From: Eshel Yaron Date: Sat, 7 Oct 2023 12:38:45 +0000 (+0200) Subject: ENHANCED: Improve 'sweeprolog-extract-region-to-predicate' X-Git-Tag: V9.1.16-sweep-0.25.3~2 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=6a9bfd36518539c1c5c513e02057a413103f46dc;p=sweep.git 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. --- diff --git a/sweep.pl b/sweep.pl index 6fbf5d7..f1129f4 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 9e581ce..3f1f9c8 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 06f9ec2..ea62e74 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 c1dfd23..e3cb3bb 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)