basic.pl

    1:- module(basic, [
    2	max/3, min/3, max_of_list/2, min_of_list/2,
    3	ahead_compare/4,
    4	associative_comma/3, comma_list/2,
    5%	iterated_deepening/4,
    6	completing_options/3, kleene_star/3, kleene_star_greedy/3, kleene_plus_greedy/3,
    7	kleene_string_codes/3,
    8	term_codes/2, term_codes/3,
    9	concat/2, flatten/3,
   10	pipe_create/2, pipe_create/3, pipe_to_obj/2, obj_to_pipe/2,
   11	assocq/3, memq/2, clear/2,
   12	clear/3, collect/3, current/3, env/3,
   13    herbrand/2, herbrand/3, herbrand/4, herbrand0/2,
   14	verbatim_skip/4,
   15	herbrand_in_context/2, herbrand_in_context/3,
   16	id/2, if/2, if/3,
   17	listcast/2, listsubst/3,
   18	prepend/3,
   19	ordered_pair/3,
   20	paragraph/2,
   21	listp/1,
   22	peek/3, peek/4,
   23	remove/3, remove_last/3,
   24	smash/1, smash/2, smash_codes/2, smash_string/2,
   25	term_string0/2, pred_term_smash/3, term_smash/2, term_smash0/2,
   26	fst/2, fst/3, snd/2, snd/3, split/2, split/3,
   27	split/4, split/6, split_rest/6, stack_init/0,
   28	split_string_by_word/3,
   29	scan_prefix/4, scan_prefix/5,
   30	remove_comment/2, remove_comment/3,
   31	bi_reverse/3,
   32	stack_pop/2, stack_push/1, stack_push/2,
   33	stack_top/1, stack_top/2, stack_update/1,
   34	residue/3,
   35	stack_update/2,
   36	union/2, flatten_dl/3,
   37	herbrand_opp/2, herbrand_opp/3, variant/4, cons/3,
   38	zip/3
   39	]).   40
   41:- use_module(pac(op)).

max(+A, +B, -C) is det: C is unified with the max of A and B.

   46max(A, B, A):- A@>B, !.
   47max(_, B, B).

min(+A, +B, -C) is det: C is unified with the min of A and B.

   52min(A, B, A):- A@<B, !.
   53min(_, B, B).

max_of_list(+L, -M) is det: M is uinified with the maximum of elements in L.

   58% ?- max_of_list([1,2,-3], M).
   59max_of_list([X], X):-!.
   60max_of_list([X, Y|Z], M):- X@<Y, !,
   61	max_of_list([Y|Z], M).
   62max_of_list([X, _|Z], M):- max_of_list([X|Z], M).

min_of_list(+L, -M) is det: M is uinified with the minimum of elements in L.

   67% ?- min_of_list([1,2,-3], M).
   68min_of_list([X], X):-!.
   69min_of_list([X, Y|Z], M):- Y@<X, !,
   70	min_of_list([Y|Z], M).
   71min_of_list([X, _|Z], M):- min_of_list([X|Z], M).
   72
   73
   74% %!	iterated_deepening(G:pred, +D:int, +N:int, -R) is nondet
   75% %	Deprecated.
   76% %	Iterate  at most N times call_with_depth_limit(G, D, R),
   77% %	incrementing D to twice larger for each iteration step.
   78
   79% % ?- iterated_deepening(append([a,b,c,d,e,f],[g,h], X), 2, 3, R).
   80% %@ X = [a, b, c, d, e, f, g, h],
   81% %@ R = 7.
   82% :- meta_predicate iterated_deepening(0, ?, ?, ?).
   83% iterated_deepening(_,  _, 0, depth_limit_reached):-!,
   84% 	throw(depth_limit_reached).
   85% iterated_deepening(G, D, N, S):-  N0 is N - 1,
   86% 	writeln(depth(D, N)),
   87% 	call_with_depth_limit(G, D, R),
   88% 	(  R == depth_limit_exceeded
   89% 	->	D1 is D + D,
   90% 		iterated_deepening(G, D1, N0, S)
   91% 	;	R = S
   92% 	).

completing_options(+X:list, +Y:list, -Z:list) is det: Update options list Y with X to Z.

   97% ?- completing_options([i(2)], [], X).
   98% ?- completing_options([i(2), j(1)], [i(1), j(A)], X).
   99completing_options([D|R], X, Y):-
  100	functor(D, F, 1),
  101	functor(D0,F, 1),
  102	(	memberchk(D0, X)
  103	->	completing_options(R, X, Y)
  104	;	completing_options(R, [D|X], Y)
  105	).
  106completing_options([], X, X).

if(+X, +Y, +Z) is nondet: Meta predicate for conditional sentences.

  111:-meta_predicate if(0, 0, 0).  112if(X, Y, Z)	:-	( call(X)   ->  call(Y); call(Z) ).
  113if(X, Y)	:-	( call(X)   ->  call(Y); true  ).

cast_to_list(+X, -Y) is det: Y is unified with casted X.

  117cast_to_list(X, Y):-
  118	(	var(X) -> Y = [X]
  119	;	(X == []; X = [_|_]) -> Y = X
  120	;	Y = [X]
  121	).

listp(+X) is det: True if X is [] or [_|_].

  125listp([]):-!.
  126listp([_|_]).
  127
  128% refresh_term(A, X, Y):- copy_term((A,X), (A,Y)).
  129% fs_fresh(fs_alt(_Fs, Gs, M, Cnt), fs_alt(Gs, Gs, M, Cnt)).
  130
  131fst(F) --> main(F).
  132snd(F) --> env(F).
  133main(F, (X, Y), (X0, Y)):- phrase(F, X, X0).
  134env(F, (X, Y), (X, Y0)):- phrase(F, Y, Y0).
  135pipe_init(X, (X, [])).
  136
  137%  DCG in duo pipe form 'P'(X, Y)
  138pipe_create(X, (X, [])).
  139%
  140pipe_create(X, Y, (Y, X)).
  141%
  142pipe_to_obj(P, Ob):- var(P), !,
  143	obj:obj_pull([acc(X)], Ob, Ob0),
  144	P = (X, Ob0).
  145%
  146pipe_to_obj((X, Y), [acc(X)|Y]).
  147
  148%
  149obj_to_pipe(X, Y):- pipe_to_obj(Y, X).
  150
  151% helpers
  152unary(F, A, T)	:- T =.. [F, A].
  153unary(F, T)	:- functor(T, F, 1).
  154n_ary(F, As, T)	:- T =.. [F | As].
  155
  156%
  157list_to_comma([], true):-!.
  158list_to_comma([X], X):-!.
  159list_to_comma([X|Y], (X,Z)):- list_to_comma(Y,Z).
  160%
  161binary_term(F, A, B, C):- C =.. [F, A, B].
  162
  163% ?- binary_term(f, [a], R).
  164%@ R = f(a,f(b,c)).
  165binary_term(_, [A], A):-!.
  166binary_term(F, [A|B], C):- binary_term(F, B, C0),
  167	binary_term(F, A, C0, C).
  168
  169% basic predicates
  170% for handling internal prolog variable preventing unexpected unification.
  171% narrowing(X, Y)
  172% ?- narrowing(X, Y).
  173% X = Y.
  174% ?- narrowing(X, (Y)).
  175% X = Y.
  176% ?- narrowing(X, f(Y)).
  177% false.
  178% ?- narrowing(f(a), f(Y)).
  179% Y = a.
  180narrowing(X, Y) :-  subsumes(Y, X).
  181
  182%
  183memq(X, [Y|_]):- X==Y, !.
  184memq(X, [_|Ys]):- memq(X, Ys).
  185
  186% ?- assocq([a = b], a, R).
  187% ?- assocq([a(1) + b], a(X), R). % fail
  188
  189assocq([X|_], A, B):- arg(1, X, A0), A == A0, !, arg(2, X, B).
  190assocq([_ |Ps], A, B):- assocq(Ps, A, B).
  191
  192% ?- assoc([a = b], a, R).
  193% ?- assoc([a(1) + b], a(X), R).
  194
  195assoc([X|_], A, B):- arg(1, X, A), !, arg(2, X, B).
  196assoc([_ |Ps], A, B):- assoc(Ps, A, B).
  197
  198%
  199unlist([X], X):-!.
  200unlist(X, X).
  201
  202% ?- member(X, Y, [a,b,c], Z).
  203
  204member(X, Y, [X|Xs], [Y|Xs]).
  205member(X, Y, [A|Xs], [A|Ys]):- member(X, Y, Xs, Ys).
  206
  207%%%
  208appear(X, X).
  209appear(X, Y):- Y=..[_|Y0], member(Z, Y0), appear(X, Z).
  210
  211%
  212list([])    --> [].
  213list([X|Y]) --> [X], list(Y).
  214
  215listcast(X,X) :- listp(X),!.
  216listcast(X,[X]).
  217
  218% ?- basic:prepend(a, S, R).
  219%@ S = [a|R].
  220% ?- basic:prepend([a,[b,c]], S, R).
  221%@ S = [a, b, c|R] .

prepend(?A, -X, -Y) is det: roughly works like flatten(A, B), append(B, Y, X).

  227prepend(A, [A|X], X):- var(A), !.
  228prepend([], X, X).
  229prepend([A|R], X, Y) :- !, prepend(A, X, Z),
  230    prepend(R, Z, Y).
  231prepend(A, [A|X], X).
  232
  233% a la <br>
  234polish_reserved(br, A, [0'\n|A]).   %'
  235
  236%
  237save_bc(X) :- prolog_load_context(module, M),
  238	scan(`.\n`, A, M, X, _), !,
  239	herbrand(_, A, G0),
  240	pac:expand_arg(G0, M, G, P, []),
  241	maplist(assert, P),
  242	nb_setval(saved_bc, G).
  243
  244% ?- expand_arg((split,maplist(pred([A, [A,A]]))),user, G, P, []), maplist(assert, P), phrase(G, [a], R).
  245%@ G = (user:split, user:maplist(user:'pred#3')),
  246%@ P = [ (user:'pred#3'(A, [A, A]):-true)],
  247%@ R = [[[a], [a]]] .

verbatim_skip(+X, +Y, +A, -B) is det: B is unified so that append([X, _, Y, B], A). Intended use is to skip a long comment like /* ... */ in TeX with X=`/*`, Y=`/*`.

  255% ?- verbatim_skip(`/*`, `*/`, `/*abc*/d`, R), smash(R).
  256verbatim_skip(X, Y, A, B):-append(X, C, A),
  257						   verbatim_skip(Y, C, B).
  258%
  259verbatim_skip(X, A, B):-append(X, B, A), !.
  260verbatim_skip(X, [_|A], B):-verbatim_skip(X, A, B).
  261
  262
  263
  264		/******************
  265		*     herbrand    *
  266		******************/
  267
  268% ?- herbrand("f(X,a)", S), smash(S).
  269% ?- herbrand(S, f(X,a)).
  270% ?- herbrand(V, S, f(X,a)).
  271% ?- herbrand(V, "f(X,a)", T), herbrand(V, S, T).
  272% ?- herbrand(['X'= X], S, f(X,a)).
  273% ?- herbrand(V, `f(A)`, T), term_string(T, S, V).
  274% ?- herbrand([op(10, fx, ***)], V, `***a(X)`, R).
  275% ?- herbrand(V, `***a(X)`, R).
  276%
  277
  278herbrand_in_context(_, X, _):- (X=''; X=""; X=[]), !,
  279	throw(domain_error(herbrand_in_context(X))).
  280herbrand_in_context(Mod, X, Y):-
  281	(	string(X)	->	X0 = X
  282	;	string_codes(X0, X)
  283	),
  284	term_string(Y, X0, [variable_names(_),
  285						module(Mod)]).
  286% ?- basic: herbrand_in_context("a \\ \\ b", H).
  287herbrand_in_context(X, _):- (X=''; X=""; X=[]), !,
  288	throw(domain_error(herbrand_in_context(X))).
  289herbrand_in_context(X, Y):-
  290	(	string(X)	->	X0 = X
  291	;	string_codes(X0, X)
  292	),
  293	term_string(Y, X0, [variable_names(_), module(pac_op)]).
  294%
  295herbrand(_, _, X, _):-(X=''; X=""; X=[]), !,
  296	throw(domain_error(herbrand(X))).
  297herbrand(Mod, V_names, X, Y):-
  298	term_codes(Y, X, [variable_names(V_names), module(Mod)]).
  299
  300%
  301herbrand(V_names, X, Y):-
  302	term_codes(Y, X, [variable_names(V_names)]).
  303%
  304herbrand(X, Y) :- herbrand(Eqs, X, Y),  maplist(call, Eqs).
  305%
  306herbrand0(X, Y) :- term_codes(Y, X, []).
  307
  308%
  309herbrand_opp(X, Y)	:- herbrand(Y, X).
  310herbrand_opp(V, X, Y)	:- herbrand(V, Y, X).
  311
  312%
  313save_current_op(op(_, A, Z), op(P0, A0, Z)):- current_op(P0, A0, Z),
  314	op_kind(A, Kind),
  315	op_kind(A0, Kind),
  316	!.
  317save_current_op(op(_, A, Z), op(0, A, Z)).
  318
  319% an operator may be infix, prefix, and postfix.
  320op_kind(xfx,	infix).
  321op_kind(xfy,	infix).
  322op_kind(yfx,	infix).
  323op_kind(fx,	prefix).
  324op_kind(fy,	prefix).
  325op_kind(xf,	postfix).
  326op_kind(yf,	postfix).
  327
  328% ?- basic:term_codes(f(a,X), C, [variable_names(['X'=X])]), basic:smash(C).
  329
  330term_codes(X, Y, Options):- nonvar(Y), !,
  331	string_codes(S, Y),
  332	term_string(X, S, Options).
  333term_codes(X, Y, Options):- memberchk(variable_names(V), Options), !,
  334	equate(V),
  335	term_string(X, S, Options),
  336	string_codes(S, Y).
  337term_codes(X, Y, Options):-
  338	term_string(X, S, Options),
  339	string_codes(S, Y).
  340
  341%
  342term_codes(X, Y):- term_codes(X, Y, []).
  343
  344%
  345equate( []) :- !.
  346equate([X = X| R]) :- equate(R).
  347
  348		/***************
  349		*     smash    *
  350		***************/

smash(+X:text) is det: Write all elements of text to the standard output ignoring the null byte code.

  356% ?- smash(a).
  357% ?- smash(a+b).
  358% ?- smash(f([b,c])).
  359% ?- smash([b,c]).
  360% ?- smash([]).
  361% ?- smash('[]').
  362
  363smash([]):- !.
  364smash([X|Y]):- !, smash(X), smash(Y).
  365% smash(0):- !.		% ignore  null bytes.
  366smash(X):- integer(X), !, put_code(X).
  367smash(X):- write(X).

smashq(+X:text) is det: Same as smasq, but use writeq/1 instead.

  372% ?- smashq(a).
  373% ?- smashq(a+b).
  374% ?- smashq(`a`).
  375% ?- smashq(f(`[b,c]`)).
  376% ?- smashq([b,c]).
  377% ?- smashq('[]').
  378% ?- smashq(`[]`).
  379
  380smashq([]):- !.
  381smashq([X|Y]):- !, smashq(X), smashq(Y).
  382% smashq(0):- !.    % null byte
  383smashq(X):- integer(X), !, put_code(X).
  384smashq(X):- writeq(X).

smash(+X:text, -Y:string) is det: Same as smash/1, but unify Y with the output string instead.

  389% ?- smash(a, X).
  390% ?- smash("a", X).
  391% ?- smash(f("a",b), X).
  392% ?- smash([a,b,c], X).
  393% ?- smash(`abc`, X).
  394
  395smash(X, Y):- smash_to_atomics(X, X0, []),
  396	atomics_to_string(X0, Y).
  397
  398% ?- smash([1, 2], X).
  399
  400% ?- codes_to_string([1,2,3], X), string_length(X, L).
  401%@ X = "\u0001\u0002\u0003",
  402%@ L = 3.
  403% ?- codes_to_string(1, X), string_length(X, L).
  404%
  405codes_to_string([], ""):-!.
  406codes_to_string(X, Y):-
  407	(	integer(X) -> char_code(Y, X)
  408	;	is_list(X),
  409		flatten(X, X0),
  410		string_codes(Y, X0)
  411	).
  412
  413% ?- term_string0("ab", X).
  414term_string0(X, Y):-
  415	(	string(X) -> Y = X
  416	;	atom(X) -> atom_string(X, Y)
  417	;	term_string(X, Y)
  418	).
  419
  420% ?- term_smash([], X).
  421% ?- term_smash([a], X).
  422% ?- term_smash([[a]], X).
  423% ?- term_smash(a+b, X).
  424% ?- term_smash("abc", X).
  425term_smash(X, Y):- pred_term_smash(X, Y, term_string).
  426
  427% ?- term_smash0(['abc'], X).
  428% ?- term_smash0(["abc", def], X).
  429term_smash0(X, Y):- pred_term_smash(X, Y, term_string0).
  430
  431%
  432:- meta_predicate pred_term_smash(?, ?, 2).  433pred_term_smash([], "", _):-!.
  434pred_term_smash([X|Y], Z, F):-!, pred_term_smash(X, U, F),
  435	pred_term_smash(Y, V, F),
  436	string_concat(U, V, Z).
  437pred_term_smash(X, Y, F):- call(F, X, Y).
  438
  439% ?- smash_string(1, X).
  440% ?- smash_string(-1, X).
  441% ?- smash_string([-12e-1], X).
  442%@ X = "-1.2".
  443% ?- smash_string(-12e-1, X).
  444%@ X = "-1.2".
  445% ?- smash_string(sin(-12e-1), X).
  446%@ X = "sin(-1.2)".
  447
  448% Assuming input argument contains no charactor code.
  449smash_string(X, Y):- flatten_atomics(X, Z, []),
  450	atomics_to_string(Z, Y).
  451
  452flatten_atomics([], A, A):-!.
  453flatten_atomics([X|Y], A, B):-!, flatten_atomics(X, A, C),
  454	flatten_atomics(Y, C, B).
  455flatten_atomics(X, [Y|A], A):- compound(X), !, term_string(X, Y).
  456flatten_atomics(X, [X|A], A).	% X must be atomic here.
  457
  458
  459% ?- smash_to_atomics([a,[],"b"+c], R,[]).
  460%@ R = [a, "\"b\"+c"].
  461% ?- smash_to_atomics([a,[97], b+c], R,[]).
  462%@ R = [a, 97, "b+c"].
  463% Assuming first argument may be a charactor code.
  464smash_to_atomics([], A, A):-!.
  465smash_to_atomics([X|Y], A, B):-!, smash_to_atomics(X, A, C),
  466	smash_to_atomics(Y, C, B).
  467smash_to_atomics(X, [Y|A], A)	:- compound(X), !, term_string(X, Y).
  468smash_to_atomics(X, [Y|A], A)	:- integer(X), X >=0, !,
  469	char_code(Y, X).
  470smash_to_atomics(X, [X|A], A).	% X must be atomic here.

smash_codes(+X:text, -Y:codes) is det: Same as smash/2, but unify Y with the output codes instead.

  476% ?- smash_codes(a, X).
  477% ?- smash_codes([97,b,[c,d], f(a, b)], X), smash(X).
  478
  479smash_codes(X, Y):- smash_to_codes(X, Y, []), !.
  480
  481%
  482smash_to_codes([], A, A).	% ground input is assumed.
  483smash_to_codes([X|Y], A, B):- smash_to_codes(X, A, C),
  484	smash_to_codes(Y, C, B).
  485% smash_to_codes(0, A, A).  % unnecessary for utf8 econding ?
  486smash_to_codes(C, [C|A], A):- integer(C).
  487smash_to_codes(X, A, B):- atom(X),
  488	atom_codes(X, X0),
  489	append(X0, B, A).
  490smash_to_codes(X, A, B):- string(X),
  491	string_codes(X, X0),
  492	append(X0, B, A).
  493smash_to_codes(X, A, B):- term_string(X, X0),
  494	string_codes(X0, X1),
  495	append(X1, B, A).
  496
  497
  498% ?- associative_comma((([], [a]), [b]), P, []).
  499% ?- associative_comma(((a,b), c), P, []).
  500associative_comma((X, Y), P, Q):-!, associative_comma(X, P, P0),
  501	associative_comma(Y, P0, Q).
  502associative_comma(X, [X|P], P).
  503
  504% ?- comma_list((a,b), X), comma_list(Y, X).
  505% ?- comma_list(a, X), comma_list(Y, X).
  506
  507% bi-dierectional between comma-list and list.
  508comma_list(X, Y):- nonvar(X), !, associative_comma(X, Y, []).
  509comma_list(X, Y):- list_to_comma(Y, X).

zip(?X:list, ?Y:list, ?Z:list) is det: Zip X and Y into Z with comma (,). ?- zip([a,b],[x,y], R), zip(A, X, R).

  514zip([], [], []):-!.
  515zip([A|X], [B|Y], [C|R]):- (C = (A-B); C = (A,B)), !,
  516	zip(X, Y, R).
  517%
  518zip(F, X, Y, Z):- maplist(F, X, Y, Z).
  519
  520% ?- different_terms([X,1]), X=2.
  521%  declare a constraint that all terms in the list are different.
  522different_terms([X|Y]) :- maplist(dif(X), Y),
  523	different_terms(Y).
  524different_terms([]).
  525
  526% tiny helpers
  527% enter(E,_,Y) :- pac:eval(E, Y).
  528peek(X,_,X).
  529peek(X,Y,X,Y).
  530current(X,X,X).
  531empty([],_).
  532empty_list(_, []).
  533car([A|_], A).
  534cdr([_|A], A).
  535cons(A, B, [A|B]).
  536singleton(A, [A]).
  537ordered_pair(A, B, (A, B)).
  538ordered_pair_p(A, B, p(A, B)).
  539return(A, B, [A|B]).		% cons <==> return !!
  540swap([A,B],[B,A]).
  541promote(A,[A]).
  542result(A,X) --> phrase(A), current(X). % result(A,X,Y,Y) :- act(A,Y,X).
  543id --> [].		%  X=Y
  544clear --> peek([]).
  545clear(X) --> peek(X,[]).

  546fst((A,_), A).
  547snd((_,B), B).
  548pair(A, B, (A,B)).
  549pair(A, B, X, (A0, B0) ):- call(A, X, A0), call(B, X, B0).
  550
  551			/******************
  552			*     splitting   *
  553			******************/
  554
  555% ?- paragraph(`a\n\nbc`, X).
  556%@ X = [[97], [98, 99]] .
  557% ?- paragraph(`a\n\nbc\n`, X).
  558%@ X = [[97], [98, 99, 10]] .
  559
  560% ?- listing(delimiter).
  561
  562paragraph(X, Y)		:-	split(plus, "\n\n", X, Y).
  563paragraph(E, X, Y)	:-	split(plus, E, X, Y).
  564
  565% ?- basic:split_string_by_word("abadea", "a", X).
  566split_string_by_word(X, Y, Z):- string_length(Y, N),
  567		      split_string_by_word(X, Y, N, Z0, []),
  568			  remove("", Z0, Z).
  569%
  570split_string_by_word(X, Y, K, [U|R], S):- sub_string(X, H, K, T, Y),!,
  571		      sub_string(X, 0, H, _, U),
  572		      sub_string(X, _, T, 0, V),
  573		      split_string_by_word(V, Y, K, R, S).
  574split_string_by_word(X, _, _, [X|R], R).
  575
  576% ?- basic:split(" ", ` a b c `, X).
  577%@ X = [[], [97], [98], [99], []] .
  578
  579split(X, Y)   :- split(=, `\n`, X, Y).
  580
  581%
  582split(E, X, Y):- split(=, E, X, Y).
  583
  584%
  585split(F, E, X, Y):- atom(E), !, atom_codes(E, E0),
  586	split(F, E0, Y, [], X, []).
  587split(F, E, X, Y):- string(E), !, string_codes(E, E0),
  588	split(F, E0, Y, [], X, []).
  589split(F, E, X, Y):- split(F, E, Y, [], X, []).
  590
  591%
  592split(F, C, [A|X], Y) --> dot_star(A, []), split_rest(F, C, X, Y).
  593split(_, _, [[]|X], X, [], []).
  594
  595%
  596split_rest(F, C, X, Y) --> delimiter(F, C), !, split(F, C, X, Y).
  597split_rest(_, _, X, X, [], []).
  598
  599% ?- basic:delimiter(=, `a`, `a`, R).
  600% ?- basic:delimiter(=, `ab`, `ac`, R).
  601% ?- basic:delimiter(plus, `a`, `aaaac`, R).
  602% ?- basic:delimiter(plus, `aa`, `aaab`, R).
  603% ?- basic:delimiter(plus, `aa`, `ab`, R).
  604
  605delimiter(=, C, X, Y):- !,  delimiter(C, X, Y).
  606delimiter(_, C, X, Y):- delimiter(C, X, X0), !,
  607	delimiter_plus(C, C, X0, Y).
  608
  609%
  610delimiter_plus([], C, X, Y):- !, delimiter_plus(C, C, X, Y).
  611delimiter_plus([A|X], C, [A|Y], Z):- !, delimiter_plus(X, C, Y, Z).
  612delimiter_plus(_, _, X, X).
  613
  614%
  615delimiter([A|X], [A|Y], Z):- delimiter(X, Y, Z).
  616delimiter([], X, X).
  617
  618%
  619dot_star(X, X) --> [].
  620dot_star([A|X], Y)--> [A], dot_star(X, Y).
  621
  622%%
  623repeat_chars(X)--> [C], {memberchk(C, X)}, repeat_chars(X).
  624repeat_chars(_)--> [].
  625
  626remove_last(X,Y,Z) :- append(Z,[X],Y), !.
  627remove_last(_,Y,Y).
  628
  629%
  630append_lists([L|R], X, Y):- append_one(L, X, X0),
  631	append_lists(R, X0, Y).
  632append_lists([], X, X).
  633
  634append_one([A|R], [A|X], Y):- append_one(R, X, Y).
  635append_one([], X, X).
  636
  637concat --> append.
  638
  639fullstop  --> ".\n".
  640
  641union(X, Y) :- append(X, X0), sort(X0, Y).
  642
  643residue(X, Y, Z) :- append(X, Z, Y).
  644
  645residue(X,Y,Z,U,V) :- append(X,V,U), append(X,Z,Y).
  646
  647remove(X, Y, Z) :- delete(Y, X, Z).
  648
  649% ?- basic:scan_prefix([b], [a,b,c], A, B).
  650
  651scan_prefix(C, X, Y, Z):- once(scan_prefix(X, Z, C, Y, [])).
  652%
  653scan_prefix(R, S, C, A, A):- append(C, S, R).
  654scan_prefix([X|R], S, C, [X|A], B):-
  655	scan_prefix(R, S, C, A, B).
  656scan_prefix([], [], _, A, A).
  657
  658% ?- basic:scan_escape_to(0'", `a\"bc"`, R, S, []), smash(R), nl, smash(S).
  659scan_escape_to(C, [C|R], R, [C|S], S).
  660scan_escape_to(C, [0'\\, A|X], X0, [0'\\, A|Y], Y0):-
  661	scan_escape_to(C, X, X0, Y, Y0).
  662scan_escape_to(C, [A|X], X0, [A|Y], Y0):-
  663	scan_escape_to(C, X, X0, Y, Y0).
  664scan_escape_to(_, X, X, Y, Y).
  665
  666%
  667comment_begin_end(`%`, `\n`, `\n`).
  668% comment_begin_end(`//`, `\n`,`\n`).
  669comment_begin_end(`/*`, `*/`, []).
  670
  671% ?- basic:remove_comment([a,b,c], X, []).
  672% ?- basic:remove_comment(`non comment%abc`, X, []), smash(X).
  673%@ X = [110, 111, 110, 32, 99, 111, 109, 109, 101|...] .
  674% ?- basic:remove_comment(`/***** abc ****/\nxyz`, X, []), smash(X).
  675% ?- basic:remove_comment(`/***** abc ****/xyz`, X, []), smash(X).
  676% ?- basic:remove_comment(`/**/\nxyz`, X, []), smash(X).
  677% ?- basic:remove_comment(`"/**/"\nxyz`, X, []), smash(X).
  678% ?- basic:remove_comment(`f("/**/")\nxyz`, X, []), smash(X).
  679% ?- basic:remove_comment(`f(0'\\\\, "/**/")\nxyz`, X, []), smash(X).
  680% ?- basic:remove_comment(`f(0'\\' , "/**/")\nxyz`, X, []), smash(X).
  681% ?- basic:remove_comment(`0'\\\\`, X, []), smash(X).
  682% ?- basic:remove_comment(`0'\\abc`, X, []), smash(X).
  683% ?- basic:remove_comment(`0'abc`, X, []), smash(X).
  684% ?- basic:remove_comment(`\\\\abc`, X, []), smash(X).
  685
  686remove_comment(X,Y):- remove_comment(X, Y, []).
  687
  688remove_comment([], X, X).
  689remove_comment(L, X, X0):-
  690	comment_begin_end(B, E, PushBack),
  691	append(B, L0, L),
  692	!,
  693	skip_to(E, L0, L1),
  694	append(PushBack, Y, X),
  695	remove_comment(L1, Y, X0).
  696remove_comment([Q|L], [Q|X], Y):- memq(Q,`"\`'`), !, % "
  697	scan_escape_to(Q, L, L0, X, X0),
  698	remove_comment(L0, X0, Y).
  699remove_comment([0'0, 0'\', A|L], [0'0, 0'\', A|X], Y):- !,
  700	(A == 0'\\				% '
  701	 ->		L=[B|L0],
  702			X=[B|X0],
  703			remove_comment(L0, X0, Y)
  704	;	remove_comment(L, X, Y)).
  705% remove_comment([0'0, 0'\', A|L], [0'0, 0'\', A|X], Y):- !,  %'
  706% 	remove_comment(L, X, Y).
  707remove_comment([A|L], [A|X], Y):-
  708	remove_comment(L, X, Y).
  709
  710%
  711skip_to(E, X, Y):- append(E, Y, X).
  712skip_to(E, [_|X], Y):- skip_to(E, X, Y).
  713skip_to(_,[],[]).
  714
  715:- meta_predicate delete_all(1,?,?).  716
  717delete_all(C, [X|Y], Z):- call(C, X), !, delete_all(C, Y, Z).
  718delete_all(C, [X|Y], [X|Z]):- delete_all(C, Y, Z).
  719delete_all(_, [], []).
  720
  721% ?-listsubst([([a],[b])],[a,a,a], R).
  722%@ R = [b,b,b]
  723
  724listsubst(_, [], []).
  725listsubst(X, Y, Z) :- member((A,B), X),
  726	append(A,Y1,Y),
  727	append(B,Z1,Z),
  728	listsubst(X, Y1, Z1).
  729listsubst(X, [A|Y], [A|Z]) :- listsubst(X,Y,Z).
  730
  731% %%% Comment and Quotation
  732
  733% comment(X) --> sandwich("/*", "*/", X)
  734% 	; sandwich("//", "\n", X)
  735% 	; sandwich("%", "\n", X).
  736
  737%%%%
  738% by W. Jan [2009/02/08]
  739% full-stop
  740% ?- basic:atom_to_term('a.\n', X, Y, user).
  741% ?- basic:atom_to_term('1.\n', X, Y, user).
  742
  743atom_to_term(Atom, Term, Bindings, Module) :-
  744	atom_to_memory_file(Atom, MF),
  745	open_memory_file(MF, read, Stream,
  746			 [ free_on_close(true)
  747			 ]),
  748	call_cleanup(read_term(Stream, Term,
  749			       [ variable_names(Bindings),
  750				 module(Module)
  751			       ]),
  752		     close(Stream)).
  753
  754:- meta_predicate collect(:,?,?).  755% ?- collect(=(1), [1,2,1,3], X).
  756% X = [1, 1]
  757% ?- collect(pred([X]:- atom_concat(_,pdf,X)), [a,b,xpdf,ypdf, c], L).
  758collect(F, X, Y):- collect_(X, Y, F).
  759%
  760collect_([X|R0], [X|R], F):- call(F, X), !, collect_(R0, R, F).
  761collect_([_|R0], R, F):- collect_(R0, R, F).
  762collect_([], [], _).
  763
  764:- meta_predicate collect_files(1, ?, ?).  765
  766collect_files(Filter, Dir,Ls):-
  767	directory_files(Dir, L0),
  768	collect(Filter, L0, Ls).
  769
  770:- meta_predicate image(3,?,?,?).  771% ?- image([X,X,X], [1,2,3],[1,3,3], L).
  772% L = [1,3].
  773image(F, [X|R0], [Y|S0], U):- (call(F, X, Y, Z) ->  U=[Z|T0]; U=T0),
  774	image(F, R0, S0, T0).
  775
  776%
  777dual(X, Y) :-  call(Y, X).
  778dual(X, Y, Z):- call(Y, X, Z).
  779
  780:- meta_predicate rev(2,?,?), rev(3,?,?,?).  781rev(F, X, Y) :- call(F, Y, X).
  782rev(F, X, Y, Z) :- call(F, X,  Z, Y).
  783
  784inverse(F, X, Y) :- call(F, Y, X).
  785inverse(F, X, Y, Z) :- call(F, X, Z, Y).
  786
  787% /**** course of values
  788% ?- course_of_values(n\l\n,  10, [1,1], X).
  789% X = [9, 8, 7, 6, 5, 4, 3, 2, 1|...].
  790% ?- eval(course_of_values(n\l\
  791%	(a\ (is:: ( a * n))@ car(l)), 10, [1,1]), X).
  792% X = [362880, 40320, 5040, 720, 120, 24, 6, 2, 1|...].
  793% ?- eval(course_of_values(n\fun([a],
  794%	is::( a * n)), 10, [1,1]), X).
  795% X = [362880, 40320, 5040, 720, 120, 24, 6, 2, 1|...].
  796% ****/
  797course_of_values(F, J, X, Y):-  cov(F, 1, J, X, Y).
  798
  799course_of_values(F, I, J, X, Y):-  cov(F, I, J, X, Y).
  800
  801% ?- cov(n\ fun([a], is:: (a*n)), 1, 5, [1, 1], X).
  802% X = [24, 6, 2, 1, 1, 1].
  803% ?- cov(n\ fun([], factorial(n,1)), 10, [1], X).
  804% X = [362880, 40320, 5040, 720, 120, 24, 6, 2, 1|...].
  805
  806cov(F, J, X, Y) :- cov(F, 1, J, X, Y).
  807
  808cov(_, N0, N, X, X):- N0 >= N, !.
  809cov(F, J,  N, X, Y):- eval:apply(F, [J, X], X0),
  810	J1 is J + 1,
  811	cov(F, J1, N, [X0|X], Y).

?- fun([x], x, [1,2,3], A). A = 1. ?- fun([x,y], set::(x+y), [[a,b], [c,d], [e]], X). X = [a, b, c, d].

  819% fun(P, F, X, A):- fresh_bind(P\F, P0\F0), append(P0, _, X), eval(F0,
  820% A).
  821
  822% ?-  list_rec(fun([a,b], (is::(a+b))), 10, [1,1], X).
  823% X = [144, 89, 55, 34, 21, 13, 8, 5, 3|...].
  824
  825list_rec(_, J, X, X):- J =< 0, !.
  826list_rec(F, J, X, Y):- eval:(F, [X], V),
  827	J1 is J - 1,
  828	list_rec(F, J1, [V|X], Y).
  829
  830% /***** nat_list_rec/[4,5]
  831% ?- nat_list_rec([j,l]\ ([x1, x2]\
  832%	(is:: (j+1)*x1*x2) @ nth1(1,l) @ nth1(2,l)), 5, [1,1], X).
  833% X = [1440, 48, 6, 2, 1, 1, 1].
  834% ?- nat_list_rec([j,l]\ some([x, y, r], (l=[x, y|r],
  835%	is:: (j+1)*x*y)), 5, [1,1], X).
  836% X = [1440, 48, 6, 2, 1, 1, 1].
  837% *******/
  838
  839nat_list_rec(F, N) --> nat_list_rec(F, 0, N).
  840
  841nat_list_rec(_, N, N, X, X):- !.
  842nat_list_rec(F, J, N, X, Y):-
  843	call(F, J, X, V),
  844	J1 is J + 1,
  845	nat_list_rec(F, J1, N, [V|X], Y).

is true if so is call(F, Y, X, Z).

  851:- meta_predicate variant(3, ?, ?, ?).  852% ?- variant(append, [a,b], [c, d], X).
  853% X = [c, d, a, b].
  854variant(X, Y, Z, U):- call(X, Z, Y, U).
  855
  856% ?- trace, eval(args(ev)::append(append([a,b],[c,d]), [e,f]), X).
  857% X = append([a, b, c, d], [e, f]).
  858% args(S, X, Y, [], [], true):- mapterm(eval(S), X, Y).
  859
  860%
  861with_order(Ord, G, X, Y):- sort(Ord, Ord0),
  862	zip(Ord, Ord0, A),
  863	subst(A, X, X0),
  864	call(G, X0, Y0),
  865	zip(Ord0, Ord, B),
  866	subst(B, Y0, Y).
  867
  868% ?- flatten(;, (a;b); c , X).
  869% X = [a, b, c]
  870
  871flatten(F, X, Xs):- flatten(F, X, Xs, []).
  872
  873flatten(F, X, A, B):- X=..[F, X1, X2], !,
  874	flatten(F, X1, A, A0),
  875	flatten(F, X2, A0, B).
  876flatten(_, X, [X|A], A).
  877
  878% ?- basic:flatten_dl([a,[b,c]], X, []).
  879flatten_dl([A|B], X, Y):- flatten_dl(A, X, Z),
  880	flatten_dl(B, Z, Y).
  881flatten_dl([], X, X).
  882flatten_dl(A, [A|X], X).
  883
  884% ?- flatten_more(f(a,[f(b,c)]), X).
  885% X = [f, a, f, b, c].
  886
  887flatten_more(A, [A|X], X):-var(A),!.
  888flatten_more([], X, X):-!.
  889flatten_more(A,[A|X], X):-  atomic(A),!.
  890flatten_more([A|B], X, Y):- !, flatten_more(A, X, X0),
  891	flatten_more(B, X0, Y).
  892flatten_more(A, [F|X], Y):- A =.. [F|As],
  893	flatten_more(As, X, Y).
  894
  895flatten_more(A, X):- once(flatten_more(A, X, [])).
  896
  897% ?- tree_path_set(f(1,g(2,3)), X).
  898% X = [[f,1],[f,g,2],[f,g,3]].
  899
  900tree_path_set(X, Y):- compound(X), !, X=..[F|A],
  901	maplist(tree_path_set, A, B),
  902	append(B, B0),
  903	maplist(cons(F), B0, Y).
  904tree_path_set(X, [[X]]).
  905
  906% push & pop
  907% ?- stack_push(1), stack_push(2), stack_pop(X), stack_pop(Y).
  908% X = 2,
  909% Y = 1.
  910
  911stack_init(S) :- nb_setval(S, []).
  912stack_push(X, S):- nb_getval(S, R), nb_linkval(S, [X|R]).
  913stack_pop(X, S):- nb_getval(S, [X|R]),  nb_linkval(S, R).
  914stack_update(X, S):- nb_getval(S, [_|R]),  nb_linkval(S, [X|R]).
  915stack_top(X, S):- nb_getval(S, [X|_]).
  916
  917stack_init :- stack_init('$STACK').
  918stack_push(X):- stack_push(X, '$STACK').
  919stack_pop(X):- stack_pop(X, '$STACK').
  920stack_update(X):- stack_update(X, '$STACK').
  921stack_top(X):- stack_top(X, '$STACK').

scan(+A:list/atomic, ?B:list, ?C:list, +X:list, -Y:list) is nondet: True if X = (B-C) + A0 + Y, where A0 is the list of codes of A if A is atomic, otherwise A0 = A; and '+' operator means the list concatenation. ?- basic:scan([a,b],S,[],[1,2,a,b,3,4], R). @ S = [1, 2], @ R = [3, 4] ;

  931% ?- basic:scan(`.\n`,S,[],`aaaaaa.\n==\n`, R).
  932% ?- basic:scan(".\n",S,[],`aaaaaa.\n==\n`, R).
  933
  934%@ true.
  935%%  first_token_codes(+L:codes, -X:codes) is det.
  936%	True if  X is unified with the maximum first codes block
  937%	that has no white codes.
  938
  939scan(A, S, T, X, Y):- atomic(A), !,
  940	atom_codes(A, B),
  941	scan_codes(B, S, T, X, Y).
  942scan(A, S, T, X, Y):- scan_codes(A, S, T, X, Y).
  943
  944%
  945scan_codes(A, S, S, X, Y):- append(A, Y, X).
  946scan_codes(Key, [A|As], U, [A|Xs], Y):- scan_codes(Key, As, U, Xs, Y).
  947%
  948fill  --> chars(`\s\t\r\n`).
  949
  950filler(_) --> chars(` \t`). % for compatibility
  951
  952% Tiny DCG
  953maybe_end --> chars(` \t`), peek([], end); herbrand(_).
  954
  955kleene_star(_, P, P).
  956kleene_star([X|Xs], [X|P], Q):-  append(Xs, P0, P),
  957	kleene_star([X|Xs], P0, Q).
  958
  959%
  960kleene_star_greedy([X|Xs], [X|P], Q):-  append(Xs, P0, P),
  961	kleene_star_greedy([X|Xs], P0, Q).
  962kleene_star_greedy(_, P, P).
  963
  964%
  965kleene_plus_greedy(X, Y, Z):- append(X, Z0, Y),
  966	kleene_star_greedy(X, Z0, Z).
  967
  968kleene_plus_greedy(X, Y, Z):- append(X, Z0, Y),
  969	kleene_star_greedy(X, Z0, Z).
  970
  971kleene_string_codes(S, C, D):- string_codes(S, Cs),
  972	kleene_plus_greedy(Cs, C, D).
  973
  974%
  975chars(_) --> [].
  976chars(L) --> [X], {memberchk(X, L)}, chars(L).
  977%
  978chars(L) --> [X], {memberchk(X, L)}, chars(L).
  979chars(_) --> [].
  980
  981% Idea by @brebs at Discourse.
  982
  983% ?- bi_reverse([a,b], [], X).
  984% ?- bi_reverse(X, Y, [b,a]).
  985bi_reverse(X, Y, Z):-
  986    bi_reverse(X, Y, Z, Z).
  987%
  988bi_reverse([], Z, _, Z).
  989bi_reverse([A|X], Y, [_|Z0], Z) :-
  990    bi_reverse(X, [A|Y], Z0, Z).
  991
  992% ?- predsort(ahead_compare([a,b]), [b,a,a,b,c], X).
  993% ?- predsort(ahead_compare([a,c,b]), [b,a,a,b,c], X).
  994% ?- predsort(ahead_compare([a,c,b]), [b,a,a,b,c], X).
  995% ?- predsort(ahead_compare([a,b,c]), [w, u,v], X).
  996%
  997% all elements not in the first list are identified with the first one.
  998%
  999ahead_compare(_,  =, X, X):-!.
 1000ahead_compare([], =, _, _):-!.
 1001ahead_compare([X|_], <, X, _):-!.
 1002ahead_compare([Y|_], >, _, Y):-!.
 1003ahead_compare([_|List], C, X, Y):- ahead_compare(List, C, X, Y)