ENHANCED: Guess argument names for DCG grammar rules

* sweeprolog.el (sweeprolog-predicate-completion-at-point)
(sweeprolog-insert-clause): Support guessing argument names from
documentation also for DCG grammar rules.

diff --git a/sweep.pl b/sweep.pl
index a7c5c1a709469b7e657d55a9fa50be97fe5fe6b5..ab4d5d6c95321e66bd1ca3a83b968cb016435f84 100644 (file)
--- a/sweep.pl
+++ b/sweep.pl
@@ -65,7 +65,7 @@
             sweep_beginning_of_last_predicate/2,
             sweep_atom_collection/2,
             sweep_context_callable/2,
-            sweep_predicate_completion_candidates/2,
+            sweep_heads_collection/2,
             sweep_exportable_predicates/2,
             sweep_interrupt/0,
             sweep_string_to_atom/2,
@@ -429,72 +429,57 @@ sweep_predicate_location_(M, H, Path, Line) :-
     predicate_property(M:H, line_count(Line)),
     atom_string(Path0, Path).
 
+sweep_matching_predicates(S, D, PIs) :-
+    setof(M:F/A, sweep_matching_predicate(S, D, M, F, A), PIs).
 
-sweep_predicates_collection(Sub, Preds) :-
-    findall(M:F/N,
-            ( current_predicate(M:F/N),
-              pi_head(F/N, H),
-              (   M == system
-              ->  true
-              ;   \+ (predicate_property(M:H, imported_from(M1)), M \= M1)
-              )
-            ),
-            Preds0,
-            Tail0),
-    findall(M:F/N,
-            ( '$autoload':library_index(H, M, _),
-              pi_head(F/N, H)
-            ),
-            Tail0,
-            Tail1),
-    findall(M:F/N,
-            ( xref_defined(SourceId, H, local(_)),
-              (   xref_module(SourceId, M)
-              ->  true
-              ;   M = user
-              ),
-              \+ (predicate_property(M:H, imported_from(M1)), M \= M1),
-              pi_head(F/N, H)
-            ),
-            Tail1,
-            Tail),
-    findall(M:F/N,
-            ( xref_defined(_, H, imported(SourceId)),
-              (   xref_module(SourceId, M)
-              ->  true
-              ;   M = user
-              ),
-              pi_head(F/N, H)
-            ),
-            Tail),
-    list_to_set(Preds0, Preds1),
-    maplist(sweep_predicate_description, Preds1, Preds2),
-    include(sweep_predicate_non_hidden, Preds2, Preds3),
-    (   Sub == []
-    ->  Preds = Preds3
-    ;   include(sweep_predicate_matches(Sub), Preds3, Preds)
-    ).
+sweep_matching_predicate(S, D, M, F, A) :-
+    sweep_known_predicate(M, F, A),
+    once(sub_atom(F, _, _, _, S)),
+    A >= D.
 
-sweep_predicate_matches(Sub, [String|_]) :-
-    sub_string(String, _, _, _, Sub).
+sweep_known_predicate(M, F, A) :-
+    current_predicate(M:F/A),
+    (   M == system
+    ->  true
+    ;   pi_head(F/A, H),
+        \+ (predicate_property(M:H, imported_from(M1)), M \= M1)
+    ).
+sweep_known_predicate(M, F, A) :-
+    '$autoload':library_index(H, M, _),
+    pi_head(F/A, H).
+sweep_known_predicate(M, F, A) :-
+    xref_defined(SourceId, H, How),
+    xref_definition_line(How, _),
+    (   xref_module(SourceId, M)
+    ->  true
+    ;   M = user
+    ),
+    pi_head(F/A, H).
 
-sweep_predicate_non_hidden([String|_]) :-
-    \+ sub_string(String, _, _, _, ":'$").
+sweep_predicates_collection(S0, Ps) :-
+    (   S0 == []
+    ->  S = ""
+    ;   S = S0
+    ),
+    sweep_matching_predicates(S, 0, PIs),
+    maplist(sweep_format_pi, PIs, Ps).
 
-sweep_predicate_description(M:F/N, [S|T]) :-
+sweep_format_pi(M:F/N, [S|T]) :-
     sweep_module_functor_arity_pi_(M, F, N, MFA),
     format(string(S),
            '~W',
            [MFA, [quoted(true), character_escapes(true)]]),
-    sweep_predicate_description_(MFA, T).
+    (   sweep_predicate_summary(MFA, Summary)
+    ->  atom_string(Summary, T)
+    ;   T = []
+    ).
 
-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_predicate_summary(MFA, D) :-
+    doc_comment(MFA, _, D, _).
+sweep_predicate_summary(MFA, D) :-
+    man_object_property(MFA, summary(D)).
+sweep_predicate_summary(_:FA, D) :-
+    man_object_property(FA, summary(D)).
 
 sweep_packs_collection(SearchString, Packs) :-
     prolog_pack:query_pack_server(search(SearchString), true(Packs0), []),
@@ -885,27 +870,15 @@ sweep_atom_collection(Sub, Col) :-
             ),
             Col).
 
-sweep_predicate_completion_candidates([D|Sub], Ps) :-
-    integer(D),
-    sweep_current_module(M),
-    findall(H,
-            (   (   @(predicate_property(H, visible), M)
-                ;   xref_defined(_, H, _)
-                ),
-                pi_head(F/N, H),
-                once(sub_atom(F, _, _, _, Sub)),
-                N - D >= 0
-            ),
-            Hs),
-    maplist(sweep_format_predicate(M, D), Hs, Ps).
+sweep_heads_collection([D|Sub], Ps) :-
+    sweep_matching_predicates(Sub, D, PIs),
+    maplist(sweep_format_head_(D), PIs, Ps).
 
-sweep_format_predicate(M0, D, H0, [S|SP]) :-
-    pi_head(F/N0, H0),
-    N is N0 - D,
+sweep_format_head_(D, M:F/A, [S|SP]) :-
+    N is A - D,
     length(NamedArgs, N),
     append(NamedArgs, _, OpenNamedArgs),
-    (   @(predicate_property(H0, implementation_module(M)), M0),
-        predicate_argument_names(M:F/N0, As)
+    (   predicate_argument_names(M:F/A, As)
     ->  maplist(name_variable, As, Vs), OpenNamedArgs = Vs
     ;   maplist(=('$VAR'('_')), NamedArgs)
     ),
@@ -1012,12 +985,21 @@ sweep_file_path_in_library(Path, Spec) :-
     ;   term_string(Spec1, Spec)
     ).
 
+
 predicate_argument_names(M:F/A, Args) :-
-    (   M == system
+    sweep_module_functor_arity_pi_(M, F, A, M:PI),
+    (   predicate_argument_names_from_man(M, PI, Args0)
     ->  true
-    ;   sub_atom(M, 0, 1, _, '$')
+    ;   predicate_argument_names_from_pldoc(M, PI, Args0)),
+    arg(2, PI, N),
+    predicate_argument_names_(N, Args0, Args).
+
+
+predicate_argument_names_from_man(M, PI, Args) :-
+    (   pldoc_man:load_man_object(M:PI, _, _, DOM0)
+    ->  true
+    ;   pldoc_man:load_man_object(PI, _, _, DOM0)
     ),
-    pldoc_man:load_man_object(F/A, _, _, DOM0),
     memberchk(element(dt, _, DOM1), DOM0),
     memberchk(element(a, _, DOM2), DOM1),
     catch(findall(Arg,
@@ -1031,17 +1013,16 @@ predicate_argument_names(M:F/A, Args) :-
                       comma_list(CommaSeparatedArgs, ArgsList),
                       member(Arg, ArgsList)
                   ),
-                  Args0),
+                  Args),
           error(syntax_error(_),_),
-          fail),
-    predicate_argument_names_(A, Args0, Args).
-predicate_argument_names(M:F/A, Args) :-
-    doc_comment(M:F/A, _, _, C),
+          fail).
+
+predicate_argument_names_from_pldoc(M, PI, Args) :-
+    doc_comment(M:PI, _, _, C),
     comment_modes(C, ModeAndDets),
     member(ModeAndDet, ModeAndDets),
     strip_det(ModeAndDet, Head),
-    Head =.. [_|Args0],
-    predicate_argument_names_(A, Args0, Args).
+    Head =.. [_|Args].
 
 predicate_argument_names_(Arity, Args0, Args) :-
     length(Args0, Arity),
@@ -1086,11 +1067,10 @@ dep_import(Path, Kind, PI0) -->
     [[Path, PI, Kind]].
 
 
-sweep_format_head([F0|A], R) :-
+sweep_format_head([M0,F0,A,D], R) :-
+    atom_string(M, M0),
     atom_string(F, F0),
-    pi_head(F/A, H),
-    sweep_current_module(M),
-    sweep_format_predicate(M, 0, H, R).
+    sweep_format_head_(D, M:F/A, R).
 
 sweep_format_term([F0,N,P], [S|SP]) :-
     atom_string(F, F0),

diff --git a/sweeprolog-tests.el b/sweeprolog-tests.el
index ee6ec40903d01ec353f90981d43f14465b60fe37..48cce1629237df526dfdcbffda36c8c86964dedd 100644 (file)
--- a/sweeprolog-tests.el
+++ b/sweeprolog-tests.el
@@ -714,6 +714,21 @@ foo(Bar) --> bar(Bar).")))
     (should (equal (sweeprolog-identifier-at-point)
                    "foobarbaz:foo//1"))))
 
+(ert-deftest dcg-completion-at-point ()
+  "Test completing DCG grammar rule invocation."
+  (let ((temp (make-temp-file "sweeprolog-test"
+                              nil
+                              "pl"
+                              ":- use_module(library(dcg/high_order)).
+foo(Bar) --> optiona")))
+    (find-file-literally temp)
+    (sweeprolog-mode)
+    (goto-char (point-max))
+    (complete-symbol nil)
+    (should (string= (buffer-string)
+                     ":- use_module(library(dcg/high_order)).
+foo(Bar) --> optional(Match, Default)"))))
+
 (ert-deftest definition-at-point ()
   "Test recognizing predicate definitions."
   (let ((temp (make-temp-file "sweeprolog-test"
@@ -896,6 +911,34 @@ foo --> bar.
 foo --> Body.
 "))))
 
+
+(ert-deftest dwim-next-clause-dcg-with-pldoc ()
+  "Test completing DCG grammar rule invocation."
+  (let ((temp (make-temp-file "sweeprolog-test"
+                              nil
+                              "pl"
+                              "
+:- module(dcg_completion_at_point_with, []).
+
+%!  foo(+Bar)// is det.
+
+foo(bar) --> baz(bar).
+")))
+    (find-file-literally temp)
+    (sweeprolog-mode)
+    (goto-char (point-max))
+    (sweeprolog-insert-term-dwim)
+    (should (string= (buffer-string)
+                     "
+:- module(dcg_completion_at_point_with, []).
+
+%!  foo(+Bar)// is det.
+
+foo(bar) --> baz(bar).
+foo(Bar) --> Body.
+
+"))))
+
 (ert-deftest dwim-next-clause-ssu ()
   "Tests inserting an SSU rule with `sweeprolog-insert-term-dwim'."
   (with-temp-buffer

diff --git a/sweeprolog.el b/sweeprolog.el
index 92c0829890aa87b677fcce0cc266836d2cc442f5..653076aacdb8e5caa4aa90682d3e99ecad623755 100644 (file)
--- a/sweeprolog.el
+++ b/sweeprolog.el
@@ -1355,9 +1355,10 @@ resulting list even when found in the current clause."
                  (not (or (sweeprolog--char-uppercase-p first)
                           (= first ?_)))))
       (when-let
-          ((col (sweeprolog--query-once
-                 "sweep" "sweep_predicate_completion_candidates"
-                 (cons (sweeprolog-context-callable-p)
+          ((extra-args (sweeprolog-context-callable-p))
+           (col (sweeprolog--query-once
+                 "sweep" "sweep_heads_collection"
+                 (cons extra-args
                        (buffer-substring-no-properties beg end)))))
         (list beg end col
               :exclusive 'no
@@ -3551,10 +3552,14 @@ of the prefix argument."
       (sweeprolog-forward-hole))))
 
 (defun sweeprolog-insert-clause (functor arity &optional neck module)
-  (let ((point (point))
-        (neck (or neck ":-"))
-        (head-format (sweeprolog--query-once "sweep" "sweep_format_head"
-                                             (cons functor arity))))
+  (let* ((point (point))
+         (neck (or neck ":-"))
+         (mod (or module (sweeprolog-buffer-module)))
+         (head-format (sweeprolog--query-once "sweep" "sweep_format_head"
+                                              (list mod
+                                                    functor
+                                                    arity
+                                                    (if (string= neck "-->") 2 0)))))
     (combine-after-change-calls
       (insert "\n"
               (if module
@@ -3595,7 +3600,7 @@ of the prefix argument."
       (goto-char end)
       (end-of-line)
       (sweeprolog-insert-clause functor
-                                (- arity (if (string= neck "-->") 2 0))
+                                arity
                                 neck
                                 module)
       t)))
@@ -3636,7 +3641,7 @@ of the prefix argument."
       (funcall sweeprolog-new-predicate-location-function
                functor arity neck)
       (sweeprolog-insert-clause functor
-                                (- arity (if (string= neck "-->") 2 0))
+                                arity
                                 neck)
       t)))