34
35:- module(ref_scenarios,
36 [rename_variable/3,
37 rename_variables/2,
38 underscore_singletons/1,
39 anonymize_singletons/1,
40 anonymize_underscore_multi/1,
41 anonymize_all_singletons/1,
42 new_name/3,
43 fix_multi_singletons/1,
44 anonymize_term_singletons/2,
45 replace_term_id/3,
46 unfold_goal/2,
47 rename_predicate/3,
48 rename_functor/3,
49 remove_useless_exports/1,
50 remove_underscore_multi/1,
51 replace_conjunction/3,
52 replace_conjunction/4,
53 call_to_predicate/3,
54 reformat_sentence/2,
55 reformat_sentence/3,
56 move_term/4,
57 move_term/8,
58 remove_call/2,
59 remove_call/3
60 ]). 61
62:- use_module(library(lists)). 63:- use_module(library(occurs)). 64:- use_module(library(ordsets)). 65:- use_module(library(option)). 66:- use_module(library(pairs)). 67:- use_module(library(substitute)). 68:- use_module(library(option_utils)). 69:- use_module(library(ref_context)). 70:- use_module(library(ref_message)). 71:- use_module(library(ref_replace)). 72:- use_module(library(ref_replacers)). 73:- use_module(library(clambda)). 74:- use_module(library(list_sequence)). 75:- use_module(library(qualify_meta_goal)). 76:- use_module(library(prolog_clause), []). 77
78:- meta_predicate
79 apply_var_renamer(2, :),
80 rename_variable(?,+,:),
81 remove_useless_exports(:),
82 unfold_goal(0,+),
83 underscore_singletons(:),
84 anonymize_underscore_multi(:),
85 remove_underscore_multi(:),
86 anonymize_all_singletons(:),
87 anonymize_term_singletons(+,:),
88 anonymize_singletons(:),
89 fix_multi_singletons(:),
90 rename_variables(+,:),
91 rename_functor(+,+,:),
92 replace_term_id(+,+,:). 93
97remove_useless_exports(MO:Options1) :-
98 select_option(module(M), Options1, Options, M),
99 replace_sentence((:-module(M,L)), (:- module(M,N)),
100 ( include(being_used(M), L, N),
101 L \= N
102 ), MO:[module(M)|Options]),
103 replace_sentence((:-export(K)), Exp,
104 ( once(list_sequence(L, K)),
105 include(being_used(M), L, N),
106 ( N = [] -> Exp = []
107 ; L \= N, list_sequence(N,S), Exp = (:- export(S))
108 )
109 ), MO:[module(M)|Options]).
110
111being_used(M, F/A) :-
112 functor(H, F, A),
113 predicate_property(C:H, imported_from(M)), C \== user.
114
115apply_var_renamer(Renamer, MO:Options1) :-
116 foldl(select_option_default,
117 [variable_names(Dict)-Dict],
118 Options1, Options),
119 replace_term(Var, '$VAR'(Name),
120 ( var(Var),
121 member(Name1 = Var1, Dict),
122 Var1==Var
123 ->call(Renamer, Name1, Name),
124 \+ memberchk(Name=_, Dict)
125 ),
126 MO:[variable_names(Dict)|Options]).
127
128/*
129apply_var_renamer(Renamer, MO:Options1) :-
130 foldl(select_option_default,
131 [variable_names(Dict)-Dict],
132 Options1, Options),
133 replace_sentence(Sent1, Sent,
134 ( foldl(var_renamer_each(Renamer, Dict), Dict, Sent1, Sent),
135 Sent1 \== Sent
136 ),
137 MO:[variable_names(Dict)|Options]).
138
139var_renamer_each(Renamer, Dict, Name1 = Var1) -->
140 ( { call(Renamer, Name1, Name),
141 \+ memberchk(Name = _, Dict)
142 }
143 ->substitute_value(Var1, '$VAR'(Name))
144 ; []
145 ).
146*/
147
148%! rename_variable(?Name1:atom, +Name:atom, :Options) is det.
149%
150% Rename a variable in a Term, provided that the name is new in such term.
151
152rename_variable(Name1, Name, Options) :-
153 apply_var_renamer([Name1, Name] +\ Name1^Name^true, Options).
154
155underscore_singletons(MO:Options1) :-
156 foldl(select_option_default,
157 [sentence(Sent)-Sent,
158 variable_names(Dict)-Dict],
159 Options1, Options),
160 apply_var_renamer([Dict, Sent] +\ Name1^Name
161 ^( member(Name1=Var, Dict),
162 \+ atom_concat('_', _, Name1),
163 occurrences_of_var(Var, Sent, 1),
164 atom_concat('_', Name1, Name)
165 ), MO:[sentence(Sent), variable_names(Dict)|Options]).
166
167anonymize_underscore_multi(MO:Options1) :-
168 foldl(select_option_default,
169 [sentence(Sent)-Sent,
170 variable_names(Dict)-Dict],
171 Options1, Options),
172 apply_var_renamer([Dict, Sent] +\ Name1^Name
173 ^( member(Name1=Var, Dict),
174 atom_concat('_', Name2, Name1),
175 atom_codes(Name2, [C|_]),
176 char_type(C, csymf),
177 occurrences_of_var(Var, Sent, N),
178 N > 1,
179 Name = '_'
180 ), MO:[sentence(Sent), variable_names(Dict)|Options]).
181
182remove_underscore_multi(MO:Options1) :-
183 foldl(select_option_default,
184 [sentence(Sent)-Sent,
185 variable_names(Dict)-Dict],
186 Options1, Options),
187 apply_var_renamer([Dict, Sent] +\ Name1^Name
188 ^( member(Name1=Var, Dict),
189 atom_concat('_', Name, Name1),
190 atom_codes(Name, [C|_]),
191 char_type(C, csymf),
192 occurrences_of_var(Var, Sent, N),
193 N > 1,
194 ( member(Name=_, Dict)
195 ->refactor_message("Cannot rename ~w to ~w since it already exists",
196 [Name1, Name]),
197 fail
198 ; true
199 )
200 ), MO:[sentence(Sent), variable_names(Dict)|Options]).
201
202anonymize_all_singletons(MO:Options1) :-
203 foldl(select_option_default,
204 [sentence(Sent)-Sent,
205 variable_names(Dict)-Dict],
206 Options1, Options),
207 apply_var_renamer([Dict, Sent] +\ Name1^Name
208 ^( member(Name1=Var, Dict),
209 occurrences_of_var(Var, Sent, 1),
210 Name = '_'
211 ), MO:[sentence(Sent), variable_names(Dict)|Options]).
212
213anonymize_term_singletons(Term, MO:Options1) :-
214 foldl(select_option_default,
215 [sentence(Sent)-Sent,
216 variable_names(Dict)-Dict],
217 Options1, Options),
218 apply_var_renamer([Term, Dict, Sent] +\ Name1^Name
219 ^( member(Name1=Var, Dict),
220 occurrences_of_var(Var, Sent, 1),
221 \+ occurrences_of_var(Var, Term, 0 ),
222 Name = '_'
223 ), MO:[sentence(Sent), variable_names(Dict)|Options]).
224
225anonymize_singletons(MO:Options1) :-
226 foldl(select_option_default,
227 [sentence(Sent)-Sent,
228 variable_names(Dict)-Dict],
229 Options1, Options),
230 apply_var_renamer([Dict, Sent] +\ Name1^Name
231 ^( member(Name1=Var, Dict),
232 \+ atom_concat('_', _, Name1),
233 occurrences_of_var(Var, Sent, 1),
234 Name = '_'
235 ), MO:[sentence(Sent), variable_names(Dict)|Options]).
236
237:- meta_predicate new_name(1, +, -). 238new_name(AlreadyUsedName, Name, Name) :-
239 \+ call(AlreadyUsedName, Name), !.
240new_name(AlreadyUsedName, Name1, Name) :-
241 new_name_rec(AlreadyUsedName, 2, Name1, Name).
242
243new_name_rec(AlreadyUsedName, Idx, Name1, Name) :-
244 atomic_concat(Name1, Idx, Name),
245 \+ call(AlreadyUsedName, Name), !.
246new_name_rec(AlreadyUsedName, Idx1, Name1, Name) :-
247 succ(Idx1, Idx),
248 new_name_rec(AlreadyUsedName, Idx, Name1, Name).
249
250fix_multi_singletons(MO:Options1) :-
251 foldl(select_option_default,
252 [sentence(Sent)-Sent,
253 variable_names(Dict)-Dict],
254 Options1, Options),
255 apply_var_renamer([Dict, Sent] +\ Name1^Name
256 ^( member(Name1=Var, Dict),
257 atom_concat('_', Name2, Name1),
258 occurrences_of_var(Var, Sent, N),
259 N > 1,
260 new_name([Dict]+\ X^member(X=_, Dict), Name2, Name)
261 ), MO:[sentence(Sent), variable_names(Dict)|Options]).
262
263rename_variables(RenameL, Options) :-
264 apply_var_renamer([RenameL] +\ Name1^Name^member(Name1=Name, RenameL),
265 Options).
266
267rename_functor(Functor/Arity, NewName, Options) :-
268 functor(Term, Functor, Arity),
269 Term =.. [_|Args],
270 Into =.. [NewName|Args],
271 replace_term_id(Term, Into, Options).
272
273replace_term_id(Term, Into, Options) :-
274 replace_term(Term, Into, Options),
275 functor(Term, F1, A1),
276 functor(Into, F, A),
277 replace_term(F1/A1, F/A, Options).
278
280:- meta_predicate rename_predicate(+,+,:). 281rename_predicate(M:Name1/Arity, Name, Options1) :-
282 functor(H1, Name1, Arity),
283 H1 =.. [Name1|Args],
284 H =.. [Name|Args],
285 select_option(module(CM), Options1, Options2, CM),
286 merge_options(Options2, [module(CM)], Options),
287 replace_goal(H1, H,
288 ( predicate_property(CM:H1, imported_from(M))
289 ; M = CM
290 ),
291 Options), 292 293 replace_head(H1, H, true, Options),
294 replace_head((M:H1), (M:H), true, Options),
295 replace_term(M:Name1/Arity, M:Name/Arity, Options),
296 replace_term(Name1/Arity, Name/Arity,
297 ( catch(absolute_file_name(Alias, File, [file_type(prolog)]),
298 _, fail),
299 module_property(M, file(File))
300 ),
301 [sentence((:- use_module(Alias, _)))|Options1]),
302 ( CM = M
303 -> 304 305 replace_term(Name1/Arity, Name/Arity, Options)
306 ; true
307 ).
308
309:- dynamic add_import/4. 310
311unfold_body_arg(IM, CM, Spec, Arg1, Arg) :-
312 nonvar(Arg1),
313 ( integer(Spec)
314 ; Spec = (^)
315 ), !,
316 strip_module(IM:Arg1, NM, Arg2),
317 unfold_body(Arg2, Arg, NM, CM).
318unfold_body_arg(_, _, _, Arg, Arg).
319
320:- use_module(library(mapargs)). 321:- init_expansors. 322
323unfold_body(M:Body1, Body, _, CM) :- !, unfold_body(Body1, Body, M, CM).
324unfold_body(Body1, Body, IM, CM) :-
325 ( CM == IM
326 ->Body = Body1
327 ; predicate_property(IM:Body1, implementation_module(IM1)),
328 ( predicate_property(CM:Body1, defined)
329 ->predicate_property(CM:Body1, implementation_module(IM2))
330 ; predicate_property(IM:Body1, exported)
331 ->IM2 = IM1,
332 functor(Body1, F, A),
333 assertz(add_import(CM, IM1, F, A))
334 ; IM2 = CM
335 )
335,
336 ( predicate_property(IM:Body1, meta_predicate(Meta)),
337 arg(_, Meta, Spec),
338 ( integer(Spec)
339 ; Spec = (^)
340 )
341 ->functor(Body1, F, A),
342 functor(Body2, F, A),
343 mapargs(unfold_body_arg(IM, CM), Meta, Body1, Body2)
344 ; Body2 = Body1
345 ),
346 ( IM1 \= IM2
347 ->Body = IM:Body2
348 ; Body = Body2
349 )
350 )
350.
351
352:- use_module(library(infer_alias)). 353
354rsum(Module, UML) :-
355 findall(Import-(F/A), retract(add_import(Module, Import, F, A)), Pairs),
356 Pairs \= [],
357 sort(Pairs, Sorted),
358 group_pairs_by_key(Sorted, Grouped),
359 findall(UM,
360 ( member(Import-IL, Grouped),
361 module_property(Import, file(IFile)),
362 smallest_alias(IFile, IA),
363 UM = '$@'(:- use_module(IA, '$C'((nl,write('\t ')),'$LIST,NL'(IL))))
364 ), UML).
365
366is_member(VarL, E) :-
367 member(V, VarL),
368 V == E, !.
369
370set_new_name(VNBody, VN, V) :-
371 ( member(Name1=V1, VNBody),
372 V1 == V
373 ->( ( Name = Name1
374 ; between(2, inf, Count),
375 atomic_concat(Name1, Count, Name)
376 ),
377 \+ member(Name=_, VN)
378 ->V = '$VAR'(Name)
379 )
380 ; true 381 ).
382
383match_clause_head_body((Head :- Body), _:Head, Body) :- !.
384match_clause_head_body((M:Head :- Body), M:Head, Body) :- !.
385match_clause_head_body(Head, Head, true).
386
387:- meta_predicate qualify_meta_call(0, ?, -). 388
389qualify_meta_call(M:Goal1, CM, M:Goal) :-
390 qualify_meta_call(Goal1, M, CM, true, Goal).
391
393unfold_goal(MGoal, MO:Options1) :-
394 MGoal = M:Goal,
395 strip_module(MGoal, M, Goal),
396 select_option(module(Module), Options1, Options, Module),
397 qualify_meta_call(MGoal, Module, MMeta),
398 retractall(add_import(_, _, _, _)),
399 replace_goal(Goal, '$BODY'(Body),
400 ( findall(clause(MMeta, Body1, CM, VNBody),
401 ( clause(MMeta, _, Ref),
402 clause_property(Ref, line_count(Line)),
403 clause_property(Ref, file(File)),
404 clause_property(Ref, module(CM)),
405 prolog_clause:read_term_at_line(File, Line, CM, Clause, _, VNBody),
406 match_clause_head_body(Clause, MMeta, Body1) 407 ), [clause(MMeta, Body1, CM, VNBody)]),
408 unfold_body(Body1, Body, CM, Module),
409 term_variables(Body, VarL),
410 term_variables(VN, VarS),
411 exclude(is_member(VarS), VarL, NewVarL),
412 maplist(set_new_name(VNBody, VN), NewVarL)
413 ),
414 MO:[module(Module), variable_names(VN)|Options]),
415 replace_sentence((:- use_module(Alias, L1)), [(:- use_module(Alias, '$LISTB,NL'(L)))],
416 ( catch(absolute_file_name(Alias, IFile, [file_type(prolog)]),
417 _,
418 fail),
419 module_property(Import, file(IFile)),
420 findall(F/A, retract(add_import(Module, Import, F, A)), UL),
421 UL \= [],
422 sort(UL, L2),
423 append(L1, L2, L)
424 ),
425 MO:[module(Module)|Options]),
426 replace_sentence((:- module(Module, L)), [(:- module(Module, L))|UML],
427 rsum(Module, UML),
428 MO:[module(Module)|Options]).
435:- meta_predicate remove_call(+,0,:). 436remove_call(Call, Expander, Options) :-
437 replace_term(Term, Into,
438 ( refactor_context(pattern, P),
439 do_remove_call(Call, Term, P, X),
440 Expander,
441 refactor_context(into, X),
442 copy_term(P-X, Term-Into)
443 ), Options).
444
445:- meta_predicate remove_call(+,:). 446remove_call(Call, Options) :-
447 remove_call(Call, true, Options).
448
449do_remove_call(Call, Term, P, X) :-
450 ( subsumes_term((_ :- Call), Term),
451 P = (X :- _),
452 Term = (_ :- Call)
453 ; subsumes_term((Call, _), Term),
454 P = (_, X),
455 Term = (Call, _)
456 ; subsumes_term((_, Call), Term),
457 P = (X, _),
458 Term = (_, Call)
459 ; subsumes_term(Call, Term),
460 refactor_context(sentence, Sent),
461 Term \== Sent,
462 X = true,
463 Term = Call
464 ).
465
466:- meta_predicate replace_conjunction(?, ?, 0, :). 467replace_conjunction(Conj, Repl, Expander, MO:Options1) :-
468 replace_last_literal(Conj, Conj2, CLit, CBody),
469 replace_last_literal(Repl, Repl1, RLit, RBody),
470 add_body_hook_if_needed(Conj, Repl1, Repl2),
471 copy_term(t(Conj2, CLit, CBody, Repl2, RLit, RBody), Term),
472 copy_term(Conj, ConjP),
473 foldl(select_option_default,
474 [decrease_metric(Metric)-(ref_scenarios:conj_pattern_size(ConjP))],
475 Options1, Options),
476 replace(body_rec, Conj2, Repl2,
477 ( bind_lit_body(Term, Conj2, CLit, CBody, RLit, RBody),
478 Expander
479 ), MO:[decrease_metric(Metric)|Options]).
480
481:- public conj_pattern_size/4. 482conj_pattern_size(Conj, Term, _, Size) :-
483 ref_replace:pattern_size(Term, Conj, Size).
484
485add_body_hook_if_needed(Conj, Repl1, Repl) :-
486 ( var(Conj)
487 ; Conj \= (_, _)
488 ), !,
489 ( ( var(Repl1)
490 ; Repl1 \= (_, _)
491 )
492 ->Repl = Repl1
493 ; Repl = '$BODYB'(Repl1)
494 ).
495add_body_hook_if_needed((_, Conj), Repl1, Repl) :-
496 ( ( var(Repl1)
497 ; Repl1 \= (_, _)
498 )
499 ->Repl = Repl1
500 ; Repl1 = (RLit, Repl2),
501 Repl = (RLit, Repl3),
502 add_body_hook_if_needed(Conj, Repl2, Repl3)
503 ).
504
505:- meta_predicate replace_conjunction(?, ?, :). 506replace_conjunction(Conj, Replacement, Options) :-
507 replace_conjunction(Conj, Replacement, true, Options).
508
509replace_last_literal(Conj, Body, Conj, Body) :- var(Conj), !.
510replace_last_literal((A, Conj), (A, Conj2), Lit, Body) :- !,
511 replace_last_literal(Conj, Conj2, Lit, Body).
512replace_last_literal(Conj, Body, Conj, Body).
513
514bind_lit_body(Term, Conj2, CLit, CBody, RLit, RBody) :-
515 ( subsumes_term(Conj2-CLit, Conj2-CBody)
516 ->CBody = CLit,
517 RBody = RLit,
518 PCBody = PCLit,
519 PRBody = PRLit
520 ; subsumes_term(Conj2-(CLit, Rest), Conj2-CBody)
521 ->CBody = (CLit, Rest),
522 RBody = (RLit, Rest) $@ CBody,
523 PCBody = (PCLit, PRest),
524 PRBody = (PRLit, PRest) $@ PCBody
525 ),
526 Term = t(Conj, PCLit, PCBody, Repl, PRLit, PRBody),
527 refactor_context(pattern, Conj),
528 refactor_context(into, Repl).
529
530:- dynamic
531 new_pred/3. 532
533call_to_predicate(Term, Suffix, OptL) :-
534 replace(body_rec, Term,
535 '$LIST'([Pred,
536 '$NOOP'('$G'('$PRIORITY'('$CLAUSE'(Pred :- Term), 1200),
537 ref_scenarios:ctp_1(F, Sent)))]),
538 ( substitute_value(Term, -, Sent, STrm),
539 term_variables(STrm, SVarU),
540 term_variables(Term, TVarU),
541 sort(SVarU, SVarL),
542 sort(TVarU, TVarL),
543 ord_intersect(SVarL, TVarL, ArgL),
544 Sent = (Head :- _),
545 functor(Head, Prefix, _),
546 atomic_list_concat([Prefix, '_', Suffix], Name),
547 Pred =.. [Name|ArgL]
548 ), [file(F), fixpoint(none), sentence(Sent)|OptL]),
549 findall(File, new_pred(File, _, _), FileU),
550 sort(FileU, FileL),
551 replace_sentence(Sent, ['$TEXT'(S), Sent],
552 retract(new_pred(File, Sent, S)),
553 [file(F), files(FileL), sentence(Sent)|OptL]).
554
555:- public
556 ctp_1/4. 557
558ctp_1(F, (H:-_), S, _) :- assertz(new_pred(F, (H:-_), S)), fail.
559
560sentence_format(Clause, '$CLAUSE'(Clause)).
561
562:- meta_predicate reformat_sentence(?, 0, :). 563reformat_sentence(Term, Expander, Options) :-
564 replace_sentence(Term, Formatted,
565 ( duplicate_term(Term, Copy),
566 sentence_format(Copy, Formatted),
567 Copy = Term,
568 Expander
569 ),
570 Options).
571
572:- meta_predicate reformat_sentence(?, :). 573reformat_sentence(Term, Options) :-
574 reformat_sentence(Term, true, Options).
575
576:- dynamic
577 subtext_db/1. 578
579:- public record_text/0. 580
581record_text :-
582 refactor_context(text, Text),
583 refactor_context(subpos, SubPos),
584 arg(1, SubPos, From),
585 arg(2, SubPos, To),
586 ref_replace:get_subtext(Text, From, To, SubText),
587 assertz(subtext_db(SubText)).
588
589:- meta_predicate move_term(?,?,+,0,+,0,+,+). 590
591move_term(Term, SourceOpts, TargetOpts, CommonOpts) :-
592 move_term(Term, [], end_of_file, true, SourceOpts, true, TargetOpts, CommonOpts).
593
594move_term(Term, Into, AddAt, SourceCond, SourceOpts, TargetCond, TargetOpts, CommonOpts) :-
595 merge_options(SourceOpts, CommonOpts, SOptions),
596 merge_options([fixpoint(true)|TargetOpts], CommonOpts, TOptions),
597 replace_sentence(Term,
598 '$C'(ref_scenarios:record_text, Into),
599 SourceCond,
600 SOptions),
601 replace_sentence(AddAt, '$TEXT'(SubText),
602 ( retract(subtext_db(SubText)),
603 TargetCond
604 ),
605 TOptions)