From 07b9a40b203a0b2900ddc3682a3334929a240373 Mon Sep 17 00:00:00 2001 From: Eshel Yaron Date: Fri, 25 Nov 2022 23:01:40 +0200 Subject: [PATCH] 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 dba4772..ca35201 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 db03e45..fb32a9a 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 d5ecf6e..cde6cb5 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 -- 2.39.2