misc.pl

    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)).   44
   45term_expansion --> pac:expand_pac.
   46%
   47
   48
   49		/***********************************
   50		* Compile clause / DCG with regex  *
   51		***********************************/
   52
   53new_names([V|Vs], [A=V|Eqs], N, Prefix, As):-
   54	new_name(N, As, A, Prefix, K),
   55	new_names(Vs, Eqs, K, Prefix, As).
   56new_names([], [], _, _, _).
   57
   58%
   59new_name(N, As, B, Prx, K):- atom_concat(Prx, N, B),
   60						\+ memberchk(B, As),
   61						!,
   62						succ(N, K).
   63new_name(N, As, A, Prx, K):- succ(N, N1),
   64						new_name(N1, As, A, Prx, K).
   65
   66% ?- ejockey:subtractq([X,Y,X,Y,X,Y], [X], R).
   67subtractq([], _, []).
   68subtractq([A|As], B,  C):- memq(A, B), !,
   69	subtractq(As, B, C).
   70subtractq([A|As], B, [A|C]):- subtractq(As, B, C).
   71
   72%
   73expand_clause_slim(X, Y):-
   74	expand_clause(X, [], Y0),
   75	maplist(pred([X:-true, X] & [C, C]),  Y0, Y).
   76%
   77compile_pred_word(X-->X0, Eqs, H0, R0):-!,
   78		maplist(pred([A=P, A, P]), Eqs, As, Vs),
   79		expand_clause_slim(X-->X0, [H|R]),
   80		term_variables(H, HVs),
   81		subtractq(HVs, Vs, SVs),
   82		new_names(SVs, Eqs0, 1, 'A', As),
   83		append(Eqs0, Eqs, Eqs1),
   84		term_string(H, H0, [variable_names(Eqs1),
   85							quoted(true)]),
   86		maplist(pred(([U, [V,".\n"]] :-
   87								numbervars(U, 0, _),
   88								term_string(U, V, [ numbervars(true),
   89													quoted(true)]))),
   90				R, R0).
   91compile_pred_word(X, Eqs, H0, R0):-
   92		expand_clause_slim(X, [H|R]),
   93		term_string(H, H0, [variable_names(Eqs),
   94							quoted(true)]),
   95		maplist(pred(([U, [V,".\n"]] :-
   96								numbervars(U, 0, _),
   97								term_string(U, V, [ numbervars(true),
   98													quoted(true)]))),
   99				R, R0).
  100
  101
  102			/********************
  103			*     shell string  *
  104			********************/

shell_string(+X:term, -Y:string) is det: Expand a shell command term X into a string that can be passed to shell/1.

  110% ?- shell_string(open("1"), X).
  111% ?- shell_string(open(1), X).
  112% ?- shell_string(open(abc), X).
  113% ?- shell_string(open(-l, -m, abc), X).
  114% ?- shell_string(open(-f(a)), X).
  115% ?- shell_string(open(-f(a)), X).
  116
  117% ?- shell_string(a, Y).
  118% ?- shell_string([[a]], Y).
  119% ?- shell_string([[a],[b]], Y).
  120% ?- shell_string([[a]+[b]], Y).
  121% ?- shell_string(f(-a + b), Y).
  122% ?- shell_string(f(-a + b, -c + d), Y).
  123% ?- shell_string(f(-1 + b, -c + d, e), Y).
  124% ?- shell_string(f(-1,  b, -c + d, e), Y).
  125% ?- shell_string(f(a + b + c + d + e), Y).
  126% ?- shell_string(f(a); g(b), Y).
  127% ?- shell_string(f(1); g(1), Y).
  128% ?- shell_string({f(a); g(b)}, Y).
  129
  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).
  137shell_infix(&&(L, R), L, &&, R).
  138%
  139qshell_string(X, Y):- shell_string(X, " > /dev/null 2>&1", Y).
  140%
  141shell_string(X, Y):- shell_string(X, "", Y).
  142%
  143shell_string([], Z, Z):-!.
  144shell_string([X], Y, Z):-!, shell_string(X, Y, Z).
  145shell_string([X,Y|Z], U, V):-!, shell_string([Y|Z], U, W),
  146	string_concat(" ", W, W0),
  147	shell_string(X, W0, V).
  148shell_string(A+B, X, Y):-!, shell_string(B, X, X0),
  149	shell_string(A, X0, Y).
  150shell_string(-A, X, Y):-!, shell_string("-" + A, X, Y).
  151shell_string(--(A), X, Y):-!, shell_string("--" + A, X, Y).
  152shell_string(A, X, Y):- shell_infix(A, L, F, R), !,
  153	shell_string(R, X, X0),
  154	string_concat(F, X0, X1),
  155	shell_string(L, X1, Y).
  156shell_string({A}, X, Y):-!, shell_string("( " + A + " )", X, Y).
  157shell_string(shell(A), X, Y):-!, shell_string({A}, X, Y).
  158shell_string(A, X, Y):- compound(A), !,
  159	A =.. B,
  160	shell_string(B, X, Y).
  161shell_string(A, X, Y):- atomic(A), string_concat(A, X, Y).
  162
  163
  164		/**********************************
  165		*     compleging optional args    *
  166		**********************************/
  167
  168% ?- completing_optional_args([a(hello)], [], R).
  169% ?- completing_optional_args([a(X):hello], [], R).
  170% ?- completing_optional_args([a(X): !(X=hello)], [], R).
  171% ?- completing_optional_args([a(X):hello], [], R).
  172% ?- completing_optional_args([a(X):hello], [a(world)], R).

completing_optional_args(+X, +Y, -Z) is det: option Z is unified with Y completed with default option X.

  177completing_optional_args(X, Y, Z):-
  178	completing_optional_args(X, Y, Z, []).
  179
  180% ?- zdd_array:completing_optional_args([a(X)], [a(Y)], R, S).
  181% ?- zdd_array:completing_optional_args([a(world)], [a(hello)], R, S).
  182% ?- zdd_array:completing_optional_args([a(X):b], [a(Y)], R, S).
  183% ?- zdd_array:completing_optional_args([a(X):10], [a(Y)], R, S).
  184
  185completing_optional_args([], R, R, []):-!.
  186completing_optional_args([A|As], Bs, [B|R], R0):- (A = A0:_ ; A0= A), !,
  187	functor(A0, F, 1),
  188	functor(B, F, 1),
  189	( select(B, Bs, Cs); Cs = Bs ), !,
  190	unify_one(A, B),
  191	completing_optional_args(As, Cs,  R,  R0).
  192
  193% For preventing expansion brace {..} by open_dict as pac macro.
  194% ( not used )
  195:- set_prolog_flag(open_dict, false).  196unify_default({G}, _):-!, once(G).
  197unify_default(X, X).
  198:- set_prolog_flag(open_dict, true).  199
  200%
  201unify_one(A:Val, B):- !, functor(A, F, 1),
  202	functor(B, F, 1),
  203	arg(1, A, U),
  204	arg(1, B, V),
  205	(	var(V)	->	U = Val,	% unify_default(Val, U),
  206					V = U
  207	;	var(U)	->  U = V
  208	;	true
  209	).
  210unify_one(A, A):-!.
  211unify_one(_, _).
  212
  213			/************************
  214			*       Set kind        *
  215			************************/

set(+X:term, -Y:list) is det: Evaluate a set expression X into a list Y.

  220% ?- set([a,b]-[1,2], R).
  221% ?- set(singleton(pow([1,2])), X), length(X, L).
  222
  223set(emptyset,[]):-! .
  224set(X,X):-listp(X),! .
  225set(singleton(A),[B]):-!,set(A,B) .
  226set(A+B,A1):-!,(set(A,A2),set(B,A3)),union(A2,A3,A1) .
  227set(plus(A,B),A1):-!,set(A+B,A1) .
  228set(cup(A),A1):-!,(set(A,A2),set(append(A2),A3)),sort(A3,A1) .
  229set(cap(A),A1):-!,set(A,A2),math:bigcap(A2,A1) .
  230set(++(A,B),A1):-!,(set(A,A2),set(B,A3)),math:direct_sum(A2,A3,A1) .
  231set(A*B,A1):-!,(set(A,A2),set(B,A3)),math:product(A2,A3,A1) .
  232set(A-B,A1):-!,(set(A,A2),set(B,A3)),
  233	pac_meta:pac_product(misc:set_aux,A2,A3,A1) .
  234set(\(A,B),A1):-!,(set(A,A2),set(B,A3)),subtract(A2,A3,A1) .
  235set(#(A,B),A1):-!,(set(A,A2),set(B,A3)),scramble_cons(A2,A3,A1) .
  236set(&(A,B),A1):-!,(set(A,A2),set(B,A3)),math:intersection(A2,A3,A1) .
  237set(pow(A),A1):-!,set(A,A2), math:powerset(A2,A1) .
  238set(zip(A,B),A1):-!,(set(A,A2),set(B,A3)),zip(A2,A3,A1) .
  239set(sort(A),A1):-!,set(A,A2),sort(A2,A1) .
  240set((A->B),A1):-!,(set(A,A2),set(B,A3)),math:mapset(A2,A3,A1) .
  241set(..(I,J),A1):-(I0 is I,J0 is J),!,numlist(I0,J0,A1) .
  242set(in(X,Y),A1):-!,(set(X,A2),set(Y,A3)),truth(memberchk,A2,A3,A1) .
  243set(X=Y,A1):-!,(set(X,A2),set(Y,A3)),truth(==,A2,A3,A1) .
  244set(X=<Y,A1):-!,(set(X,A2),set(Y,A3)),truth(subset,A2,A3,A1) .
  245set(X>=Y,A1):-!,set(Y=<X,A1) .
  246set(X<Y,A1):-!,(set(X,A2),set(Y,A3)),truth(math:proper_subset,A2,A3,A1) .
  247set(X>Y,A1):-set(Y<X,A1) .
  248
  249%
  250set_aux(A,B,A-B).

insert(+M:term, +X:list, -Y:list) is det: Insert M beteen every successive elements of X, and unify Y with the result.

  256% ?- misc:insert(a, [1,2,3], R).
  257insert(M, [A|P], [A|Q]):- foldl(pred(M, [B, [M, B| U], U]), P, Q, []).
  258insert(_, [], []).
  259
  260%
  261truth(X, true) :- call(X), !.
  262truth(_, false).
  263
  264truth(X, Y, true) :- call(X, Y), !.
  265truth(_, _, false).
  266
  267truth(X, Y, Z, true) :- call(X, Y, Z), !.
  268truth(_, _, _, false).

desugaring(+X:term, -Y:term) is det: Eliminate infix '-' and '/', and prefix '+', '-', and ufify Y with the result.

  274% ?- desugaring( -(a-b-c), Y).
  275
  276desugaring(X-Y,A1+ -1*A2):-!,desugaring(X,A1),desugaring(Y,A2).
  277desugaring(+X,A1):-!,desugaring(X,A1).
  278desugaring(-X,-1*A1):-!,desugaring(X,A1).
  279desugaring(X/Y,A1 rdiv A2):-!,desugaring(X,A1),desugaring(Y,A2).
  280desugaring(X,X).
  281
  282insert_pause(cs(item),[cs(pause),cs(item)]):-! .
  283insert_pause(X,A1):-(listp(X),maplist(insert_pause,X,Y)),!,insert_pause(Y,A1) .
  284insert_pause(X,A1):-(X=..[F|As],maplist(insert_pause,As,Bs),Z=..[F|Bs]),!,
  285		insert_pause(Z,A1).
  286
  287texadjust([cs(item)|X],A1):-texadjust(X,Y),!,texadjust([10,cs(item)|Y],A1) .
  288
  289cs(cs(N),[N]):-!.
  290cs(A,A1):-listp(A),!,maplist(cs,A,A1) .
  291cs(A,A1):-A=..[_A2|As], maplist(cs,As,A1) .
  292
  293texuncomment(comment(_A1),[]).
  294
  295try2problem(env(try,Body),A1):-try2problem(Body,A2),try2problem(env(problem,A2),A1).
  296
  297drop3zw(ddol(E),[cs(noindent),cs(skip),"3zw",env(coronamath,[dol([cs(displaystyle)," ",E])])]).
  298
  299
  300
  301% product(A, B, C):-
  302% 	foldr( pred(B, [X,P,Q] :-
  303% 		foldr(pred(X, [Y,U,[X-Y|U]]), B, P, Q)), A, [], C).
  304
  305% product_cons(A, B, C):-
  306% 	foldr( pred(B, [X,P,Q] :- foldr(pred(X, [Y,U,[[X|Y]|U]]), B, P, Q)), A, [], C).
  307
  308% ?- product_cons([1,2],[[a,b],[c,d,e]], X).
  309%@ X = [[1,a,b],[1,c,d,e],[2,a,b],[2,c,d,e]] .
  310
  311% product3(A, B, C, D):-
  312% 	foldr( pred([B,C], [X,P,Q] :-
  313% 		foldr(pred([X,C], [Y,U, V]:-
  314% 			 foldr(pred([X,Y], [Z, M, [X-Y-Z|M]]), C, U, V)),
  315% 				B, P, Q)), A, [], D).
  316
  317% product4(A, B, C, D, E):-
  318% 	foldr( pred([B,C,D],
  319% 		    [X, P, Q] :-
  320% 		foldr(pred([X,C,D],
  321% 			   [Y, U, V]:-
  322% 			 foldr(pred([X,Y,D],
  323% 				    [Z, M, N]:-
  324% 			      foldr(pred([X,Y,Z],
  325% 					 [W, R,[X-Y-Z-W|R]]), D, M, N)),
  326% 			       C, U, V)),
  327% 		      B, P, Q)),
  328% 	        A, [], E).
  329
  330matrix_paths([], [[]]).
  331matrix_paths([X|Y], Z):- matrix_paths(Y,  PY),
  332	foldr(pred(PY, [J, P, Q]:-
  333	     foldr(pred(J, [K, N, [[J|K]|N]]), PY, P, Q)),
  334	      X, [], Z).
  335
  336
  337% ?- time(repeat(10^8, choices_by_fold([[1,2],[a,b,c],[3,4]], R))).
  338%@ % 7,900,000,001 inferences, 394.599 CPU in 394.833 seconds (100% CPU, 20020346 Lips)
  339%@ true.
  340
  341% ?- time(repeat(10^8, choices([[1,2],[a,b,c],[3,4]], R))).
  342%@ % 4,300,000,001 inferences, 138.387 CPU in 138.479 seconds (100% CPU, 31072358 Lips)
  343%@ true.

by [compile, pac, region] of emacs-jockey.pl choices_by_fold(X, Y):- reverse(X, X0),

foldl(pred([A,B,C] :-
foldr( pred(B,
[L,P,Q] :-
foldr(pred(L, [M,U,[[L|M]|U]]),
B, P, Q)),
A, [], C)),
X0, [[]], Y)

  358% ?- length(L, 10), maplist(misc:random_choice([[a,b],[c,d,e]]), L), maplist(writeln, L).
  359
  360random_choice([L|R], [A|Q]):- length(L, N), I is random(N),
  361			      nth0(I, L, A),
  362			      random_choice(R, Q).
  363random_choice([], []).

list(+X:term, -Y:list) is det: Expand a list term X into a list Y.

  369% ?- list([1,2]\[1,2,3,4], R).
  370% ?- list([a,b]^2, R).
  371% ?- list(^^([a,b], 2), R).
  372% ?- list([a,b]^2+[c,d]^3+[e,f]^4, R), length(R, L).
  373% ?- list([a,b]^0+[c,d]^1+[e,f]^2, R), length(R, L).
  374% ?- list([a,b]^^3, R), length(R, L).
  375
  376list(A+B,A1):-!, list(A,A2),
  377	list(B,A3),
  378	append(A2,A3,A1).
  379list(\(A,B),Z):-!, list(A,X),list(B,Y), append(X,Z,Y) .
  380list(A/B,Z):-!, list(A,X),list(B,Y), append(Z,Y,X) .
  381list(E^L,A1):-N is L,!,list(E,A2),times(N,A2,A1) .
  382list(^^(E,L),C):-N is L,!,list(E,A),math:nlist(A,N,C) .
  383list(X,X):-listp(X),! .
  384list(+A,A1):-!,list(A,A2), append(A2,A1) .
  385list(flat(A),A1):-list(A,A2),flatten(A2,A1) .

string(+X:term, -Y:string) is det: Expand a string term X into a string Y.

  390% ?- string("ab"+"cd"+"ef", X).
  391% ?- string("abcd"/"cd", X).
  392% ?- string("ab"\"abcd", X).
  393% ?- string(("ab"\"abcd")^3, X).
  394% ?- string(("ab"\"abcd")^3, X).
  395% ?- val(string((+) @ (list@ (+(["ab", "cd"], ["ef", "gf"])))), Y).
  396% ?- string(reverse("abcd"), X).
  397% ?- string(reverse(reverse("uvw") + reverse("ab" + "12")), X).
  398
  399string(A+B,A1):-!, string(A,A2),
  400	string(B,A3),
  401	string_concat(A2,A3,A1).
  402string(\(A,B),Z):-!, string(A,X),
  403	string(B,Y),
  404	string_concat(X,Z,Y).
  405string(A/B,Z):-!, string(A,X),
  406	string(B,Y),
  407	string_concat(Z,Y,X).
  408string(E^L,A1):-N is L,!,string(E,A2),
  409	string_times(N,A2,A1) .
  410string(reverse(X),B):-!, string(X,A1),
  411	string_codes(A1,A2),
  412	reverse(A2,A),
  413	string_codes(B,A).
  414string(+A,A1):-!, string(A,A2),
  415	list(A2,A3),
  416	string_list_concat(A3,A1).
  417string(X,X):-(string(X);atom(X)),!.
  418
  419%
  420edit_skk_line(X, A, B):-
  421	(	skk_null_jisyo_entry(X, []) -> B = A
  422	;	A = [X|B]
  423	).
  424%
  425skk_null_jisyo_entry --> wl("[^/]*//[\n\s\r\t]*"), end_of_line.
  426%
  427end_of_line([], _).
  428
  429% split by variable length filler.
  430split_by_filler(X) --> filler, token_and_split(X).
  431%
  432token_and_split([]) --> current([]).
  433token_and_split([A|X]) --> wl("[^\s\t\r\n]+", A, []),  split_by_filler(X).
  434
  435%
  436filler -->	filler(_, _).
  437%
  438filler(X, Y) --> wl("[\s\t\n\r]*", X, Y).
  439%
  440delimiter_plus --> wl(+("[\t\r\n]" | "\s\s+"), _, _).
  441%
  442delimiter_plus(X, Y) --> wl(+("[\t\r\n]" | "\s\s+"), X, Y).
  443
  444
  445		/************************************
  446		*     new splitter. [2024/05/24]    *
  447		************************************/

X, Y as Difference-list is unified with a list of words splitted by filler \t, \n, \r, and spaces \s\s+. This splitter does not include empty word in the output.

split_plus(?X) is det: Equivalent to split_plus(?X, []).

  457% ?- split_plus(Ws, `   `, []).
  458% ?- split_plus(Ws, ` a + a  `, []), maplist(string_codes, X, Ws).
  459% ?- split_plus(Ws, `\t\n a + a\n\t  `, []), maplist(string_codes, X, Ws).
  460
  461split_plus(X) --> split_plus(X, []).
  462%
  463split_plus(X, Y) --> filler, !, words(X, Y).
  464%
  465words(X, X) --> current([]), !.
  466words([[C|W]|Xs], Y) --> [C], word_tail(W), words(Xs, Y).
  467%
  468word_tail([]) --> filler, current([]), !.
  469word_tail([]) --> delimiter_plus, !.
  470word_tail([C|W]) --> [C], word_tail(W).
  471
  472% ?- Codes = ` a + b  c  `,
  473%	 Fregex = "[\s\t\n\r]*",
  474%	 Dregex = +("[\t\r\n]" | "\s\s+"),
  475%	 pred_split(Fregex, Dregex, Splitted, Codes, []),
  476%	 maplist(string_codes, Strings, Splitted).
  477
  478pred_split(Filler, Delimiter, X) -->
  479	{	pac_word:let_wl(F, Filler),
  480		pac_word:let_wl(D, Delimiter)
  481	},
  482	pred_split(F, D, X, []).
  483%
  484pred_split(F, D, X, Y) --> call(F), !, words(F, D, X, Y).
  485%
  486words(_, _, X, X) --> current([]), !.
  487words(F, D, [[C|W]|Xs], Y) --> [C], word_tail(F, D, W), words(F, D, Xs, Y).
  488%
  489word_tail(F, _, []) --> call(F), current([]), !.
  490word_tail(_, D, []) --> call(D), !.
  491word_tail(F, D, [C|W]) --> [C], word_tail(F, D, W).
  492
  493
  494% ?- time((	Codes = ` a + b  c `,
  495%		Fregex = "[\s\t\n\r]*",
  496%		Dregex = +("[\t\r\n]" | "\s\s+"),
  497%		pac_word:let_wl(F, Fregex),
  498%		pac_word:let_wl(D, Dregex),
  499%	let(Split, mrec([F, D],
  500%		[ Pred_split  = ( [X, Y, A, B]:-call(F, A, C), !,
  501%					call(Words, X, Y, C, B)),
  502%		  Words = (
  503%					( [X, X, [], []]:-! )
  504%				&	([[[C|W]|Xs], Y, [C|A], B]:-
  505%						call(Word_tail, W, A, A0),
  506%						call(Words, Xs, Y, A0, B))),
  507%		 Word_tail = (
  508%					([[], A, B]:-call(F, A, B), current([], B, B))
  509%				&	([[], A, B]:- call(D, A, B), !)
  510%				&	([[C|W], [C|A], B]:- call(Word_tail, W, A, B)))])),
  511%	 call(Split, Splitted, [], Codes, []))),
  512%	 maplist(string_codes, Strings, Splitted).
  513%@ % 8,758 inferences, 0.001 CPU in 0.001 seconds (98% CPU, 6950794 Lips)
  514%@ Codes = [32, 97, 32, 43, 32, 98, 32, 32, 99|...],
  515%@ Fregex = "[ \t\n\r]*",
  516%@ Dregex = + ("[\t\r\n]"| "  +"),
  517%@ F = user:'nt#558',
  518%@ D = user:'nt#562',
  519%@ Split = misc:'pac#574'([user:'nt#558', user:'nt#562']),
  520%@ Pred_split = 'pac#574'([user:'nt#558', user:'nt#562']),
  521%@ Words = 'pac#575'([user:'nt#558', user:'nt#562']),
  522%@ Word_tail = 'pac#576'([user:'nt#558', user:'nt#562']),
  523%@ Splitted = [[97, 32, 43, 32, 98], [99]],
  524%@ Strings = ["a + b", "c"] .
  525
  526% ?- filler(`   abc`, X).
  527% ?- string_chars("ab", L), split_by_filler(X, L, Y).
  528% ?- string_chars("    ", L), split_by_filler(X, L, Y).
  529% ?- string_chars(" ab  c\n \t   ", L), split_by_filler(X, L, Y).
  530% ?- string_chars(" ab  c\nd\t ef   ", L), split_by_filler(X, L, Y).
  531
  532% Apply set operation on directories as a set of files.
  533:- meta_predicate directory_files(2,?,?).  534directory_files(E, Ds, L):-
  535	maplist(pred([D, D0]:-expand_file_name(D, [D0])), Ds, Es),
  536	maplist(directory_files, Es, Ls),
  537	call(E, Ls, L).
  538
  539:- meta_predicate map_directory_files(1, ?).  540map_directory_files(F, D):- directory_files(D, Fs),
  541	working_directory(D0, D),
  542	maplist(ignore(F), Fs),
  543	working_directory(_, D0).
  544
  545ignore(F, X):- ignore(call(F, X)).
  546
  547% ?- directory_remove_ymhms('/Volumes/sparrow/raw-scan-master').
  548% ?- directory_remove_ymhms('/Volumes/shark/searchable-master').
  549directory_remove_ymhms(D):- expand_file_name(D, [D0]),
  550	map_directory_files(pred(([X]:-
  551					atom_codes(X, X0),
  552					parse_time_me(".pdf", X0, Y0),
  553					atom_codes(Y,Y0),
  554					rename_file(X, Y) )),
  555					D0).
  556
  557% :- listing(parse_time).
  558% ?-  misc:parse_time(`pdf`, `2007å¹´12æ21æ¥21æ35å18ç§.pdf`, P), atom_codes(Y, P).
  559
  560parse_time(Ext) -->
  561	w(*(char(digit)), Year),	"å¹´",
  562	w(*(char(digit)), Month),	"æ",
  563	w(*(char(digit)), Day),		"æ¥",
  564	w(*(char(digit)), Hour),	"æ",
  565	w(*(char(digit)), Minute),	"å",
  566	w(*(char(digit)), Second),	"ç§",
  567	".",
  568	w(*(.), Ext),
  569	current([]),
  570	{ append([Year, Month, Day, Hour, Minute, Second, `.`,  Ext], Y) },
  571	peek(Y).
  572
  573% ?- dir_minus('~/Desktop', '~/Desktop', Z).
  574% ?- dir_minus('~', '~/Desktop', Z).
  575% ?- dir_minus('~', '~', Z).
  576dir_minus(X,Y,Z):- directory_files(fun([[A,B]]-> (set::(A\B))), [X, Y], Z).
  577dir_plus(X,Y,Z):- directory_files(fun([[A,B]]-> (set::(A+B))), [X, Y], Z).
  578
  579%
  580rename_directory_suffix(Suffix0, Suffix, Dir):-
  581	expand_file_name(Dir, [Dir0]),
  582	map_directory_files(
  583 	 pred([Suffix0,Suffix], [X]:- (	atom_concat(X0, Suffix0, X),
  584					atom_concat(X0, Suffix, Y),
  585					rename_file(X, Y)
  586				)),
  587	Dir0).
  588
  589:- meta_predicate collect_subterm(1,?,?).  590
  591collect_subterm(F, X, Y):- collect_subterm(X, Y0, [], F), sort(Y0, Y).
  592
  593%
  594collect_subterm(X, [X|V], V, F):- call(F, X), !.
  595collect_subterm(X, V, W, F):- compound(X), !,
  596	X=..[_|As],
  597	foldr(	pred(F, [A, P, Q] :- collect_subterm(A, P, Q, F), As, V, W)).
  598collect_subterm(_, V, V, _).
  599
  600% :- dynamic calls/2.
  601% % from swi library.
  602% assert_call_graph :-
  603%         retractall(calls(_, _)),
  604%         prolog_walk_code([ trace_reference(_),
  605%                            on_trace(assert_edge),
  606%                            source(false)
  607%                          ]),
  608%         predicate_property(calls(_,_), number_of_clauses(N)),
  609%         format('Got ~D edges~n', [N]).
  610
  611% assert_edge(Callee, Caller, _Where) :-
  612%         calls(Caller, Callee), !.
  613% assert_edge(Callee, Caller, _Where) :-
  614%         assertz(calls(Caller, Callee)).
  615
  616%
  617predicate_arity(F, L):-
  618	setof(P/N,
  619		A^X^(	predicate_property(A:X, file(F)),
  620			functor(X, P, N)
  621		  ),
  622	      L),
  623	insert(", ", L, L0),
  624	smash(["[", L0, "]"]).
  625
  626%
  627predicate_arity_for_export(F,  L):-
  628	writeln('start ...'),
  629	assert_call_graph,
  630	writeln('call graph done'),
  631	find_exportables_from_calls(F, L).
  632
  633% ?- qcompile(zdd(zdd)), module(zdd).
  634
  635
  636% ?- find_exportables_from_calls('/Users/cantor/local/lib/pacpl7/engine.pl', Expo), insert(",\n", Expo, E), maplist(write, E).
  637
  638find_exportables_from_calls(Loc,  Exp):-
  639	predicate_arity(Loc,  L0),
  640	setof(F/N, P^X^(
  641			member(F/N, L0),
  642			functor(P, F, N),
  643			once(calls(X,  user:P)),
  644			\+ predicate_property(X, file(Loc))
  645		       ),
  646	      Exp),
  647	insert(",\n", Exp, E),
  648	maplist(write, E).
  649
  650
  651% ?- calls(X, user:assocq(_,_,_)), predicate_property(X, file(A)).
  652% ?- misc:residue(([a,b,c,d,e]-[a,b]-[c]), R).
  653
  654residue(X-Y,V):-!, residue(X,A),
  655	residue(Y,U),
  656	append(U,V,A).
  657residue(X,X).
  658
  659% ?-  parse_utf8(`My name is åäº å½æ.`, R), smash(R).
  660parse_utf8 --> sed(kanji(A), =(A)),
  661	maplist(pred(([X, Y] :- listp(X), string_codes(Y, X))
  662	       &
  663	       ([X, Y] :- char_code(Y, X)))).
  664
  665kanji(A)  --> w(char(utf8b), A, B), wl(*char(utf8c), B).
  666
  667% ?- misc:cgi_bin_name_edit.
  668%@ true.
  669
  670% For test.
  671% cgi_bin_name_edit :- cgi_bin_name_edit(
  672%      		"/Users/cantor/Desktop/http_request.js",
  673% 		"/Users/cantor/Desktop/http_request1.js").
  674% for test.
  675% cgi_bin_name_edit :- cgi_bin_name_edit(
  676% 	 	"/Users/cantor/local/cgi-bin/http_request.js",
  677% 		"/Users/cantor/Desktop/http_request.js").
  678
  679% cgi_bin_name_edit(In_js_name, Out_js_name) :-  getenv(cgi_bin, U),
  680% 	atomics_to_string([U, /], V),
  681% 	term_string(V, V0),
  682% 	atomics_to_string([V0, ";"], V1),
  683% 	string_codes(V1, V2),
  684% 	setup_call_cleanup(
  685% 	 (	open(In_js_name, read, In),
  686% 		open(Out_js_name, write, Out) ),
  687% 		repeat_line(V2, In, Out),
  688% 	(	close(In),
  689% 		close(Out))).
  690
  691% cgi_bin_name_edit(V, A, B):-
  692% 	head_sed(sed([V],
  693% 		 (wl("[\s\t]*var[\s\t]+CGIBIN[\s\t]*=[\s\t]*", X), wl(".*")),
  694% 		 (X + V)), A, B).
  695%
  696repeat_line(V, In, Out):- read_line_to_codes(In, A),
  697	A \== end_of_file,
  698	cgi_bin_name_edit(V, A, B),
  699	maplist(put_code(Out), B),
  700	put_code(Out, 0'\n),			%%%% '
  701	!,
  702	repeat_line(V, In, Out).
  703repeat_line(_,_,_).
  704
  705
  706% ?- expand_sgn_brace(sgn([a,b]), X).
  707% ?- expand_sgn_brace((sgn([a,b]), sgn([c,d])), X).
  708expand_sgn_brace(sgn([A,A0|B]),(A1;A2)):-!,
  709	expand_sgn_brace(sgn([A]),A1),
  710	expand_sgn_brace(sgn([A0|B]),A2).
  711expand_sgn_brace(sgn([A]),A1):-!,expand_sgn_brace(A,A1).
  712expand_sgn_brace((A,B),(A1,A2)):-!,expand_sgn_brace(A,A1),
  713	expand_sgn_brace(B,A2).
  714expand_sgn_brace((A;B),(A1;A2)):-!,expand_sgn_brace(A,A1),
  715	expand_sgn_brace(B,A2).
  716expand_sgn_brace(\+A,\+A1):-!,expand_sgn_brace(A,A1).
  717expand_sgn_brace(A/N,A0/N):-!,expand_sgn_brace(A,A0).
  718expand_sgn_brace(X,A1):-is_list(X),!,
  719	maplist(expand_sgn_brace,X,A1).
  720expand_sgn_brace(X,X).
  721
  722% Samples defining functions on a sort of expressions.
  723
  724% ?- listing(list_plus).
  725% ?- misc:list_plus([a,b,c]+[d,e,f]+[g,h,i], R).
  726
  727list_concat(X+Y,A1):-list_concat(X,A2),
  728	list_cocnat(Y,A3),
  729	append(A2,A3,A1) .
  730list_concat(X,X).
  731
  732
  733% ?- listing(my_add).
  734% ?- misc:my_add(1+2+3+4+5, R).
  735my_add(X+Y,A1):- my_add(X,A2),
  736	my_add(Y,A3),
  737	plus(A2,A3,A1).
  738my_add(X,X).
  739
  740% ?- misc:string_rev(rev("abc"), R).
  741%@ R = "cba" .
  742% ?- write_canonical([rev/1-misc:string_reverse]).
  743%@ [:(-(/(rev,1),misc),string_reverse)]
  744
  745% list_plus		:= [(+)/2-append].
  746% list_rev		:= [rev/1-reverse].
  747% list_plus_rev	:= (list_plus + list_rev).
  748% list_plus_only	:= (list_plus_rev \ list_rev).
  749
  750% % string sort.
  751% % ?- misc:string_plus_rev(rev(rev("abc")+rev("def")), R).
  752% %@ R = "defabc" .
  753
  754% string_plus		:= [(+)/2- string_concat].
  755% string_rev		:= [rev/1- (misc:pred(([X, Y]:-
  756% 								string_codes(X, X0),
  757% 								reverse(X0, Y0),
  758% 								string_codes(Y, Y0))))].
  759% string_plus_rev	:= (string_plus + string_rev).
  760% string_plus_rev_meet := (string_plus * string_rev).
  761% string_plus_only	:= (string_plus_rev \ string_rev).
  762
  763% empty_sgn := [].
  764
  765% Example uses of @
  766% uuu(A,B) --> A@B.
  767% vvv(A,B) --> #(A)@B.
  768% www(A, B) --> fun([X,Y,Z]->(X@Y@Z))@A@B.
  769%?- misc:www(append, [a,b], [c,d], R).
  770%@ R = [a, b, c, d].
  771% ?- call(fun([F,X]-> F@X), append([a,b]), [c,d], R).
  772%@ R = [a, b, c, d].
  773
  774% DISCOURSE by @brebs
  775
  776% ?- split_list_at_nth1(N, [a,b,c], [X|T], End).
  777% ?- split_list_at_nth1(N, [a,b,c], St, [a,b,c|T]).
  778% ?- trace, split_list_at_nth1(N, [a,b], Start, End).
  779split_list_at_nth1(Nth1, Long, Start, End) :-
  780    (   nonvar(Nth1) -> must_be(nonneg, Nth1), Once = true
  781    ;   is_list(Long), once(is_list(Start) ; is_list(End)) -> Once = true
  782    ;   is_list(End), is_list(Start) -> Once = true
  783    ;   Once = false
  784    ),
  785    split_list_at_nth1_(Long, 0, Nth1, Once, Start, End).
  786
  787split_list_at_nth1_(L, N, N, Once, [], L) :-
  788    (Once == true -> ! ; true).
  789split_list_at_nth1_([H|T], N, Nth1, Once, [H|Upto], End) :-
  790    N1 is N + 1,
  791    split_list_at_nth1_(T, N1, Nth1, Once, Upto, End)