1:- module(misc, [
2 compile_pred_word/4
3 , random_choice/2
4 , collect_subterm/3
5 , collect_subterm/4
6 , completing_optional_args/3
7 , cs/2
8 , desugaring/2
9 , dir_minus/3
10 , dir_plus/3
11 , directory_files/3
12 , directory_remove_ymhms/1
13 , drop3zw/2
14 , find_exportables_from_calls/2
15 , ignore/2
16 , insert/3
17 , insert_pause/2
18 , kanji/3
19 , list/2
20 , map_directory_files/2
21 , matrix_paths/2
22 , parse_time/3
23 , parse_utf8/2
24 , predicate_arity/2
25 , predicate_arity_for_export/2
26 , rename_directory_suffix/3
27 , set/2
28 , split_by_filler/3
29 , string/2
30 , shell_string/2, shell_string/3, qshell_string/2
31 , texadjust/2
32 , texuncomment/2
33 , token_and_split/3
34 , try2problem/2
35 , expand_sgn_brace/2 ]). 36
37:- use_module(pac(basic)). 38:- use_module(util(file)). 39:- use_module(util('meta2')). 40:- use_module(util(math)). 41:- use_module(pac('expand-pac')). 42:- use_module(pac('expand-word')). 43:- use_module(pac(op)). 44term_expansion --> pac:expand_pac.
46
47
48 51
52new_names([V|Vs], [A=V|Eqs], N, Prefix, As):-
53 new_name(N, As, A, Prefix, K),
54 new_names(Vs, Eqs, K, Prefix, As).
55new_names([], [], _, _, _).
56
58new_name(N, As, B, Prx, K):- atom_concat(Prx, N, B),
59 \+ memberchk(B, As),
60 !,
61 succ(N, K).
62new_name(N, As, A, Prx, K):- succ(N, N1),
63 new_name(N1, As, A, Prx, K).
64
66subtractq([], _, []).
67subtractq([A|As], B, C):- memq(A, B), !,
68 subtractq(As, B, C).
69subtractq([A|As], B, [A|C]):- subtractq(As, B, C).
70
72expand_clause_slim(X, Y):-
73 expand_clause(X, [], Y0),
74 maplist(pred([X:-true, X] & [C, C]), Y0, Y).
76compile_pred_word(X-->X0, Eqs, H0, R0):-!,
77 maplist(pred([A=P, A, P]), Eqs, As, Vs),
78 expand_clause_slim(X-->X0, [H|R]),
79 term_variables(H, HVs),
80 subtractq(HVs, Vs, SVs),
81 new_names(SVs, Eqs0, 1, 'A', As),
82 append(Eqs0, Eqs, Eqs1),
83 term_string(H, H0, [variable_names(Eqs1),
84 quoted(true)]),
85 maplist(pred(([U, [V,".\n"]] :-
86 numbervars(U, 0, _),
87 term_string(U, V, [ numbervars(true),
88 quoted(true)]))),
89 R, R0).
90compile_pred_word(X, Eqs, H0, R0):-
91 expand_clause_slim(X, [H|R]),
92 term_string(H, H0, [variable_names(Eqs),
93 quoted(true)]),
94 maplist(pred(([U, [V,".\n"]] :-
95 numbervars(U, 0, _),
96 term_string(U, V, [ numbervars(true),
97 quoted(true)]))),
98 R, R0).
99
100
101
115
128
129shell_infix(L / R, L, /, R).
130shell_infix(L ; R, L, ;, R).
131shell_infix('|'(L,R), L, '|', R).
132shell_infix(L > R, L, >, R).
133shell_infix(L >> R, L, >>, R).
134shell_infix(L << R, L, <<, R).
135shell_infix(&(L, R), L, &, R).
136shell_infix(&&(L, R), L, &&, R).
138qshell_string(X, Y):- shell_string(X, " > /dev/null 2>&1", Y).
140shell_string(X, Y):- shell_string(X, "", Y).
142shell_string([], Z, Z):-!.
143shell_string([X], Y, Z):-!, shell_string(X, Y, Z).
144shell_string([X,Y|Z], U, V):-!, shell_string([Y|Z], U, W),
145 string_concat(" ", W, W0),
146 shell_string(X, W0, V).
147shell_string(A+B, X, Y):-!, shell_string(B, X, X0),
148 shell_string(A, X0, Y).
149shell_string(-A, X, Y):-!, shell_string("-" + A, X, Y).
150shell_string(--(A), X, Y):-!, shell_string("--" + A, X, Y).
151shell_string(A, X, Y):- shell_infix(A, L, F, R), !,
152 shell_string(R, X, X0),
153 string_concat(F, X0, X1),
154 shell_string(L, X1, Y).
155shell_string({A}, X, Y):-!, shell_string("( " + A + " )", X, Y).
156shell_string(shell(A), X, Y):-!, shell_string({A}, X, Y).
157shell_string(A, X, Y):- compound(A), !,
158 A =.. B,
159 shell_string(B, X, Y).
160shell_string(A, X, Y):- atomic(A), string_concat(A, X, Y).
161
162
163 166
176completing_optional_args(X, Y, Z):-
177 completing_optional_args(X, Y, Z, []).
178
183
184completing_optional_args([], R, R, []):-!.
185completing_optional_args([A|As], Bs, [B|R], R0):- (A = A0:_ ; A0= A), !,
186 functor(A0, F, 1),
187 functor(B, F, 1),
188 ( select(B, Bs, Cs); Cs = Bs ), !,
189 unify_one(A, B),
190 completing_optional_args(As, Cs, R, R0).
191
194:- set_prolog_flag(open_dict, false). 195unify_default({G}, _):-!, once(G).
196unify_default(X, X).
197:- set_prolog_flag(open_dict, true). 198
200unify_one(A:Val, B):- !, functor(A, F, 1),
201 functor(B, F, 1),
202 arg(1, A, U),
203 arg(1, B, V),
204 ( var(V) -> U = Val, 205 V = U
206 ; var(U) -> U = V
207 ; true
208 ).
209unify_one(A, A):-!.
210unify_one(_, _).
211
212
221
222set(emptyset,[]):-! .
223set(X,X):-listp(X),! .
224set(singleton(A),[B]):-!,set(A,B) .
225set(A+B,A1):-!,(set(A,A2),set(B,A3)),union(A2,A3,A1) .
226set(plus(A,B),A1):-!,set(A+B,A1) .
227set(cup(A),A1):-!,(set(A,A2),set(append(A2),A3)),sort(A3,A1) .
228set(cap(A),A1):-!,set(A,A2),math:bigcap(A2,A1) .
229set(++(A,B),A1):-!,(set(A,A2),set(B,A3)),math:direct_sum(A2,A3,A1) .
230set(A*B,A1):-!,(set(A,A2),set(B,A3)),math:product(A2,A3,A1) .
231set(A-B,A1):-!,(set(A,A2),set(B,A3)),
232 pac_meta:pac_product(misc:set_aux,A2,A3,A1) .
233set(\(A,B),A1):-!,(set(A,A2),set(B,A3)),subtract(A2,A3,A1) .
234set(#(A,B),A1):-!,(set(A,A2),set(B,A3)),scramble_cons(A2,A3,A1) .
235set(&(A,B),A1):-!,(set(A,A2),set(B,A3)),math:intersection(A2,A3,A1) .
236set(pow(A),A1):-!,set(A,A2), math:powerset(A2,A1) .
237set(zip(A,B),A1):-!,(set(A,A2),set(B,A3)),zip(A2,A3,A1) .
238set(sort(A),A1):-!,set(A,A2),sort(A2,A1) .
239set((A->B),A1):-!,(set(A,A2),set(B,A3)),math:mapset(A2,A3,A1) .
240set(..(I,J),A1):-(I0 is I,J0 is J),!,numlist(I0,J0,A1) .
241set(in(X,Y),A1):-!,(set(X,A2),set(Y,A3)),truth(memberchk,A2,A3,A1) .
242set(X=Y,A1):-!,(set(X,A2),set(Y,A3)),truth(==,A2,A3,A1) .
243set(X=<Y,A1):-!,(set(X,A2),set(Y,A3)),truth(subset,A2,A3,A1) .
244set(X>=Y,A1):-!,set(Y=<X,A1) .
245set(X<Y,A1):-!,(set(X,A2),set(Y,A3)),truth(math:proper_subset,A2,A3,A1) .
246set(X>Y,A1):-set(Y<X,A1) .
247
249set_aux(A,B,A-B).
256insert(M, [A|P], [A|Q]):- foldl(pred(M, [B, [M, B| U], U]), P, Q, []).
257insert(_, [], []).
258
260truth(X, true) :- call(X), !.
261truth(_, false).
262
263truth(X, Y, true) :- call(X, Y), !.
264truth(_, _, false).
265
266truth(X, Y, Z, true) :- call(X, Y, Z), !.
267truth(_, _, _, false).
274
275desugaring(X-Y,A1+ -1*A2):-!,desugaring(X,A1),desugaring(Y,A2).
276desugaring(+X,A1):-!,desugaring(X,A1).
277desugaring(-X,-1*A1):-!,desugaring(X,A1).
278desugaring(X/Y,A1 rdiv A2):-!,desugaring(X,A1),desugaring(Y,A2).
279desugaring(X,X).
280
281insert_pause(cs(item),[cs(pause),cs(item)]):-! .
282insert_pause(X,A1):-(listp(X),maplist(insert_pause,X,Y)),!,insert_pause(Y,A1) .
283insert_pause(X,A1):-(X=..[F|As],maplist(insert_pause,As,Bs),Z=..[F|Bs]),!,
284 insert_pause(Z,A1).
285
286texadjust([cs(item)|X],A1):-texadjust(X,Y),!,texadjust([10,cs(item)|Y],A1) .
287
288cs(cs(N),[N]):-!.
289cs(A,A1):-listp(A),!,maplist(cs,A,A1) .
290cs(A,A1):-A=..[_A2|As], maplist(cs,As,A1) .
291
(comment(_A1),[]).
293
294try2problem(env(try,Body),A1):-try2problem(Body,A2),try2problem(env(problem,A2),A1).
295
296drop3zw(ddol(E),[cs(noindent),cs(skip),"3zw",env(coronamath,[dol([cs(displaystyle)," ",E])])]).
297
298
299
303
306
309
315
328
329matrix_paths([], [[]]).
330matrix_paths([X|Y], Z):- matrix_paths(Y, PY),
331 foldr(pred(PY, [J, P, Q]:-
332 foldr(pred(J, [K, N, [[J|K]|N]]), PY, P, Q)),
333 X, [], Z).
334
335
339
358
359random_choice([L|R], [A|Q]):- length(L, N), I is random(N),
360 nth0(I, L, A),
361 random_choice(R, Q).
362random_choice([], []).
374
375list(A+B,A1):-!, list(A,A2),
376 list(B,A3),
377 append(A2,A3,A1).
378list(\(A,B),Z):-!, list(A,X),list(B,Y), append(X,Z,Y) .
379list(A/B,Z):-!, list(A,X),list(B,Y), append(Z,Y,X) .
380list(E^L,A1):-N is L,!,list(E,A2),times(N,A2,A1) .
381list(^^(E,L),C):-N is L,!,list(E,A),math:nlist(A,N,C) .
382list(X,X):-listp(X),! .
383list(+A,A1):-!,list(A,A2), append(A2,A1) .
384list(flat(A),A1):-list(A,A2),flatten(A2,A1) .
397
398string(A+B,A1):-!, string(A,A2),
399 string(B,A3),
400 string_concat(A2,A3,A1).
401string(\(A,B),Z):-!, string(A,X),
402 string(B,Y),
403 string_concat(X,Z,Y).
404string(A/B,Z):-!, string(A,X),
405 string(B,Y),
406 string_concat(Z,Y,X).
407string(E^L,A1):-N is L,!,string(E,A2),
408 string_times(N,A2,A1) .
409string(reverse(X),B):-!, string(X,A1),
410 string_codes(A1,A2),
411 reverse(A2,A),
412 string_codes(B,A).
413string(+A,A1):-!, string(A,A2),
414 list(A2,A3),
415 string_list_concat(A3,A1).
416string(X,X):-(string(X);atom(X)),!.
417
418
420split_by_filler(X) --> filler, token_and_split(X).
422token_and_split([]) --> current([]).
423token_and_split([A|X]) --> wl("[^\s\t\r\n]+", A, []), split_by_filler(X).
424
426filler --> filler(_, _).
428filler(X, Y) --> wl("[\s\t\n\r]*", X, Y).
430delimiter_plus --> wl(+("[\t\r\n]" | "\s\s+"), _, _).
432delimiter_plus(X, Y) --> wl(+("[\t\r\n]" | "\s\s+"), X, Y).
433
434
435
450
451split_plus(X) --> split_plus(X, []).
453split_plus(X, Y) --> filler, !, words(X, Y).
455words(X, X) --> current([]), !.
456words([[C|W]|Xs], Y) --> [C], word_tail(W), words(Xs, Y).
458word_tail([]) --> filler, current([]), !.
459word_tail([]) --> delimiter_plus, !.
460word_tail([C|W]) --> [C], word_tail(W).
461
467
468pred_split(Filler, Delimiter, X) -->
469 { pac_word:let_wl(F, Filler),
470 pac_word:let_wl(D, Delimiter)
471 },
472 pred_split(F, D, X, []).
474pred_split(F, D, X, Y) --> call(F), !, words(F, D, X, Y).
476words(_, _, X, X) --> current([]), !.
477words(F, D, [[C|W]|Xs], Y) --> [C], word_tail(F, D, W), words(F, D, Xs, Y).
479word_tail(F, _, []) --> call(F), current([]), !.
480word_tail(_, D, []) --> call(D), !.
481word_tail(F, D, [C|W]) --> [C], word_tail(F, D, W).
482
483
515
521
523:- meta_predicate directory_files(2,?,?). 524directory_files(E, Ds, L):-
525 maplist(pred([D, D0]:-expand_file_name(D, [D0])), Ds, Es),
526 maplist(directory_files, Es, Ls),
527 call(E, Ls, L).
528
529:- meta_predicate map_directory_files(1, ?). 530map_directory_files(F, D):- directory_files(D, Fs),
531 working_directory(D0, D),
532 maplist(ignore(F), Fs),
533 working_directory(_, D0).
534
535ignore(F, X):- ignore(call(F, X)).
536
539directory_remove_ymhms(D):- expand_file_name(D, [D0]),
540 map_directory_files(pred(([X]:-
541 atom_codes(X, X0),
542 parse_time_me(".pdf", X0, Y0),
543 atom_codes(Y,Y0),
544 rename_file(X, Y) )),
545 D0).
546
549
550parse_time(Ext) -->
551 w(*(char(digit)), Year), "å¹´",
552 w(*(char(digit)), Month), "æ",
553 w(*(char(digit)), Day), "æ¥",
554 w(*(char(digit)), Hour), "æ",
555 w(*(char(digit)), Minute), "å",
556 w(*(char(digit)), Second), "ç§",
557 ".",
558 w(*(.), Ext),
559 current([]),
560 { append([Year, Month, Day, Hour, Minute, Second, `.`, Ext], Y) },
561 peek(Y).
562
563% ?- dir_minus('~/Desktop', '~/Desktop', Z).
564% ?- dir_minus('~', '~/Desktop', Z).
565% ?- dir_minus('~', '~', Z).
566dir_minus(X,Y,Z):- directory_files(fun([[A,B]]-> (set::(A\B))), [X, Y], Z).
567dir_plus(X,Y,Z):- directory_files(fun([[A,B]]-> (set::(A+B))), [X, Y], Z).
568
570rename_directory_suffix(Suffix0, Suffix, Dir):-
571 expand_file_name(Dir, [Dir0]),
572 map_directory_files(
573 pred([Suffix0,Suffix], [X]:- ( atom_concat(X0, Suffix0, X),
574 atom_concat(X0, Suffix, Y),
575 rename_file(X, Y)
576 )),
577 Dir0).
578
579:- meta_predicate collect_subterm(1,?,?). 580
581collect_subterm(F, X, Y):- collect_subterm(X, Y0, [], F), sort(Y0, Y).
582
584collect_subterm(X, [X|V], V, F):- call(F, X), !.
585collect_subterm(X, V, W, F):- compound(X), !,
586 X=..[_|As],
587 foldr( pred(F, [A, P, Q] :- collect_subterm(A, P, Q, F), As, V, W)).
588collect_subterm(_, V, V, _).
589
600
605
607predicate_arity(F, L):-
608 setof(P/N,
609 A^X^( predicate_property(A:X, file(F)),
610 functor(X, P, N)
611 ),
612 L),
613 insert(", ", L, L0),
614 smash(["[", L0, "]"]).
615
617predicate_arity_for_export(F, L):-
618 writeln('start ...'),
619 assert_call_graph,
620 writeln('call graph done'),
621 find_exportables_from_calls(F, L).
622
624
625
627
628find_exportables_from_calls(Loc, Exp):-
629 predicate_arity(Loc, L0),
630 setof(F/N, P^X^(
631 member(F/N, L0),
632 functor(P, F, N),
633 once(calls(X, user:P)),
634 \+ predicate_property(X, file(Loc))
635 ),
636 Exp),
637 insert(",\n", Exp, E),
638 maplist(write, E).
639
640
643
644residue(X-Y,V):-!, residue(X,A),
645 residue(Y,U),
646 append(U,V,A).
647residue(X,X).
648
650parse_utf8 --> sed(kanji(A), =(A)),
651 maplist(pred(([X, Y] :- listp(X), string_codes(Y, X))
652 &
653 ([X, Y] :- char_code(Y, X)))).
654
655kanji(A) --> w(char(utf8b), A, B), wl(*char(utf8c), B).
656
659
668
680
686repeat_line(V, In, Out):- read_line_to_codes(In, A),
687 A \== end_of_file,
688 cgi_bin_name_edit(V, A, B),
689 maplist(put_code(Out), B),
690 put_code(Out, 0'\n), 691 !,
692 repeat_line(V, In, Out).
693repeat_line(_,_,_).
694
695
698expand_sgn_brace(sgn([A,A0|B]),(A1;A2)):-!,
699 expand_sgn_brace(sgn([A]),A1),
700 expand_sgn_brace(sgn([A0|B]),A2).
701expand_sgn_brace(sgn([A]),A1):-!,expand_sgn_brace(A,A1).
702expand_sgn_brace((A,B),(A1,A2)):-!,expand_sgn_brace(A,A1),
703 expand_sgn_brace(B,A2).
704expand_sgn_brace((A;B),(A1;A2)):-!,expand_sgn_brace(A,A1),
705 expand_sgn_brace(B,A2).
706expand_sgn_brace(\+A,\+A1):-!,expand_sgn_brace(A,A1).
707expand_sgn_brace(A/N,A0/N):-!,expand_sgn_brace(A,A0).
708expand_sgn_brace(X,A1):-is_list(X),!,
709 maplist(expand_sgn_brace,X,A1).
710expand_sgn_brace(X,X).
711
713
716
717list_concat(X+Y,A1):-list_concat(X,A2),
718 list_cocnat(Y,A3),
719 append(A2,A3,A1) .
720list_concat(X,X).
721
722
725my_add(X+Y,A1):- my_add(X,A2),
726 my_add(Y,A3),
727 plus(A2,A3,A1).
728my_add(X,X).
729
734
739
743
752
754
763
765
769split_list_at_nth1(Nth1, Long, Start, End) :-
770 ( nonvar(Nth1) -> must_be(nonneg, Nth1), Once = true
771 ; is_list(Long), once(is_list(Start) ; is_list(End)) -> Once = true
772 ; is_list(End), is_list(Start) -> Once = true
773 ; Once = false
774 ),
775 split_list_at_nth1_(Long, 0, Nth1, Once, Start, End).
776
777split_list_at_nth1_(L, N, N, Once, [], L) :-
778 (Once == true -> ! ; true).
779split_list_at_nth1_([H|T], N, Nth1, Once, [H|Upto], End) :-
780 N1 is N + 1,
781 split_list_at_nth1_(T, N1, Nth1, Once, Upto, End)