[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[nongnu] elpa/sweeprolog 6a9bfd3651 7/9: ENHANCED: Improve 'sweeprolog-e
From: |
ELPA Syncer |
Subject: |
[nongnu] elpa/sweeprolog 6a9bfd3651 7/9: ENHANCED: Improve 'sweeprolog-extract-region-to-predicate' |
Date: |
Sat, 7 Oct 2023 10:01:42 -0400 (EDT) |
branch: elpa/sweeprolog
commit 6a9bfd36518539c1c5c513e02057a413103f46dc
Author: Eshel Yaron <me@eshelyaron.com>
Commit: Eshel Yaron <me@eshelyaron.com>
ENHANCED: Improve 'sweeprolog-extract-region-to-predicate'
Teach 'sweeprolog-extract-region-to-predicate' about existentially
quantified goals and lambda terms.
* sweep.pl (sweep_term_variable_names/2): Remove from export list.
* sweep.pl (sweep_extract_goal/2): New public predicate.
* sweeprolog.el (sweeprolog-extract-region-to-predicate): Use it.
* sweeprolog-tests.el: Test it.
* sweep.texi (Extract Goal): Update documentation.
---
sweep.pl | 319 +++++++++++++++++++++++++++++++++++++++++++++++++++-
sweep.texi | 5 +-
sweeprolog-tests.el | 280 ++++++++++++++++++++++++++++++++++++++++++++-
sweeprolog.el | 134 +++++++++++-----------
4 files changed, 666 insertions(+), 72 deletions(-)
diff --git a/sweep.pl b/sweep.pl
index 6fbf5d7fdd..f1129f4674 100644
--- a/sweep.pl
+++ b/sweep.pl
@@ -93,12 +93,12 @@
sweep_head_functors_collection/2,
sweep_functors_collection/2,
sweep_compound_functors_collection/2,
- sweep_term_variable_names/2,
sweep_goal_may_cut/2,
sweep_top_level_start_pty/2,
sweep_cleanup_threads/2,
sweep_kill_thread/2,
- sweep_list_threads/2
+ sweep_list_threads/2,
+ sweep_extract_goal/2
]).
:- use_module(library(pldoc)).
@@ -1670,7 +1670,7 @@ sweep_variable_start_code(C, _) :- code_type(C,
prolog_var_start).
sweep_term_variable_names(String, Names) :-
term_string(_, String, [variable_names(VarNames)]),
- maplist([Atom=_,Name]>>atom_string(Atom, Name), VarNames, Names).
+ maplist([Atom=_,Atom]>>true, VarNames, Names).
sweep_goal_may_cut(String, _) :-
term_string(Goal, String),
@@ -1693,3 +1693,316 @@ sweep_goal_may_cut_(!) =>
true.
sweep_goal_may_cut_(_) =>
false.
+
+strip_parens(parentheses_term_position(_,_,Pos0), Pos, _, Pri) :-
+ !,
+ strip_parens(Pos0, Pos, 1200, Pri).
+strip_parens(Pos, Pos, Pri, Pri).
+
+clause_body_pos_neck(C,P0,B,BP,N,R) :-
+ strip_parens(P0,P,1199,R),
+ clause_body_pos_neck_(C,P,B,BP,N).
+
+clause_body_pos_neck_((:-B), term_position(_,_,_,_,[BP]), B, BP,0) :- !.
+clause_body_pos_neck_((_:-B), term_position(_,_,_,_,[_,BP]), B, BP,0) :- !.
+clause_body_pos_neck_((_=>B), term_position(_,_,_,_,[_,BP]), B, BP,0) :- !.
+clause_body_pos_neck_((_-->B), term_position(_,_,_,_,[_,BP]), B, BP,//).
+
+sweep_extract_goal([ClauseString,GoalBeg,GoalEnd,Functor0,FileName0],
+ [Call,Head,Neck,Body,Safe,Functor,Arity,Exists]) :-
+ Result = result(Call, Head, Body, Safe, Arity, Neck, Exists),
+ atom_string(Functor1, Functor0),
+ term_string(Functor1, Functor),
+ atom_string(FileName, FileName0),
+ xref_source(FileName),
+ sweep_module_path_(Mod, FileName),
+ term_string(Clause, ClauseString, [subterm_positions(Pos0),
+ variable_names(ClauseVarNames),
+ module(Mod)]),
+ clause_body_pos_neck(Clause, Pos0, Body0, Pos, Meta, Pri),
+ pos_bounds(Pos, PosBeg, PosEnd),
+ ( GoalBeg =< PosBeg, PosEnd =< GoalEnd
+ -> sweep_extract_this_goal(ClauseString, ClauseVarNames, Functor1, Body0,
Pos, 0, false, Meta, Mod, Pri, Result)
+ ; sweep_extract_goal_r(FileName, ClauseString, ClauseVarNames, GoalBeg,
GoalEnd, Functor1, Body0, Pos, 0, false, Meta, Mod, Pri, Result)
+ ).
+
+sweep_extract_goal_r(_, _, _, _, _, _, _,
+ Pos, _, _, _, _, _, _) :-
+ var(Pos),
+ !,
+ fail.
+sweep_extract_goal_r(FileName, ClauseString, ClauseVarNames, GoalBeg, GoalEnd,
Func, {Goal},
+ brace_term_position(_, _, Pos), Offset, Safe0, '//', Mod,
_Pri, Result) :-
+ !,
+ Pri = 1199,
+ pos_bounds(Pos, PosBeg, PosEnd),
+ ( GoalBeg =< PosBeg, PosEnd =< GoalEnd
+ -> sweep_extract_this_goal(ClauseString, ClauseVarNames, Func, Goal, Pos,
Offset, Safe0, 0, Mod, Pri, Result)
+ ; sweep_extract_goal_r(FileName, ClauseString, ClauseVarNames, GoalBeg,
GoalEnd, Func, Goal, Pos, Offset, Safe0, 0, Mod, Pri, Result)
+ ).
+sweep_extract_goal_r(FileName, ClauseString, ClauseVarNames, GoalBeg, GoalEnd,
Func, Goal,
+ parentheses_term_position(_, _, Pos), Offset, Safe0,
Meta, Mod, _Pri, Result) :-
+ !,
+ Pri = 1199,
+ pos_bounds(Pos, PosBeg, PosEnd),
+ ( GoalBeg =< PosBeg, PosEnd =< GoalEnd
+ -> sweep_extract_this_goal(ClauseString, ClauseVarNames, Func, Goal, Pos,
Offset, Safe0, Meta, Mod, Pri, Result)
+ ; sweep_extract_goal_r(FileName, ClauseString, ClauseVarNames, GoalBeg,
GoalEnd, Func, Goal, Pos, Offset, Safe0, Meta, Mod, Pri, Result)
+ ).
+sweep_extract_goal_r(FileName, ClauseString, ClauseVarNames, GoalBeg, GoalEnd,
Func, Goal,
+ term_position(Beg,End,_,_,PosList), Offset, Safe0, Meta,
Mod, Pri, Result) :-
+ !,
+ ( @(predicate_property(Goal, meta_predicate(Spec)), Mod)
+ -> true
+ ; ignore(catch(infer_meta_predicate(Goal, Spec),
+ error(permission_error(access, private_procedure, _),
+ context(system:clause/2, _)),
+ false))
+ ),
+ sweep_extract_goal_term(FileName, ClauseString, ClauseVarNames, GoalBeg,
GoalEnd, Func, Goal, 1, Beg, End, Spec, PosList, PosList, Offset, Safe0, Meta,
Mod, Pri, Result).
+
+sweep_extract_goal_term(FileName, ClauseString0, ClauseVarNames, GoalBeg,
GoalEnd, Func, Goal, ArgIndex, Beg, End, Spec,
+ [Pos|Tail], PosList, Offset0, Safe0, Meta0, Mod0,
Pri0, Result) :-
+ arg(ArgIndex, Goal, Arg),
+ pos_bounds(Pos, PosBeg, PosEnd),
+ ( GoalBeg =< PosBeg, PosEnd =< GoalEnd
+ -> sweep_extract_goal_update_state(FileName, Goal, ArgIndex, PosBeg,
PosEnd, PosList, Beg, End, Spec,
+ ClauseString0, Offset0, Safe0, Meta0,
Mod0,
+ ClauseString, Offset, Safe1, Meta,
Mod, Pri),
+ sweep_extract_this_goal(ClauseString, ClauseVarNames, Func, Arg, Pos,
Offset, Safe1, Meta, Mod, Pri, Result)
+ ; PosBeg =< GoalBeg, GoalEnd =< PosEnd
+ -> sweep_extract_goal_update_state(FileName, Goal, ArgIndex, PosBeg,
PosEnd, PosList, Beg, End, Spec,
+ ClauseString0, Offset0, Safe0, Meta0,
Mod0,
+ ClauseString, Offset, Safe1, Meta,
Mod, Pri),
+ sweep_extract_goal_r(FileName, ClauseString, ClauseVarNames, GoalBeg,
GoalEnd, Func, Arg, Pos, Offset, Safe1, Meta, Mod, Pri, Result)
+ ; ArgIndex1 is ArgIndex + 1,
+ sweep_extract_goal_term(FileName, ClauseString0, ClauseVarNames,
GoalBeg, GoalEnd, Func, Goal, ArgIndex1, Beg, End, Spec,
+ Tail, PosList, Offset0, Safe0, Meta0, Mod0,
Pri0, Result)
+ ).
+
+sweep_extract_goal_update_state(FileName, Goal, ArgIndex, ArgBeg, ArgEnd,
PosList, Beg, End, Spec,
+ ClauseString0, Offset0, Safe0, Meta0, Mod0,
+ ClauseString, Offset, Safe, Meta, Mod, Pri) :-
+ sweep_extract_goal_update_module(Goal, ArgIndex, Mod0, Mod),
+ sweep_extract_goal_update_meta(Spec, ArgIndex, Meta0, Meta),
+ sweep_extract_goal_update_precedence(FileName, Goal, ArgIndex, ArgBeg,
ArgEnd, Beg, End, Pri),
+ sweep_extract_goal_update_safety(Goal, ArgIndex, Safe0, Safe),
+ sweep_extract_goal_update_clause_string(Goal, ArgIndex, PosList,
ClauseString0, Offset0, ClauseString, Offset).
+
+sweep_extract_goal_update_clause_string((_;_), 1, [_,AltPos], ClauseString0,
Offset, ClauseString, Offset) :-
+ !,
+ pos_bounds(AltPos, AltBeg, AltEnd),
+ sub_string(ClauseString0, 0, AltBeg, _, ClauseBeforeAlt),
+ sub_string(ClauseString0, AltEnd, _, 0, ClauseAfterAlt),
+ string_concat(ClauseBeforeAlt, "true", ClauseString1),
+ string_concat(ClauseString1, ClauseAfterAlt, ClauseString).
+sweep_extract_goal_update_clause_string((_;_), 2, [AltPos,_], ClauseString0,
Offset0, ClauseString, Offset) :-
+ !,
+ pos_bounds(AltPos, AltBeg, AltEnd),
+ Offset is Offset0 + AltEnd - AltBeg - 4,
+ sub_string(ClauseString0, 0, AltBeg, _, ClauseBeforeAlt),
+ sub_string(ClauseString0, AltEnd, _, 0, ClauseAfterAlt),
+ string_concat(ClauseBeforeAlt, "true", ClauseString1),
+ string_concat(ClauseString1, ClauseAfterAlt, ClauseString).
+sweep_extract_goal_update_clause_string(_, _, _, ClauseString, Offset,
ClauseString, Offset).
+
+sweep_extract_goal_update_safety((_,_), _, Safe, Safe) :-
+ !.
+sweep_extract_goal_update_safety((_;_), _, Safe, Safe) :-
+ !.
+sweep_extract_goal_update_safety((_->_), 2, Safe, Safe) :-
+ !.
+sweep_extract_goal_update_safety(_, _, _, true).
+
+sweep_extract_goal_update_module(Mod1:_, ArgIndex, _Mod0, Mod) :-
+ atom(Mod1),
+ !,
+ ArgIndex == 2,
+ Mod = Mod1.
+sweep_extract_goal_update_module(_, _, Mod, Mod).
+
+sweep_extract_goal_update_meta(Spec, 2, ^, ^) :-
+ var(Spec),
+ !.
+sweep_extract_goal_update_meta(Spec, _, _, _) :-
+ var(Spec),
+ !,
+ fail.
+sweep_extract_goal_update_meta(Spec, ArgIndex, //, Meta) :-
+ !,
+ arg(ArgIndex, Spec, Meta0),
+ ( Meta0 == 0
+ -> Meta = '//'
+ ; Meta = Meta0
+ ).
+sweep_extract_goal_update_meta(Spec, ArgIndex, _Meta0, Meta) :-
+ arg(ArgIndex, Spec, Meta).
+
+sweep_extract_goal_update_precedence(FileName, Goal, ArgIndex, ArgBeg, ArgEnd,
Beg, End, Pri) :-
+ compound_name_arity(Goal, F, N),
+ sweep_extract_goal_update_precedence_(FileName, F, N, ArgIndex, ArgBeg,
ArgEnd, Beg, End, Pri).
+
+sweep_extract_goal_update_precedence_(FileName, F, 1, 1, Beg, _ArgEnd, Beg,
_End, Precedence) :-
+ ( xref_op(FileName, op(Precedence0, Assoc, F))
+ ; current_op(Precedence0, Assoc, F)
+ ),
+ memberchk(Assoc, [xf,yf]),
+ !,
+ ( Assoc == xf
+ -> Precedence is Precedence0 - 1
+ ; Precedence = Precedence0
+ ).
+sweep_extract_goal_update_precedence_(FileName, F, 1, 1, _ArgBeg, End, _Beg,
End, Precedence) :-
+ ( xref_op(FileName, op(Precedence0, Assoc, F))
+ ; current_op(Precedence0, Assoc, F)
+ ),
+ memberchk(Assoc, [fx,fy]),
+ !,
+ ( Assoc == fx
+ -> Precedence is Precedence0 - 1
+ ; Precedence = Precedence0
+ ).
+sweep_extract_goal_update_precedence_(FileName, F, 2, 1, Beg, _ArgEnd, Beg,
_End, Precedence) :-
+ ( xref_op(FileName, op(Precedence0, Assoc, F))
+ ; current_op(Precedence0, Assoc, F)
+ ),
+ memberchk(Assoc, [xfx, xfy, yfy, yfx]),
+ !,
+ ( Assoc == xfx
+ -> Precedence is Precedence0 - 1
+ ; Assoc == xfy
+ -> Precedence is Precedence0 - 1
+ ; Assoc == yfx
+ -> Precedence = Precedence0
+ ; Assoc == yfy
+ -> Precedence = Precedence0
+ ).
+sweep_extract_goal_update_precedence_(FileName, F, 2, 2, _ArgBeg, End, _Beg,
End, Precedence) :-
+ ( xref_op(FileName, op(Precedence0, Assoc, F))
+ ; current_op(Precedence0, Assoc, F)
+ ),
+ memberchk(Assoc, [xfx, xfy, yfy, yfx]),
+ !,
+ ( Assoc == xfx
+ -> Precedence is Precedence0 - 1
+ ; Assoc == xfy
+ -> Precedence is Precedence0
+ ; Assoc == yfx
+ -> Precedence = Precedence0 - 1
+ ; Assoc == yfy
+ -> Precedence = Precedence0
+ ).
+sweep_extract_goal_update_precedence_(_, _, _, _, _, _, _, _, 999).
+
+sweep_extract_this_goal(Clause, ClauseVarNames, Func, Term, Pos, Offset,
Safe0, ^, Mod, Pri, Result) :-
+ !,
+ sweep_extract_ext_goal([], Clause, ClauseVarNames, Func, Term, Pos,
Offset, Safe0, Mod, Pri, Result).
+sweep_extract_this_goal(Clause, ClauseVarNames, Func, Bindings>>_Goal, Pos,
Offset, _Safe0, Meta, Mod, Pri, result(Call, Head, Body, "true", Arity, ":-",
Exists)) :-
+ !,
+ sweep_extract_lambda(Clause, ClauseVarNames, Func, Bindings, Pos, Offset,
Meta, Mod, Pri, Call, Head, Body, Arity, Exists).
+sweep_extract_this_goal(Clause, _ClauseVarNames, Func, Term, Pos, Offset,
Safe0, Meta, Mod, Pri, Result) :-
+ sweep_extract_this_goal_([], Clause, Func, Term, Pos, Offset, Safe0, Meta,
Mod, Pri, Result).
+
+sweep_extract_this_goal_(Exts, Clause, Func, Term, Pos, Offset, Safe0, Meta,
Mod, Pri, result(Call, Head, Body, Safe, Arity, Neck, Exists)) :-
+ pos_bounds(Pos, BodyBeg0, BodyEnd0),
+ BodyLength is BodyEnd0 - BodyBeg0,
+ BodyBeg is BodyBeg0 - Offset,
+ BodyEnd is BodyEnd0 - Offset,
+ sub_string(Clause, BodyBeg, BodyLength, _, Body),
+ sub_string(Clause, 0, BodyBeg, _, ClauseBeforeBody),
+ sub_string(Clause, BodyEnd, _, 0, ClauseAfterBody),
+ string_concat(ClauseBeforeBody, Func, ClauseWithoutBody0),
+ string_concat(ClauseWithoutBody0, ClauseAfterBody, ClauseWithoutBody),
+ sweep_term_variable_names(ClauseWithoutBody, OtherVars0),
+ subtract(OtherVars0, Exts, OtherVars),
+ sweep_term_variable_names(Body, BodyVars),
+ intersection(OtherVars, BodyVars, CommonVars),
+ maplist([A,A=V,V]>>true,CommonVars, VarNames, Args),
+ length(Args, Arity),
+ CallTerm =.. [Func|Args],
+ term_string(CallTerm, Call, [quoted(true),
+ character_escapes(true),
+ spacing(next_argument),
+ variable_names(VarNames),
+ module(Mod),
+ priority(Pri)]),
+ ( Meta == '//'
+ -> Extra = 2
+ ; integer(Meta)
+ -> Extra = Meta
+ ; Extra = 0
+ ),
+ FullArity is Arity + Extra,
+ pi_head(Func/FullArity, H),
+ ( sweep_predicate_location_(Mod, H, _, _)
+ -> Exists = "true"
+ ; Exists = []
+ ),
+ % TODO - adjust Head and Body when Meta > 0
+ Head = Call,
+ ( Safe0
+ -> Safe = "true"
+ ; ( sweep_goal_may_cut_(Term)
+ -> Safe = []
+ ; Safe = "true"
+ )
+ ),
+ ( Meta == '//'
+ -> Neck = "-->"
+ ; Neck = ":-"
+ ).
+
+sweep_extract_ext_goal(Exts, ClauseString, ClauseVarNames, Func, Var^Term,
term_position(_,_,_,_,[_,Pos]), Offset, Safe0, Mod, _Pri, Result) :-
+ !,
+ ( member(Name=V, ClauseVarNames),
+ V == Var
+ -> true
+ ; Name = '_'
+ ),
+ sweep_extract_ext_goal([Name|Exts], ClauseString, ClauseVarNames, Func,
Term, Pos, Offset, Safe0, Mod, 200, Result).
+sweep_extract_ext_goal(Exts, ClauseString, _ClauseVarNames, Func, Term, Pos,
Offset, Safe0, Mod, Pri, Result) :-
+ sweep_extract_this_goal_(Exts, ClauseString, Func, Term, Pos, Offset,
Safe0, 0, Mod, Pri, Result).
+
+sweep_extract_lambda(Clause, ClauseVarNames, Func, Bindings, Pos0, Offset,
Meta, Mod, Pri0, Call, Head, Body, Arity, Exists) :-
+ strip_parens(Pos0, term_position(_,_,_,_,[_BindingsPos0, GoalPos0]), Pri0,
_Pri),
+ strip_parens(GoalPos0, GoalPos, 399, _GoalPri),
+ sweep_extract_lambda_(Clause, ClauseVarNames, Func, Bindings, GoalPos,
Offset, Meta, Mod, Pri0, Call, Head, Body, Arity, Exists).
+
+
+sweep_extract_lambda_(Clause, ClauseVarNames, Func, {Shared0}/Args, GoalPos,
Offset, Meta, Mod, Pri0, Call, Head, Body, Arity, Exists) :-
+ comma_list(Shared0, Shared),
+ sweep_extract_lambda_1(Clause, ClauseVarNames, Func, Shared, Args,
GoalPos, Offset, Meta, Mod, Pri0, Call, Head, Body, Arity, Exists).
+sweep_extract_lambda_(Clause, ClauseVarNames, Func, Args, GoalPos, Offset,
Meta, Mod, Pri0, Call, Head, Body, Arity, Exists) :-
+ sweep_extract_lambda_1(Clause, ClauseVarNames, Func, [], Args, GoalPos,
Offset, Meta, Mod, Pri0, Call, Head, Body, Arity, Exists).
+
+sweep_extract_lambda_1(Clause, ClauseVarNames, Func, Shared, Args, GoalPos,
Offset, Meta, Mod, Pri0, Call, Head, Body, Arity, Exists) :-
+ pos_bounds(GoalPos, BodyBeg0, BodyEnd0),
+ BodyLength is BodyEnd0 - BodyBeg0,
+ BodyBeg is BodyBeg0 - Offset,
+ sub_string(Clause, BodyBeg, BodyLength, _, Body),
+ length(Args, ArgsLen),
+ ( integer(Meta)
+ -> ArgsLen == Meta
+ ; ArgsLen == 0
+ ),
+ CallTerm =.. [Func|Shared],
+ term_string(CallTerm, Call, [quoted(true),
+ character_escapes(true),
+ spacing(next_argument),
+ variable_names(ClauseVarNames),
+ module(Mod),
+ priority(Pri0)]),
+ append(Shared, Args, HeadArgs),
+ HeadTerm =.. [Func|HeadArgs],
+ term_string(HeadTerm, Head, [quoted(true),
+ character_escapes(true),
+ spacing(next_argument),
+ variable_names(ClauseVarNames),
+ module(Mod),
+ priority(Pri0)]),
+ length(HeadArgs, Arity),
+ pi_head(Func/Arity, H),
+ ( sweep_predicate_location_(Mod, H, _, _)
+ -> Exists = "true"
+ ; Exists = []
+ ).
diff --git a/sweep.texi b/sweep.texi
index 9e581ce39d..3f1f9c8ce6 100644
--- a/sweep.texi
+++ b/sweep.texi
@@ -2714,7 +2714,10 @@ that the goal to extract shares with the containing
clause.
If the selected goal contains a cut whose scope would change as a
result of being extracted from the current clause,
@code{sweeprolog-extract-region-to-predicate} warns you about it and
-asks you to confirm before continuing.
+asks you to confirm before continuing. If your code already includes
+a definition for the predicate that
+@code{sweeprolog-extract-region-to-predicate} would define, this
+command similarly warns you and asks for confirmation.
If you call @code{sweeprolog-extract-region-to-predicate} when the
region does not contain a valid Prolog term, this command complains
diff --git a/sweeprolog-tests.el b/sweeprolog-tests.el
index 06f9ec24f3..ea62e743cc 100644
--- a/sweeprolog-tests.el
+++ b/sweeprolog-tests.el
@@ -35,7 +35,7 @@ The second argument is ignored."
(progn . ,body)
(set-buffer-modified-p nil)
(kill-buffer)
- (sweeprolog-restart)
+ ;; (sweeprolog-restart)
(setq-default sweeprolog-enable-flymake enable-flymake-flag)))))
(defconst sweeprolog-tests-greeting
@@ -1783,4 +1783,282 @@ foo((A,B)) =>
(call-interactively #'up-list)
(should (= (point) 51)))
+(sweeprolog-deftest extract-region-to-predicate ()
+ "Test `sweeprolog-extract-region-to-predicate'."
+ "
+:- module(bbb, []).
+
+bar(A, B, C, D, bar(bar), bar{bar:bar}, [bar,bar|bar]) :-
+ A = B,
+ C = D.
+"
+ (sweeprolog-extract-region-to-predicate 85 101 "bbb")
+ (should (string= (buffer-string)
+ "
+:- module(bbb, []).
+
+bar(A, B, C, D, bar(bar), bar{bar:bar}, [bar,bar|bar]) :-
+ bbb(A, B, C, D).
+
+bbb(A, B, C, D) :-
+ A = B,
+ C = D.
+")))
+
+(sweeprolog-deftest extract-region-to-predicate-parens ()
+ "Test `sweeprolog-extract-region-to-predicate' with parentheses."
+ ""
+ (should (equal (sweeprolog--extract-goal "bar :-
+ ( A = B,
+ C = D
+ )."
+ 11 41 "foo")
+ (list "foo" "foo" ":-" "( A = B,
+ C = D
+ )"
+ "true" "foo" 0 nil)))
+ (should (equal (sweeprolog--extract-goal "bar :-
+ ( A = B,
+ C = D
+ )."
+ 15 35 "foo")
+ (list "foo" "foo" ":-" "A = B,
+ C = D"
+ "true" "foo" 0 nil))))
+
+(sweeprolog-deftest extract-region-to-predicate-cut ()
+ "Test `sweeprolog-extract-region-to-predicate' in presence of a cut."
+ ""
+ (should (equal (sweeprolog--extract-goal "bar :-
+ A = B,
+ !,
+ C = D."
+ 11 34 "foo")
+ (list "foo" "foo" ":-" "A = B,
+ !,
+ C = D"
+ nil "foo" 0 nil))))
+
+(sweeprolog-deftest extract-region-to-predicate-clean-cut ()
+ "Test `sweeprolog-extract-region-to-predicate' in presence of a clean cut."
+ ""
+ (should (equal (sweeprolog--extract-goal "bar :-
+ A = B,
+ call(!),
+ C = D."
+ 11 40 "foo")
+ (list "foo" "foo" ":-" "A = B,
+ call(!),
+ C = D"
+ "true" "foo" 0 nil))))
+
+(sweeprolog-deftest extract-region-to-predicate-dcg ()
+ "Test `sweeprolog-extract-region-to-predicate'."
+ ""
+ (should (equal (sweeprolog--extract-goal "bar(A,D) -->
+ foo1(A, B),
+ foo2(C, D)."
+ 17 43 "foo")
+ (list "foo(A, D)" "foo(A, D)" "-->"
"foo1(A, B),
+ foo2(C, D)"
+ "true" "foo" 2 nil))))
+
+(sweeprolog-deftest extract-region-to-predicate-dcg-to-reg-1 ()
+ "Test `sweeprolog-extract-region-to-predicate' with \"{}/1\" in DCG."
+ ""
+ (should (equal (sweeprolog--extract-goal "bar(A,D) -->
+ {foo1(A, B), foo2(C, D)}."
+ 17 41 "foo")
+ (list "foo(A, D)" "foo(A, D)" "-->" "{foo1(A, B), foo2(C, D)}"
+ "true" "foo" 2 nil))))
+
+(sweeprolog-deftest extract-region-to-predicate-dcg-to-reg-2 ()
+ "Test `sweeprolog-extract-region-to-predicate' with \"{}/1\" in DCG."
+ ""
+ (should (equal (sweeprolog--extract-goal "bar(A,D) -->
+ {foo1(A, B), foo2(C, D)}."
+ 18 40 "foo")
+ (list "foo(A, D)" "foo(A, D)" ":-" "foo1(A, B), foo2(C, D)"
+ "true" "foo" 2 nil))))
+
+(sweeprolog-deftest extract-region-to-predicate-dcg-in-use ()
+ "Test `sweeprolog-extract-region-to-predicate' with DCG that's in use."
+ ":- module(baz, []).
+
+bar(A,D) -->
+ foo1(A, B),
+ foo2(C, D).
+
+foo(_,_) --> [].
+"
+ (should (equal (sweeprolog--extract-goal "bar(A,D) -->
+ foo1(A, B),
+ foo2(C, D)."
+ 17 43 "foo")
+ (list "foo(A, D)" "foo(A, D)" "-->" "foo1(A, B),
+ foo2(C, D)"
+ "true" "foo" 2 "true"))))
+
+
+(sweeprolog-deftest extract-region-to-predicate-1 ()
+ "Test `sweeprolog-extract-region-to-predicate'."
+ "
+:- module(bbb, []).
+
+bar(A, B, C, D, bar(bar), bar{bar:bar}, [bar,bar|bar]) :-
+ A = B,
+ C = D.
+"
+ (sweeprolog-extract-region-to-predicate 85 90 "bbb")
+ (should (string= (buffer-string)
+ "
+:- module(bbb, []).
+
+bar(A, B, C, D, bar(bar), bar{bar:bar}, [bar,bar|bar]) :-
+ bbb(A, B),
+ C = D.
+
+bbb(A, B) :-
+ A = B.
+")))
+
+(sweeprolog-deftest extract-region-to-predicate-2 ()
+ "Test `sweeprolog-extract-region-to-predicate'."
+ "
+:- module(bbb, []).
+
+bar(A, B) :-
+ ( A = C,
+ B = D
+ ; A = C,
+ B = D
+ ).
+"
+ (sweeprolog-extract-region-to-predicate 44 64 "bbb")
+ (should (string= (buffer-string)
+ "
+:- module(bbb, []).
+
+bar(A, B) :-
+ ( bbb(A, B)
+ ; A = C,
+ B = D
+ ).
+
+bbb(A, B) :-
+ A = C,
+ B = D.
+")))
+
+(sweeprolog-deftest extract-region-to-predicate-3 ()
+ "Test `sweeprolog-extract-region-to-predicate'."
+ "
+:- module(bbb, []).
+
+bar(A, B) :-
+ ( A = C,
+ B = D
+ ; A = C,
+ B = D
+ ).
+"
+ (sweeprolog-extract-region-to-predicate 73 93 "bbb")
+ (should (string= (buffer-string)
+ "
+:- module(bbb, []).
+
+bar(A, B) :-
+ ( A = C,
+ B = D
+ ; bbb(A, B)
+ ).
+
+bbb(A, B) :-
+ A = C,
+ B = D.
+")))
+
+(sweeprolog-deftest extract-region-to-predicate-ext-1 ()
+ "Test `sweeprolog-extract-region-to-predicate'."
+ "
+:- module(bbb, []).
+
+bar(A, Y) :-
+ setof(X, Y^member(X, Y), Y).
+"
+ (sweeprolog-extract-region-to-predicate 49 63 "bbb")
+ (should (string= (buffer-string)
+ "
+:- module(bbb, []).
+
+bar(A, Y) :-
+ setof(X, bbb(X), Y).
+
+bbb(X) :-
+ member(X, Y).
+")))
+
+(sweeprolog-deftest extract-region-to-predicate-ext-2 ()
+ "Test `sweeprolog-extract-region-to-predicate'."
+ "
+:- module(bbb, []).
+
+bar(A, Y) :-
+ setof(X, Y^(member(X, Y), X = Z), Y).
+"
+ (sweeprolog-extract-region-to-predicate 51 72 "bbb")
+ (should (string= (buffer-string)
+ "
+:- module(bbb, []).
+
+bar(A, Y) :-
+ setof(X, Y^bbb(Y, X), Y).
+
+bbb(Y, X) :-
+ (member(X, Y), X = Z).
+")))
+
+(sweeprolog-deftest extract-region-to-predicate-lambda-1 ()
+ "Test `sweeprolog-extract-region-to-predicate'."
+ "
+:- module(bbb, []).
+
+bar(A, Y) :-
+ maplist([VarName]>>ignore(memberchk(VarName, GoalVarNames)),
+ TemplateVarNames).
+"
+ (sweeprolog-extract-region-to-predicate 48 99 "bbb")
+ (should (string= (buffer-string)
+ "
+:- module(bbb, []).
+
+bar(A, Y) :-
+ maplist(bbb,
+ TemplateVarNames).
+
+bbb(VarName) :-
+ ignore(memberchk(VarName, GoalVarNames)).
+")))
+
+(sweeprolog-deftest extract-region-to-predicate-lambda-2 ()
+ "Test `sweeprolog-extract-region-to-predicate'."
+ "
+:- module(bbb, []).
+
+bar(A, Y) :-
+ maplist({GoalVarNames}/[VarName]>>ignore(memberchk(VarName, GoalVarNames)),
+ TemplateVarNames).
+"
+ (sweeprolog-extract-region-to-predicate 48 114 "bbb")
+ (should (string= (buffer-string)
+ "
+:- module(bbb, []).
+
+bar(A, Y) :-
+ maplist(bbb(GoalVarNames),
+ TemplateVarNames).
+
+bbb(GoalVarNames, VarName) :-
+ ignore(memberchk(VarName, GoalVarNames)).
+")))
;;; sweeprolog-tests.el ends here
diff --git a/sweeprolog.el b/sweeprolog.el
index c1dfd23518..e3cb3bb270 100644
--- a/sweeprolog.el
+++ b/sweeprolog.el
@@ -7105,6 +7105,11 @@ This function is used as a
`add-log-current-defun-function' in
;;;; Extract goals to separate predicates
+(defun sweeprolog--extract-goal (str beg end new &optional file-name)
+ (sweeprolog--query-once "sweep" "sweep_extract_goal"
+ (list str beg end new (or file-name
+ (buffer-file-name)))))
+
(defun sweeprolog-extract-region-to-predicate (beg end new &optional all)
"Extract the Prolog goal from BEG to END into a new predicate, NEW.
@@ -7124,73 +7129,68 @@ clause.
The user option `sweeprolog-new-predicate-location-function' says
where in the buffer to insert the newly created predicate."
- (interactive "r\nsNew predicate functor: \np" sweeprolog-mode)
- ;; TODO - check that NEW isn't already used
- (let* ((name (sweeprolog-format-string-as-atom new))
- (head nil)
- (neck nil)
- (body (buffer-substring-no-properties beg end))
- (vars (condition-case nil
- (sweeprolog--query-once "sweep" "sweep_term_variable_names"
- body)
- (prolog-exception
- (user-error "Region does not contain a valid Prolog term"))))
- (def-end nil))
- (if (and (sweeprolog--query-once "sweep" "sweep_goal_may_cut" body)
- (not (y-or-n-p (concat
- "The selected goal contains a cut whose "
- "scope would change as a result of this "
- "operation. Continue?"))))
- (message "Canceled.")
- (goto-char beg)
- (combine-after-change-calls
- (delete-region beg end)
- (insert name)
- (let* ((clause-beg (save-excursion
- (sweeprolog-beginning-of-top-term)
- (point)))
- (clause-end (save-excursion
- (sweeprolog-end-of-top-term)
- (point)))
- (clause-vars
- (condition-case nil
- (sweeprolog--query-once "sweep" "sweep_term_variable_names"
- (buffer-substring-no-properties
- clause-beg clause-end))
- (prolog-exception (sweeprolog-local-variables-collection))))
- (args (seq-intersection vars clause-vars #'string=))
- (args-string (when args
- (concat "("
- (mapconcat #'identity args ", ")
- ")"))))
- (setq head (concat name args-string)
- neck (or (nth 4 (sweeprolog-definition-at-point)) ":-"))
- (when args-string (insert args-string))
- (funcall sweeprolog-new-predicate-location-function
- name (length args) neck)
- (let ((def-beg (1+ (point)))
- (clause (concat "\n"
- head
- " "
- neck
- "\n"
- body
- ".\n")))
- (insert clause)
- (indent-region-line-by-line def-beg (point))
- (setq def-end (point))
- (goto-char def-beg))))
- (when all
- (let ((def-beg (point)))
- (save-excursion
- (goto-char (point-min))
- (let ((sweeprolog-query-replace-term-include-match-function
- (pcase-lambda (`(,beg ,end . ,_))
- (not (<= def-beg beg end def-end)))))
- (deactivate-mark)
- (sweeprolog-query-replace-term
- body head "true" '(goal))))))
- (sweeprolog-analyze-buffer))))
+ (interactive "r\nsNew predicate functor: \nP" sweeprolog-mode)
+ (let* ((module (sweeprolog-buffer-module))
+ (pred-beg nil)
+ (pred-end nil)
+ (clause-beg (save-excursion
+ (goto-char end)
+ (sweeprolog-beginning-of-top-term)
+ (point)))
+ (clause-end (save-excursion
+ (goto-char beg)
+ (sweeprolog-end-of-top-term)
+ (point)))
+ (clause-str (buffer-substring-no-properties clause-beg
+ clause-end)))
+ (pcase
+ (condition-case error
+ (sweeprolog--extract-goal clause-str
+ (- beg clause-beg)
+ (- end clause-beg)
+ new)
+ (prolog-exception
+ (pcase error
+ (`(prolog-exception
+ compound "error"
+ (compound "syntax_error" ,_)
+ ,_)
+ (user-error "Cannot extract goal from invalid term!")))))
+ ('nil (user-error (format "Selection %s is not a valid goal!"
(buffer-substring-no-properties beg end))))
+ (`(,call ,head ,neck ,body ,safe ,functor ,arity ,in-use)
+ (cond
+ ((or (and (not safe)
+ (not (y-or-n-p (concat
+ "The selected goal contains a cut whose "
+ "scope may change as a result of this "
+ "operation. Continue?"))))
+ (and in-use
+ (not (y-or-n-p (concat
+ "Predicate %s:%s/%d is already defined. "
+ "Continue?")))))
+ (message "Canceled."))
+ (t
+ (goto-char beg)
+ (combine-after-change-calls
+ (delete-region beg end)
+ (insert call)
+ (funcall sweeprolog-new-predicate-location-function
+ functor arity neck)
+ (setq pred-beg (1+ (point)))
+ (insert "\n" head " " neck "\n" body ".\n")
+ (setq pred-end (point))
+ (indent-region-line-by-line pred-beg pred-end)
+ (goto-char pred-beg))
+ (deactivate-mark)
+ (when all
+ (save-excursion
+ (goto-char (point-min))
+ (let ((sweeprolog-query-replace-term-include-match-function
+ (pcase-lambda (`(,beg ,end . ,_))
+ (not (<= pred-beg beg end pred-end)))))
+ (sweeprolog-query-replace-term
+ body head "true" '(goal)))))
+ (sweeprolog-analyze-buffer)))))))
(defun sweeprolog-maybe-extract-region-to-predicate (_point arg)
(when (and (use-region-p)
- [nongnu] elpa/sweeprolog updated (0dd67eba55 -> 6431074ee1), ELPA Syncer, 2023/10/07
- [nongnu] elpa/sweeprolog ebd42adc30 1/9: ; Recognize ext-quantified goal positions as callable, ELPA Syncer, 2023/10/07
- [nongnu] elpa/sweeprolog 38d1326fee 2/9: ; Fix precedence calculation for unary operator arguments, ELPA Syncer, 2023/10/07
- [nongnu] elpa/sweeprolog 52b1f46bbb 4/9: ; Remove unused function 'sweeprolog-token-boundaries', ELPA Syncer, 2023/10/07
- [nongnu] elpa/sweeprolog abcafbc720 5/9: ; * sweeprolog.el (sweeprolog-query-replace-term): Update comment, ELPA Syncer, 2023/10/07
- [nongnu] elpa/sweeprolog 2bca5fbdc2 6/9: ; Improve user option docstring, ELPA Syncer, 2023/10/07
- [nongnu] elpa/sweeprolog 6431074ee1 9/9: Announce recent changes in NEWS.org and bump version to 0.25.3, ELPA Syncer, 2023/10/07
- [nongnu] elpa/sweeprolog 622c914dfd 3/9: ; New helper predicate 'pos_bounds/3', ELPA Syncer, 2023/10/07
- [nongnu] elpa/sweeprolog 6a9bfd3651 7/9: ENHANCED: Improve 'sweeprolog-extract-region-to-predicate',
ELPA Syncer <=
- [nongnu] elpa/sweeprolog 6c1017d637 8/9: ; Fix excluding new predicate body from replacement after extraction, ELPA Syncer, 2023/10/07