[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[nongnu] elpa/sweeprolog 07b9a40b20 1/2: Adjust arity of predicates acco
From: |
ELPA Syncer |
Subject: |
[nongnu] elpa/sweeprolog 07b9a40b20 1/2: Adjust arity of predicates according to completion context |
Date: |
Fri, 25 Nov 2022 16:59:24 -0500 (EST) |
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