[nongnu] elpa/sweeprolog 07b9a40b20 1/2: Adjust arity of predicates according to completion context

[ELPA Syncer]

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

    Adjust arity of predicates according to completion context
    
    * sweep.pl (sweep_context_callable): track required arity adjustment.
    (sweep_predicate_completion_candidates): take arity difference as
    argument, adjust and filter candidates according to it.
    * sweeprolog.el (sweeprolog-predicate-completion-at-point): use it.
    * sweeprolog-tests.el: test it.
---
 sweep.pl            | 72 ++++++++++++++++++++++++++++++++++-------------------
 sweeprolog-tests.el | 50 +++++++++++++++++++++++++++++++------
 sweeprolog.el       |  5 ++--
 3 files changed, 90 insertions(+), 37 deletions(-)

diff --git a/sweep.pl b/sweep.pl
index dba4772329..ca352010f6 100644
--- a/sweep.pl
+++ b/sweep.pl
@@ -764,14 +764,22 @@ sweep_atom_collection(Sub, Col) :-
             ),
             Col).
 
-sweep_predicate_completion_candidates(_, Ps) :-
+sweep_predicate_completion_candidates(D, Ps) :-
+    integer(D),
     findall(H,
             (   sweep_current_module(M),
-                @(predicate_property(H, visible), M)
+                (   @(predicate_property(H0, visible), M)
+                ;   xref_defined(_, H0, _)
+                ),
+                adjust_arity(D, H0, H)
             ),
             Hs),
     maplist(sweep_format_predicate, Hs, Ps).
 
+adjust_arity(0, H, H) :- !.
+adjust_arity(D, H0, H) :- pi_head(F/N0, H0), !, N is N0 - D, N >= 0, 
pi_head(F/N, H).
+adjust_arity(D, H0, H) :- pi_head(M:F/N0, H0), N is N0 - D, N >= 0, 
pi_head(M:F/N, H).
+
 sweep_format_predicate(H, [S|SP]) :-
     term_variables(H, Vs),
     maplist(=('$VAR'('_')), Vs),
@@ -789,43 +797,55 @@ sweep_context_callable([H|T], R) :-
     ;   current_op(1200, _, F)
     ),
     !,
-    sweep_context_callable_(T, R).
+    (   F == (-->)
+    ->  R0 = 2
+    ;   R0 = 0
+    ),
+    sweep_context_callable_(T, R0, 0, R).
 sweep_context_callable([_|T], R) :-
     sweep_context_callable(T, R).
 
-sweep_context_callable_([], true) :- !.
-sweep_context_callable_([[":"|2]], true) :- !.
-sweep_context_callable_([["("|_]|T], R) :-
-    sweep_context_callable_(T, R).
-sweep_context_callable_([H|T], R) :-
+sweep_context_callable_([], R0, R1, R) :- R is R0 + R1, !.
+sweep_context_callable_([[":"|2]], R0, R1, R) :- R is R0 + R1, !.
+sweep_context_callable_([["("|_]|T], R0, R1, R) :-
+    !,
+    sweep_context_callable_(T, R0, R1, R).
+sweep_context_callable_([["{"|_]|T], 2, R1, R) :-
+    !,
+    sweep_context_callable_(T, 0, R1, R).
+sweep_context_callable_([H|T], R0, _, R) :-
     H = [F0|N],
     atom_string(F, F0),
-    (   sweep_context_callable_arg(F, N)
-    ->  sweep_context_callable_(T, R)
-    ;   R = []
-    ).
+    sweep_context_callable_arg(F, N, R1),
+    sweep_context_callable_(T, R0, R1, R).
 
-sweep_context_callable_arg(Neck, _) :-
+sweep_context_callable_arg((-->), _, 2) :- !.
+sweep_context_callable_arg(Neck, _, 0) :-
     (   xref_op(_, op(1200, _, Neck))
     ->  true
     ;   current_op(1200, _, Neck)
-    ).
-sweep_context_callable_arg(F, N) :-
-    (   current_predicate(F/M), pi_head(F/M,Head)
-    ;   xref_defined(_, Head, _), pi_head(F/M,Head)
     ),
+    !.
+sweep_context_callable_arg(F, N, R) :-
+    sweep_current_module(Mod),
+    (   @(predicate_property(Head, visible), Mod)
+    ;   xref_defined(_, Head, _)
+    ),
+    pi_head(F/M,Head),
     M >= N,
-    catch(infer_meta_predicate(Head, Spec),
-          error(permission_error(access, private_procedure, _),
-                context(system:clause/2, _)),
-          false),
+    (   @(predicate_property(Head, meta_predicate(Spec)), Mod)
+    ;   catch(infer_meta_predicate(Head, Spec),
+              error(permission_error(access, private_procedure, _),
+                    context(system:clause/2, _)),
+              false)
+    ),
     arg(N, Spec, A),
-    callable_arg(A).
+    callable_arg(A, R).
 
-callable_arg(N) :- integer(N), !.
-callable_arg(^) :- !.
-callable_arg(//) :- !.
-callable_arg(:) :- !.
+callable_arg(N,    N) :- integer(N), !.
+callable_arg((^),  0) :- !.
+callable_arg((//), 2) :- !.
+callable_arg((:),  0) :- !.
 
 sweep_exportable_predicates(Path0, Preds) :-
     atom_string(Path, Path0),
diff --git a/sweeprolog-tests.el b/sweeprolog-tests.el
index db03e45980..fb32a9a0d2 100644
--- a/sweeprolog-tests.el
+++ b/sweeprolog-tests.el
@@ -229,6 +229,39 @@ baz(Baz) :- Baz = opaque
 "
                      ))))
 
+(ert-deftest complete-non-terminal ()
+  "Tests completing DCG non-terminals."
+  (let ((temp (make-temp-file "sweeprolog-test"
+                              nil
+                              ".pl"
+                              "
+barbaz --> foo.
+
+foo --> barb"
+                              )))
+    (find-file-literally temp)
+    (sweeprolog-mode)
+    (goto-char (point-max))
+    (call-interactively #'completion-at-point)
+    (should (string= (buffer-string)
+                     "
+barbaz --> foo.
+
+foo --> barbaz"
+
+                     ))
+    (insert ".\n\nfoo => barb")
+    (call-interactively #'completion-at-point)
+    (should (string= (buffer-string)
+                     "
+barbaz --> foo.
+
+foo --> barbaz.
+
+foo => barbaz(_, _)"
+
+                     ))))
+
 (ert-deftest complete-predicate ()
   "Tests completing predicate calls."
   (let ((temp (make-temp-file "sweeprolog-test"
@@ -877,24 +910,25 @@ test_bindings(Name-Value) -->
   (with-temp-buffer
     (sweeprolog-mode)
     (insert given)
-    (let ((callable (sweeprolog-context-callable-p)))
-      (should (if expected
-                  callable
-                (not callable))))))
+    (should (equal expected (sweeprolog-context-callable-p)))))
 
 (ert-deftest context-callable ()
   "Test recognizing callable contexts."
+  (sweeprolog-test-context-callable-p "foo(Bar) :- include( " 1)
+  (sweeprolog-test-context-callable-p "foo(Bar) --> " 2)
+  (sweeprolog-test-context-callable-p "foo(Bar) --> {include(" 1)
+  (sweeprolog-test-context-callable-p "foo(Bar) --> {include(phrase(" 2)
   (sweeprolog-test-context-callable-p "foo" nil)
   (sweeprolog-test-context-callable-p "foo(" nil)
   (sweeprolog-test-context-callable-p "foo(bar)" nil)
-  (sweeprolog-test-context-callable-p "foo(bar) :- " t)
+  (sweeprolog-test-context-callable-p "foo(bar) :- " 0)
   (sweeprolog-test-context-callable-p "foo(bar) :- baz(" nil)
   (sweeprolog-test-context-callable-p "foo(bar) :- baz(bar" nil)
-  (sweeprolog-test-context-callable-p "foo(bar) :- baz(bar), " t)
+  (sweeprolog-test-context-callable-p "foo(bar) :- baz(bar), " 0)
   (sweeprolog-test-context-callable-p "foo(bar) :- baz(bar), findall(" nil)
   (sweeprolog-test-context-callable-p "foo(bar) :- baz(bar), findall(X" nil)
-  (sweeprolog-test-context-callable-p "foo(bar) :- baz(bar), findall(X," t)
-  (sweeprolog-test-context-callable-p "foo(bar) :- baz(bar), findall(X, false" 
t)
+  (sweeprolog-test-context-callable-p "foo(bar) :- baz(bar), findall(X," 0)
+  (sweeprolog-test-context-callable-p "foo(bar) :- baz(bar), findall(X, false" 
0)
   (sweeprolog-test-context-callable-p "foo(bar) :- baz(bar), findall(X, 
false," nil)
   (sweeprolog-test-context-callable-p "foo(bar) :- baz(bar), findall(X, false, 
Xs). " nil))
 
diff --git a/sweeprolog.el b/sweeprolog.el
index d5ecf6ec66..cde6cb568f 100644
--- a/sweeprolog.el
+++ b/sweeprolog.el
@@ -1078,11 +1078,10 @@ resulting list even when found in the current clause."
     (when (and (<= beg (point) end)
                (let ((first (char-after beg)))
                  (not (or (sweeprolog--char-uppercase-p first)
-                          (= first ?_))))
-               (sweeprolog-context-callable-p))
+                          (= first ?_)))))
       (when-let
           ((col (sweeprolog--query-once "sweep" 
"sweep_predicate_completion_candidates"
-                                        nil)))
+                                        (sweeprolog-context-callable-p))))
         (list beg end col
               :exclusive 'no
               :annotation-function