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 herbrand_in_context/2, herbrand_in_context/3,
15 id/2, if/2, if/3,
16 listcast/2, listsubst/3,
17 prepend/3,
18 ordered_pair/3,
19 paragraph/2,
20 listp/1,
21 peek/3, peek/4,
22 remove/3, remove_last/3,
23 smash/1, smash/2, smash_codes/2,
24 term_string0/2, pred_term_smash/3, term_smash/2, term_smash0/2,
25 fst/2, fst/3, snd/2, snd/3, split/2, split/3,
26 split/4, split/6, split_rest/6, stack_init/0,
27 split_string_by_word/3,
28 scan_prefix/4, scan_prefix/5,
29 remove_comment/2, remove_comment/3,
30 bi_reverse/3,
31 stack_pop/2, stack_push/1, stack_push/2,
32 stack_top/1, stack_top/2, stack_update/1,
33 residue/3,
34 stack_update/2,
35 union/2, flatten_dl/3,
36 herbrand_opp/2, herbrand_opp/3, variant/4, cons/3,
37 zip/3
38 ]). 39
41max(A, B, A):- A@>B, !.
42max(_, B, B).
43
44min(A, B, A):- A@<B, !.
45min(_, B, B).
46
48max_of_list([X], X):-!.
49max_of_list([X, Y|Z], M):- X@<Y, !,
50 max_of_list([Y|Z], M).
51max_of_list([X, _|Z], M):- max_of_list([X|Z], M).
52
54min_of_list([X], X):-!.
55min_of_list([X, Y|Z], M):- Y@<X, !,
56 min_of_list([Y|Z], M).
57min_of_list([X, _|Z], M):- min_of_list([X|Z], M).
58
59
60:- use_module(pac(op)). 61
66
70:- meta_predicate iterated_deepening(0, ?, ?, ?). 71iterated_deepening(_, _, 0, depth_limit_reached):-!,
72 throw(depth_limit_reached).
73iterated_deepening(G, D, N, S):- N0 is N - 1,
74 writeln(depth(D, N)),
75 call_with_depth_limit(G, D, R),
76 ( R == depth_limit_exceeded
77 -> D1 is D + D,
78 iterated_deepening(G, D1, N0, S)
79 ; R = S
80 ).
87completing_options([D|R], X, Y):-
88 functor(D, F, 1),
89 functor(D0,F, 1),
90 ( memberchk(D0, X)
91 -> completing_options(R, X, Y)
92 ; completing_options(R, [D|X], Y)
93 ).
94completing_options([], X, X).
99:-meta_predicate if(0, 0, 0). 100
101if(X, Y, Z) :- ( call(X) -> call(Y); call(Z) ).
102if(X, Y) :- ( call(X) -> call(Y); true ).
103
105cast_to_list(X, Y):- var(X) -> Y = [X]
106 ; (X == []; X = [_|_]) -> Y = X
107 ; Y = [X].
108
109listp([]):-!.
110listp([_|_]).
111
114
115fst(F) --> main(F).
116snd(F) --> env(F).
117main(F, (X, Y), (X0, Y)):- phrase(F, X, X0).
118env(F, (X, Y), (X, Y0)):- phrase(F, Y, Y0).
119pipe_init(X, (X, [])).
122pipe_create(X, (X, [])).
124pipe_create(X, Y, (Y, X)).
126pipe_to_obj(P, Ob):- var(P), !,
127 obj:obj_pull([acc(X)], Ob, Ob0),
128 P = (X, Ob0).
130pipe_to_obj((X, Y), [acc(X)|Y]).
131
133obj_to_pipe(X, Y):- pipe_to_obj(Y, X).
134
136unary(F, A, T) :- T =.. [F, A].
137unary(F, T) :- functor(T, F, 1).
138n_ary(F, As, T) :- T =.. [F | As].
139
141list_to_comma([], true):-!.
142list_to_comma([X], X):-!.
143list_to_comma([X|Y], (X,Z)):- list_to_comma(Y,Z).
145binary_term(F, A, B, C):- C =.. [F, A, B].
146
149binary_term(_, [A], A):-!.
150binary_term(F, [A|B], C):- binary_term(F, B, C0),
151 binary_term(F, A, C0, C).
152
164narrowing(X, Y) :- subsumes(Y, X).
165
167memq(X, [Y|_]):- X==Y, !.
168memq(X, [_|Ys]):- memq(X, Ys).
169
171assocq([(A0-B)|_], A, B):- A==A0, !.
172assocq([_ |Ps], A, B):- assocq(Ps, A, B).
173
175assoc([A0 = B |_], A, B):- A==A0, !.
176assoc([_ |Ps], A, B):- assoc(Ps, A, B).
177
179unlist([X], X):-!.
180unlist(X, X).
181
183
184member(X, Y, [X|Xs], [Y|Xs]).
185member(X, Y, [A|Xs], [A|Ys]):- member(X, Y, Xs, Ys).
186
188appear(X, X).
189appear(X, Y):- Y=..[_|Y0], member(Z, Y0), appear(X, Z).
190
192list([]) --> [].
193list([X|Y]) --> [X], list(Y).
194
195listcast(X,X) :- listp(X),!.
196listcast(X,[X]).
197
207prepend(A, [A|X], X):- var(A), !.
208prepend([], X, X).
209prepend([A|R], X, Y) :- !, prepend(A, X, Z),
210 prepend(R, Z, Y).
211prepend(A, [A|X], X).
212
214polish_reserved(br, A, [0'\n|A]). 215
217save_bc(X) :- prolog_load_context(module, M),
218 scan(`.\n`, A, M, X, _), !,
219 herbrand(_, A, G0),
220 pac:expand_arg(G0, M, G, P, []),
221 maplist(assert, P),
222 nb_setval(saved_bc, G).
223
228
229 232
241
243herbrand_in_context(Mod, X, Y):-
244 ( string(X) -> X0 = X
245 ; string_codes(X0, X)
246 ),
247 term_string(Y, X0, [variable_names(_),
248 module(Mod)]).
249
251herbrand_in_context(X, Y):-
252 ( string(X) -> X0 = X
253 ; string_codes(X0, X)
254 ),
255 term_string(Y, X0, [variable_names(_), module(pac_op)]).
257herbrand(Mod, V_names, X, Y):-
258 term_codes(Y, X, [variable_names(V_names), module(Mod)]).
259
261herbrand(V_names, X, Y):-
262 term_codes(Y, X, [variable_names(V_names)]).
264herbrand(X, Y) :- herbrand(Eqs, X, Y), maplist(call, Eqs).
266herbrand0(X, Y) :- term_codes(Y, X, []).
267
269herbrand_opp(X, Y) :- herbrand(Y, X).
270herbrand_opp(V, X, Y) :- herbrand(V, Y, X).
271
273save_current_op(op(_, A, Z), op(P0, A0, Z)):- current_op(P0, A0, Z),
274 op_kind(A, Kind),
275 op_kind(A0, Kind),
276 !.
277save_current_op(op(_, A, Z), op(0, A, Z)).
278
280op_kind(xfx, infix).
281op_kind(xfy, infix).
282op_kind(yfx, infix).
283op_kind(fx, prefix).
284op_kind(fy, prefix).
285op_kind(xf, postfix).
286op_kind(yf, postfix).
287
289
290term_codes(X, Y, Options):- nonvar(Y), !,
291 string_codes(S, Y),
292 term_string(X, S, Options).
293term_codes(X, Y, Options):- memberchk(variable_names(V), Options), !,
294 equate(V),
295 term_string(X, S, Options),
296 string_codes(S, Y).
297term_codes(X, Y, Options):-
298 term_string(X, S, Options),
299 string_codes(S, Y).
300
302term_codes(X, Y):- term_codes(X, Y, []).
303
305equate( []) :- !.
306equate([X = X| R]) :- equate(R).
307
308
322
323smash([]):- !.
324smash([X|Y]):- !, smash(X), smash(Y).
326smash(X):- integer(X), !, put_code(X).
327smash(X):- write(X).
339
340smashq([]):- !.
341smashq([X|Y]):- !, smashq(X), smashq(Y).
343smashq(X):- integer(X), !, put_code(X).
344smashq(X):- writeq(X).
354
355smash(X, Y):- smash_to_atomics(X, X0, []),
356 atomics_to_string(X0, Y).
357
359term_string0(X, Y):-
360 ( string(X) -> Y = X
361 ; atom(X) -> atom_string(X, Y)
362 ; term_string(X, Y)
363 ).
364
370term_smash(X, Y):- pred_term_smash(X, Y, term_string).
371
374term_smash0(X, Y):- pred_term_smash(X, Y, term_string0).
375
377:- meta_predicate pred_term_smash(?, ?, 2). 378pred_term_smash([], "", _):-!.
379pred_term_smash([X|Y], Z, F):-!, pred_term_smash(X, U, F),
380 pred_term_smash(Y, V, F),
381 string_concat(U, V, Z).
382pred_term_smash(X, Y, F):- call(F, X, Y).
383
386
387smash_to_atomics([], A, A):-!.
388smash_to_atomics(X, [X0|A], A):- var(X), !, term_string(X, X0).
389smash_to_atomics([X|Y], A, B):-!, smash_to_atomics(X, A, C),
390 smash_to_atomics(Y, C, B).
392smash_to_atomics(X, [Y|A], A) :- compound(X), !, term_string(X, Y).
393smash_to_atomics(C, [C0|A], A) :- integer(C), !, char_code(C0, C).
394smash_to_atomics(X, [X|A], A).
401
402smash_codes(X, Y):- smash_to_codes(X, Y, []), !.
403
405smash_to_codes([], A, A). 406smash_to_codes([X|Y], A, B):- smash_to_codes(X, A, C),
407 smash_to_codes(Y, C, B).
409smash_to_codes(C, [C|A], A):- integer(C).
410smash_to_codes(X, A, B):- atom(X),
411 atom_codes(X, X0),
412 append(X0, B, A).
413smash_to_codes(X, A, B):- string(X),
414 string_codes(X, X0),
415 append(X0, B, A).
416smash_to_codes(X, A, B):- term_string(X, X0),
417 string_codes(X0, X1),
418 append(X1, B, A).
419
422associative_comma((X, Y), P, Q):-!, associative_comma(X, P, P0),
423 associative_comma(Y, P0, Q).
424associative_comma(end_of_file, P, P):-!.
425associative_comma(X, [X|P], P).
426
429
431comma_list(X, Y):- nonvar(X), !, associative_comma(X, Y, []).
432comma_list(X, Y):- list_to_comma(Y, X).
437zip([], [], []):-!.
438zip([A|X], [B|Y], [C|R]):- (C = (A-B); C = (A,B)), !,
439 zip(X, Y, R).
441zip(F, X, Y, Z):- maplist(F, X, Y, Z).
442
443
447different_terms([X|Y]) :- maplist(dif(X), Y),
448 different_terms(Y).
449different_terms([]).
450
453peek(X,_,X).
454peek(X,Y,X,Y).
455current(X,X,X).
456empty([],_).
457empty_list(_, []).
458car([A|_], A).
459cdr([_|A], A).
460cons(A, B, [A|B]).
461singleton(A, [A]).
462ordered_pair(A, B, (A, B)).
463ordered_pair_p(A, B, p(A, B)).
464return(A, B, [A|B]). 465swap([A,B],[B,A]).
466promote(A,[A]).
467result(A,X) --> phrase(A), current(X). 468id --> []. 469clear --> peek([]).
470clear(X) --> peek(X,[]).
471fst((A,_), A).
472snd((_,B), B).
473pair(A, B, (A,B)).
474pair(A, B, X, (A0, B0) ):- call(A, X, A0), call(B, X, B0).
475
476 479
484
485paragraph(X, Y) :- split(plus, "\n\n", X, Y).
486paragraph(E, X, Y) :- split(plus, E, X, Y).
487
489split_string_by_word(X, Y, Z):- string_length(Y, N),
490 split_string_by_word(X, Y, N, Z, []).
491
493split_string_by_word(X,Y,K,[U|R],S):- sub_string(X,H,K,T,Y),!,
494 sub_string(X,0,H,_,U),
495 sub_string(X,_,T,0,V),
496 split_string_by_word(V, Y, K, R, S).
497split_string_by_word(X,_,_,[X|R],R).
498
501
502split(X, Y) :- split(=, `\n`, X, Y).
503
505split(E, X, Y):- split(=, E, X, Y).
506
508split(F, E, X, Y):- atom(E), !, atom_codes(E, E0),
509 split(F, E0, Y, [], X, []).
510split(F, E, X, Y):- string(E), !, string_codes(E, E0),
511 split(F, E0, Y, [], X, []).
512split(F, E, X, Y):- split(F, E, Y, [], X, []).
513
515split(F, C, [A|X], Y) --> dot_star(A, []), split_rest(F, C, X, Y).
516split(_, _, [[]|X], X, [], []).
517
519split_rest(F, C, X, Y) --> delimiter(F, C), !, split(F, C, X, Y).
520split_rest(_, _, X, X, [], []).
521
527
528delimiter(=, C, X, Y):- !, delimiter(C, X, Y).
529delimiter(_, C, X, Y):- delimiter(C, X, X0), !,
530 delimiter_plus(C, C, X0, Y).
531
533delimiter_plus([], C, X, Y):- !, delimiter_plus(C, C, X, Y).
534delimiter_plus([A|X], C, [A|Y], Z):- !, delimiter_plus(X, C, Y, Z).
535delimiter_plus(_, _, X, X).
536
538delimiter([A|X], [A|Y], Z):- delimiter(X, Y, Z).
539delimiter([], X, X).
540
542dot_star(X, X) --> [].
543dot_star([A|X], Y)--> [A], dot_star(X, Y).
544
546repeat_chars(X)--> [C], {memberchk(C, X)}, repeat_chars(X).
547repeat_chars(_)--> [].
548
549remove_last(X,Y,Z) :- append(Z,[X],Y), !.
550remove_last(_,Y,Y).
551
553append_lists([L|R], X, Y):- append_one(L, X, X0),
554 append_lists(R, X0, Y).
555append_lists([], X, X).
556
557append_one([A|R], [A|X], Y):- append_one(R, X, Y).
558append_one([], X, X).
559
560concat --> append.
561
562fullstop --> ".\n".
563
564union(X, Y) :- append(X, X0), sort(X0, Y).
565
566residue(X, Y, Z) :- append(X, Z, Y).
567
568residue(X,Y,Z,U,V) :- append(X,V,U), append(X,Z,Y).
569
570remove(X, Y, Z) :- delete(Y, X, Z).
571
573
574scan_prefix(C, X, Y, Z):- once(scan_prefix(X, Z, C, Y, [])).
576scan_prefix(R, S, C, A, A):- append(C, S, R).
577scan_prefix([X|R], S, C, [X|A], B):-
578 scan_prefix(R, S, C, A, B).
579scan_prefix([], [], _, A, A).
580
582scan_escape_to(C, [C|R], R, [C|S], S).
583scan_escape_to(C, [0'\\, A|X], X0, [0'\\, A|Y], Y0):-
584 scan_escape_to(C, X, X0, Y, Y0).
585scan_escape_to(C, [A|X], X0, [A|Y], Y0):-
586 scan_escape_to(C, X, X0, Y, Y0).
587scan_escape_to(_, X, X, Y, Y).
588
(`%`, `\n`, `\n`).
592comment_begin_end(`/*`, `*/`, []).
593
608
(X,Y):- remove_comment(X, Y, []).
610
([], X, X).
612remove_comment(L, X, X0):-
613 comment_begin_end(B, E, PushBack),
614 append(B, L0, L),
615 !,
616 skip_to(E, L0, L1),
617 append(PushBack, Y, X),
618 remove_comment(L1, Y, X0).
619remove_comment([Q|L], [Q|X], Y):- memq(Q,`"\`'`), !, 620 scan_escape_to(Q, L, L0, X, X0),
621 remove_comment(L0, X0, Y).
622remove_comment([0'0, 0'\', A|L], [0'0, 0'\', A|X], Y):- !,
623 (A == 0'\\ 624 -> L=[B|L0],
625 X=[B|X0],
626 remove_comment(L0, X0, Y)
627 ; remove_comment(L, X, Y)).
630remove_comment([A|L], [A|X], Y):-
631 remove_comment(L, X, Y).
632
634skip_to(E, X, Y):- append(E, Y, X).
635skip_to(E, [_|X], Y):- skip_to(E, X, Y).
636skip_to(_,[],[]).
637
638:- meta_predicate delete_all(1,?,?). 639
640delete_all(C, [X|Y], Z):- call(C, X), !, delete_all(C, Y, Z).
641delete_all(C, [X|Y], [X|Z]):- delete_all(C, Y, Z).
642delete_all(_, [], []).
643
646
647listsubst(_, [], []).
648listsubst(X, Y, Z) :- member((A,B), X),
649 append(A,Y1,Y),
650 append(B,Z1,Z),
651 listsubst(X, Y1, Z1).
652listsubst(X, [A|Y], [A|Z]) :- listsubst(X,Y,Z).
653
655
659
665
666atom_to_term(Atom, Term, Bindings, Module) :-
667 atom_to_memory_file(Atom, MF),
668 open_memory_file(MF, read, Stream,
669 [ free_on_close(true)
670 ]),
671 call_cleanup(read_term(Stream, Term,
672 [ variable_names(Bindings),
673 module(Module)
674 ]),
675 close(Stream)).
676
677:- meta_predicate collect(:,?,?). 681collect(F, X, Y):- collect_(X, Y, F).
683collect_([X|R0], [X|R], F):- call(F, X), !, collect_(R0, R, F).
684collect_([_|R0], R, F):- collect_(R0, R, F).
685collect_([], [], _).
686
687:- meta_predicate collect_files(1, ?, ?). 688
689collect_files(Filter, Dir,Ls):-
690 directory_files(Dir, L0),
691 collect(Filter, L0, Ls).
692
693:- meta_predicate image(3,?,?,?). 696image(F, [X|R0], [Y|S0], U):- (call(F, X, Y, Z) -> U=[Z|T0]; U=T0),
697 image(F, R0, S0, T0).
698
700dual(X, Y) :- call(Y, X).
701dual(X, Y, Z):- call(Y, X, Z).
702
703:- meta_predicate rev(2,?,?), rev(3,?,?,?). 704rev(F, X, Y) :- call(F, Y, X).
705rev(F, X, Y, Z) :- call(F, X, Z, Y).
706
707inverse(F, X, Y) :- call(F, Y, X).
708inverse(F, X, Y, Z) :- call(F, X, Z, Y).
709
720course_of_values(F, J, X, Y):- cov(F, 1, J, X, Y).
721
722course_of_values(F, I, J, X, Y):- cov(F, I, J, X, Y).
723
728
729cov(F, J, X, Y) :- cov(F, 1, J, X, Y).
730
731cov(_, N0, N, X, X):- N0 >= N, !.
732cov(F, J, N, X, Y):- eval:apply(F, [J, X], X0),
733 J1 is J + 1,
734 cov(F, J1, N, [X0|X], Y).
744
747
748list_rec(_, J, X, X):- J =< 0, !.
749list_rec(F, J, X, Y):- eval:(F, [X], V),
750 J1 is J - 1,
751 list_rec(F, J1, [V|X], Y).
752
761
762nat_list_rec(F, N) --> nat_list_rec(F, 0, N).
763
764nat_list_rec(_, N, N, X, X):- !.
765nat_list_rec(F, J, N, X, Y):-
766 call(F, J, X, V),
767 J1 is J + 1,
768 nat_list_rec(F, J1, N, [V|X], Y).
774:- meta_predicate variant(3, ?, ?, ?). 777variant(X, Y, Z, U):- call(X, Z, Y, U).
778
782
784with_order(Ord, G, X, Y):- sort(Ord, Ord0),
785 zip(Ord, Ord0, A),
786 subst(A, X, X0),
787 call(G, X0, Y0),
788 zip(Ord0, Ord, B),
789 subst(B, Y0, Y).
790
793
794flatten(F, X, Xs):- flatten(F, X, Xs, []).
795
796flatten(F, X, A, B):- X=..[F, X1, X2], !,
797 flatten(F, X1, A, A0),
798 flatten(F, X2, A0, B).
799flatten(_, X, [X|A], A).
800
802flatten_dl([A|B], X, Y):- flatten_dl(A, X, Z),
803 flatten_dl(B, Z, Y).
804flatten_dl([], X, X).
805flatten_dl(A, [A|X], X).
806
809
810flatten_more(A, [A|X], X):-var(A),!.
811flatten_more([], X, X):-!.
812flatten_more(A,[A|X], X):- atomic(A),!.
813flatten_more([A|B], X, Y):- !, flatten_more(A, X, X0),
814 flatten_more(B, X0, Y).
815flatten_more(A, [F|X], Y):- A =.. [F|As],
816 flatten_more(As, X, Y).
817
818flatten_more(A, X):- once(flatten_more(A, X, [])).
819
822
823tree_path_set(X, Y):- compound(X), !, X=..[F|A],
824 maplist(tree_path_set, A, B),
825 append(B, B0),
826 maplist(cons(F), B0, Y).
827tree_path_set(X, [[X]]).
828
833
834stack_init(S) :- nb_setval(S, []).
835stack_push(X, S):- nb_getval(S, R), nb_linkval(S, [X|R]).
836stack_pop(X, S):- nb_getval(S, [X|R]), nb_linkval(S, R).
837stack_update(X, S):- nb_getval(S, [_|R]), nb_linkval(S, [X|R]).
838stack_top(X, S):- nb_getval(S, [X|_]).
839
840stack_init :- stack_init('$STACK').
841stack_push(X):- stack_push(X, '$STACK').
842stack_pop(X):- stack_pop(X, '$STACK').
843stack_update(X):- stack_update(X, '$STACK').
844stack_top(X):- stack_top(X, '$STACK').
856
861
862scan(A, S, T, X, Y):- atomic(A), !,
863 atom_codes(A, B),
864 scan_codes(B, S, T, X, Y).
865scan(A, S, T, X, Y):- scan_codes(A, S, T, X, Y).
866
868scan_codes(A, S, S, X, Y):- append(A, Y, X).
869scan_codes(Key, [A|As], U, [A|Xs], Y):- scan_codes(Key, As, U, Xs, Y).
871fill --> chars(` \t\r\n`).
872
873filler(_) --> chars(` \t`). 874
875
877maybe_end --> chars(` \t`), peek([], end); herbrand(_).
878
879kleene_star(_, P, P).
880kleene_star([X|Xs], [X|P], Q):- append(Xs, P0, P),
881 kleene_star([X|Xs], P0, Q).
882
884kleene_star_greedy([X|Xs], [X|P], Q):- append(Xs, P0, P),
885 kleene_star_greedy([X|Xs], P0, Q).
886kleene_star_greedy(_, P, P).
887
889kleene_plus_greedy(X, Y, Z):- append(X, Z0, Y),
890 kleene_star_greedy(X, Z0, Z).
891
892kleene_plus_greedy(X, Y, Z):- append(X, Z0, Y),
893 kleene_star_greedy(X, Z0, Z).
894
895kleene_string_codes(S, C, D):- string_codes(S, Cs),
896 kleene_plus_greedy(Cs, C, D).
897
899chars(_) --> [].
900chars(L) --> [X], {memberchk(X, L)}, chars(L).
902chars(L) --> [X], {memberchk(X, L)}, chars(L).
903chars(_) --> [].
904
906
909bi_reverse(X, Y, Z):-
910 bi_reverse(X, Y, Z, Z).
912bi_reverse([], Z, _, Z).
913bi_reverse([A|X], Y, [_|Z0], Z) :-
914 bi_reverse(X, [A|Y], Z0, Z).
915
923ahead_compare(_, =, X, X):-!.
924ahead_compare([], =, _, _):-!.
925ahead_compare([X|_], <, X, _):-!.
926ahead_compare([Y|_], >, _, Y):-!.
927ahead_compare([_|List], C, X, Y):- ahead_compare(List, C, X, Y)