YAP 7.1.0
maplist.yap
Go to the documentation of this file.
2/**
3 * @file maplist.yap
4 * @author Lawrence Byrd + Richard A. O'Keefe, VITOR SANTOS COSTA <vsc@VITORs-MBP.lan>
5 * @author : E. Alphonse from code by Joachim Schimpf, Jan Wielemaker, Vitor Santos Costa
6 * @date 4 August 1984 and Ken Johnson 11-8-87
7 *
8 * @brief Macros to apply a predicate to all elements of a list.
9 *
10 *
11*/
12
13:- module(maplist,
14 [maplist/2,
23 foldl/4,
24 foldl/5,
25 foldl/6,
26 foldl/7,
30 foldl3/8,
31 foldl4/10,
37 scanl/4,
38 scanl/5,
39 scanl/6,
40 scanl/7,
43 selectlists/5,
46 ]).
47
48:- meta_predicate
49 selectlist(1,+,-),
50 selectlist(2,+,+,-),
51 checklist(1,+),
52 maplist(1,+),
53 maplist(2,+,-),
54 maplist(3,+,+,-),
55 maplist(4,+,+,+,-),
56 maplist(5,+,+,+,+,-),
57 convlist(2,+,-),
58 convlist(3,?,?,?),
59 mapnodes(2,+,-),
60 mapnodes_list(2,+,-),
61 checknodes(1,+),
62 checknodes_list(1,+),
63 sumlist(3,+,+,-),
64 sumnodes(3,+,+,-),
65 sumnodes_body(3,+,+,-,+,+),
66 include(1,+,-),
67 exclude(1,+,-),
68 partition(1,+,-,-),
69 partition(2,+,-,-,-),
70 foldl(3, +, +, -),
71 foldl2(5, +, +, -, +, -),
72 foldl2(6, +, ?, +, -, +, -),
73 foldl2(6, +, ?, ?, +, -, +, -),
74 foldl3(5, +, +, -, +, -, +, -),
75 foldl4(7, +, +, -, +, -, +, -, +, -),
76 foldl(4, +, +, +, -),
77 foldl(5, +, +, +, +, -),
78 foldl(6, +, +, +, +, +, -),
79 scanl(3, +, +, -),
80 scanl(4, +, +, +, -),
81 scanl(5, +, +, +, +, -),
82 scanl(6, +, +, +, +, +, -).
83
84:- use_module(library(maputils)).
85:- append/3use_module(library(lists), []).
86:- format_to_chars/3read_from_chars/2use_module(library(charsio), [, ]).
87:- sub_term/2use_module(library(occurs), []).
88
89/**
90 * @defgroup maplist Map List and Term Operations
91 * @ingroup YAPLibrary
92 * @{
93 *
94 * This library provides a set of utilities for applying a predicate to
95 * all elements of a list. They allow one to easily perform the most common do-loop constructs in Prolog.
96 * To avoid performance degradation, each call creates an
97 * equivalent Prolog program, without meta-calls, which is executed by
98 * the Prolog engine instead. The library was based on code
99 * by Joachim Schimpf and on code from SWI-Prolog, and it is also inspired by the GHC
100 * libraries.
101 *
102 * The routines are available once included with the
103 * `use_module(library(maplist))` command.
104 * Examples:
105 *
106 * ~~~~
107 * plus(X,Y,Z) :- Z is X + Y.
108 *
109 * plus_if_pos(X,Y,Z) :- Y > 0, Z is X + Y.
110 *
111 * vars(X, Y, [X|Y]) :- var(X), !.
112 * vars(_, Y, Y).
113 *
114 * trans(TermIn, TermOut) :-
115 * nonvar(TermIn),
116 * TermIn =.. [p|Args],
117 * TermOut =..[q|Args], !.
118 * trans(X,X).
119 * ~~~~
120 * %success
121 *
122 * ?- maplist(plus(1), [1,2,3,4], [2,3,4,5]).
123 *
124 * ?- checklist(var, [X,Y,Z]).
125 *
126 * ?- selectlist(<(0), [-1,0,1], [1]).
127 *
128 * ?- convlist(plus_if_pos(1), [-1,0,1], [2]).
129 *
130 * ?- sumlist(plus, [1,2,3,4], 1, 11).
131 *
132 * ?- maplist(mapargs(number_atom),[c(1),s(1,2,3)],[c('1'),s('1','2','3')]).
133 * ~~~~
134 *
135 **/
136
137/** @pred maplist( 2:Pred, + _List1_,+ _List2_)
138
139Apply _Pred_ on all successive pairs of elements from
140 _List1_ and
141 _List2_. Fails if _Pred_ can not be applied to a
142pair. See the example above.
143
144
145*/
146
147/** @pred maplist(3:Pred,+ List1,+ List2,+ List4)
148
149Apply _Pred_ on all successive triples of elements from _List1_,
150 _List2_ and _List3_. Fails if _Pred_ can not be applied to a
151triple. See the example above.
152
153 */
154
155
156%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
157%
158% Definitions for Metacalls
159%
160%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
161
162/**
163 @pred include( 2:Pred, + ListIn, ? ListOut)
164
165 Same as selectlist/3.
166*/
167include(G,In,Out) :-
168 selectlist(G, In, Out).
169
170/**
171 @pred selectlist(1:Pred, + ListIn, ? ListOut))
172
173 Creates _ListOut_ of all list elements of _ListIn_ that pass a given test
174*/
175selectlist(_, [], []).
176selectlist(Pred, [In|ListIn], ListOut) :-
177 (call(Pred, In) ->
178 ListOut = [In|NewListOut]
179 ;
180 ListOut = NewListOut
181 ),
182 selectlist(Pred, ListIn, NewListOut).
183
184/**
185 @pred selectlist( 2:Pred, + ListIn, + ListInAux, ? ListOut, ? ListOutAux)
186
187 Creates _ListOut_ and _ListOutAux_ of all list elements of _ListIn_ and _ListInAux_ that
188 pass the given test _Pred_.
189*/
190selectlists(_, [], [], [], []).
191selectlists(Pred, [In|ListIn], [In1|ListIn1], ListOut, ListOut1) :-
192 (call(Pred, In, In1) ->
193 ListOut = [In|NewListOut],
194 ListOut1 = [In1|NewListOut1]
195 ;
196 ListOut1 = NewListOut1,
197 ListOut = NewListOut
198 ),
199 selectlist(Pred, ListIn, ListIn1, NewListOut, NewListOut1).
200
201/** @pred selectlist( 2:Pred, + ListIn, + ListInAux, ? ListOut)
202
203 Creates _ListOut_ of all list elements of _ListIn_ that
204 pass the given test _Pred_ using + _ListInAux_ as an
205 auxiliary element.
206*/
207selectlist(_, [], [], []).
208selectlist(Pred, [In|ListIn], [In1|ListIn1], ListOut) :-
209 (call(Pred, In, In1) ->
210 ListOut = [In|NewListOut]
211 ;
212 ListOut = NewListOut
213 ),
214 selectlist(Pred, ListIn, ListIn1, NewListOut).
215
216/**
217 @pred exclude( 2:Goal, + List1, ? List2)
218
219 Filter elements for which _Goal_ fails. True if _List2_ contains
220 those elements _Xi_ of _List1_ for which `call(Goal, Xi)` fails.
221*/
222exclude(_, [], []).
223exclude(Pred, [In|ListIn], ListOut) :-
224 (call(Pred, In) ->
225 ListOut = NewListOut
226 ;
227 ListOut = [In|NewListOut]
228 ),
229 exclude(Pred, ListIn, NewListOut).
230
231/**
232 @pred partition(1:Pred, + List1, ? Included, ? Excluded)
233
234 Filter elements of _List1_ according to _Pred_. True if
235 _Included_ contains all elements for which `call(Pred, X)`
236 succeeds and _Excluded_ contains the remaining elements.
237 */
238partition(_, [], [], []).
239partition(Pred, [In|ListIn], List1, List2) :-
240 (call(Pred, In) ->
241 List1 = [In|RList1],
242 List2 = RList2
243 ;
244 List1 = RList1,
245 List2 = [In|RList2]
246 ),
247 partition(Pred, ListIn, RList1, RList2).
248
249/**
250 @pred partition(2:Pred, + List1, ? Lesser, ? Equal, ? Greater)
251
252 Filter list according to _Pred_ in three sets. For each element
253 _Xi_ of _List_, its destination is determined by
254 `call(Pred, Xi, Place)`, where _Place_ must be unified to one
255 of `<`, `=` or `>`. `Pred` must be deterministic.
256
257
258*/
259partition(_, [], [], [], []).
260partition(Pred, [In|ListIn], List1, List2, List3) :-
261 call(Pred, In, Diff),
262 ( Diff == (<) ->
263 List1 = [In|RList1],
264 List2 = RList2,
265 List3 = RList3
266 ;
267 Diff == (=) ->
268 List1 = RList1,
269 List2 = [In|RList2],
270 List3 = RList3
271 ;
272 Diff == (>) ->
273 List1 = RList1,
274 List2 = RList2,
275 List3 = [In|RList3]
276 ;
277 must_be(oneof([<,=,>]), Diff)
278 ),
279 partition(Pred, ListIn, RList1, RList2, RList3).
280
281/**
282 @pred checklist( 1:Pred, + List)
283
284 Succeeds if the predicate _Pred_ succeeds on all elements of _List_.
285*/
286checklist(_, []).
287checklist(Pred, [In|ListIn]) :-
288 call(Pred, In),
289 checklist(Pred, ListIn).
290
291/**
292 @pred
293 ist(: Pred, ? ListIn)
294
295 Applies predicate _Pred_( _El_ ) to all
296 elements _El_ of _ListIn_.
297
298*/
299maplist(_, []).
300maplist(Pred, [In|ListIn]) :-
301 call(Pred, In),
302 maplist(Pred, ListIn).
303
304
305/**
306 @pred maplist(: Pred, ? L1, ? L2 )
307 _L1_ and _L2_ are such that
308 `call( _Pred_, _A1_, _A2_)` holds for every
309 corresponding element in lists _L1_, _L2_.
310
311 Comment from Richard O'Keefe: succeeds when _Pred( _Old_, _New_) succeeds for each corresponding
312 _Gi_ in _Listi_, _New_ in _NewList_. In InterLisp, this is MAPCAR.
313 It is also MAP2C. Isn't bidirectionality wonderful?
314*/
315maplist(_, [], []).
316maplist(Pred, [In|ListIn], [Out|ListOut]) :-
317 call(Pred, In, Out),
318 maplist(Pred, ListIn, ListOut).
319
320/**
321 @pred maplist(: Pred, ? L1, ? L2, ? L3)
322 _L1_, _L2_, and _L3_ are such that
323 `call( _Pred_, _A1_, _A2_, _A3_)` holds for every
324 corresponding element in lists _L1_, _L2_, and _L3_.
325
326*/
327maplist(_, [], [], []).
328maplist(Pred, [A1|L1], [A2|L2], [A3|L3]) :-
329 call(Pred, A1, A2, A3),
330 maplist(Pred, L1, L2, L3).
331
332/**
333 @pred maplist(: Pred, ? L1, ? L2, ? L3, ? L4)
334
335 _L1_, _L2_, _L3_, and _L4_ are such that
336 `call( _Pred_, _A1_, _A2_, _A3_, _A4_)` holds
337 for every corresponding element in lists _L1_, _L2_, _L3_, and
338 _L4_.
339*/
340maplist(_, [], [], [], []).
341maplist(Pred, [A1|L1], [A2|L2], [A3|L3], [A4|L4]) :-
342 call(Pred, A1, A2, A3, A4),
343 maplist(Pred, L1, L2, L3, L4).
344
345/**
346 @pred maplist(: Pred, ? L1, ? L2, ? L3, ? L4, ? L5)
347
348 _L1_, _L2_, _L3_, _L4_ and _L5_ are such that
349 `call( _Pred_, _A1_, _A2_, _A3_, _A4_,_A5_)` holds
350 for every corresponding element in lists _L1_, _L2_, _L3_, _L4_ and _L5_.
351*/
352maplist(_, [], [], [], [], []).
353maplist(Pred, [A1|L1], [A2|L2], [A3|L3], [A4|L4], [A5|L5]) :-
354 call(Pred, A1, A2, A3, A4, A5),
355 maplist(Pred, L1, L2, L3, L4, L5).
356
357/**
358 @pred convlist(: Pred, + ListIn, ? ListOut)
359
360 A combination of maplist/3 and selectlist/3: creates _ListOut_ by
361 applying the predicate _Pred_ to all list elements on which
362 _Pred_ succeeds.
363
364 ROK: convlist(Rewrite, OldList, NewList)
365 is a sort of hybrid of maplist/3 and sublist/3.
366 Each element of NewList is the image under Rewrite of some
367 element of OldList, and order is preserved, but elements of
368 OldList on which Rewrite is undefined (fails) are not represented.
369 Thus if foo(X,Y) :- integer(X), Y is X+1.
370 then convlist(foo, [1,a,0,joe(99),101], [2,1,102]).
371*/
372convlist(_, [], []).
373convlist(Pred, [Old|Olds], NewList) :-
374 call(Pred, Old, New),
375 call,
376 NewList = [New|News],
377 convlist(Pred, Olds, News).
378convlist(Pred, [_|Olds], News) :-
379 convlist(Pred, Olds, News).
380
381/**
382 @pred convlist(: Pred, ? ListIn, ?ExtraList, ? ListOut)
383
384 A combination of maplist/4 and selectlist/3: _ListIn_, _ListExtra_,
385 and _ListOut_ are the sublists so that the predicate _Pred_ succeeds.
386
387 ROK: convlist(Rewrite, OldList, NewList)
388 is a sort of hybrid of maplist/3 and sublist/3.
389 Each element of NewList is the image under Rewrite of some
390 element of OldList, and order is preserved, but elements of
391 OldList on which Rewrite is undefined (fails) are not represented.
392 Thus if foo(X,Y) :- integer(X), Y is X+1.
393 then convlist(foo, [1,a,0,joe(99),101], [2,1,102]).
394*/
395convlist(_, [], []).
396convlist(Pred, [Old|Olds], NewList) :-
397 call(Pred, Old, New),
398 call,
399 NewList = [New|News],
400 convlist(Pred, Olds, News).
401convlist(Pred, [_|Olds], News) :-
402 convlist(Pred, Olds, News).
403
404/**
405 @pred mapnodes(+ _Pred_, + _TermIn_, ? _TermOut_)
406
407 Creates _TermOut_ by applying the predicate _Pred_
408 to all sub-terms of _TermIn_ (depth-first and left-to-right order).
409*/
410mapnodes(Pred, TermIn, TermOut) :-
411 (atomic(TermIn); var(TermIn)), !,
412 call(Pred, TermIn, TermOut).
413mapnodes(Pred, TermIn, TermOut) :-
414 call(Pred, TermIn, Temp),
415 Temp =.. [Func|ArgsIn],
416 mapnodes_list(Pred, ArgsIn, ArgsOut),
417 TermOut =.. [Func|ArgsOut].
418
419mapnodes_list(_, [], []).
420mapnodes_list(Pred, [TermIn|ArgsIn], [TermOut|ArgsOut]) :-
421 mapnodes(Pred, TermIn, TermOut),
422 mapnodes_list(Pred, ArgsIn, ArgsOut).
423
424/**
425 @pred checknodes(+ _Pred_, + _Term_)
426
427 Succeeds if the predicate _Pred_ succeeds on all sub-terms of
428 _Term_ (depth-first and left-to-right order)
429*/
430checknodes(Pred, Term) :-
431 (atomic(Term); var(Term)), !,
432 call(Pred, Term).
433checknodes(Pred, Term) :-
434 call(Pred, Term),
435 Term =.. [_|Args],
436 checknodes_list(Pred, Args).
437
438checknodes_list(_, []).
439checknodes_list(Pred, [Term|Args]) :-
440 checknodes_body(Pred, Term),
441 checknodes_list(Pred, Args).
442
443/**
444 @pred sumlist(: _Pred_, + _List_, ? _AccIn_, ? _AccOut_)
445
446 Calls _Pred_ on all elements of List and collects a result in
447 _Accumulator_. Same as fold/4.
448*/
449sumlist(_, [], Acc, Acc).
450sumlist(Pred, [H|T], AccIn, AccOut) :-
451 call(Pred, H, AccIn, A1),
452 sumlist(Pred, T, A1, AccOut).
453
454/**
455 @pred sumnodes(+ _Pred_, + _Term_, ? _AccIn_, ? _AccOut_)
456
457 Calls the predicate _Pred_ on all sub-terms of _Term_ and
458 collect a result in _Accumulator_ (depth-first and left-to-right
459 order)
460*/
461sumnodes(Pred, Term, A0, A2) :-
462 call(Pred, Term, A0, A1),
463 (compound(Term) ->
464 functor(Term, _, N),
465 sumnodes_body(Pred, Term, A1, A2, 0, N)
466 ; % simple term or variable
467 A1 = A2
468 ).
469
470sumnodes_body(Pred, Term, A1, A3, N0, Ar) :-
471 N0 < Ar ->
472 N is N0+1,
473 arg(N, Term, Arg),
474 sumnodes(Pred, Arg, A1, A2),
475 sumnodes_body(Pred, Term, A2, A3, N, Ar)
476 ;
477 A1 = A3.
478
479
480/*******************************
481 * FOLDL *
482 *******************************/
483
484%%
485%% @pred foldl(:Goal, +List, +V0, -V, +W0, -WN).
486%
487
488/**
489 @pred oldl(: _Pred_, + _List1_, + _List2_, ? _AccIn_, ? _AccOut_)
490
491 The foldl family of predicates is defined
492 ==
493 foldl(P, [X11,...,X1n],V0, Vn, W0, WN) :-
494 P(X11, V0, V1, W0, W1),
495 ...
496 P(X1n, Vn1, Vn, Wn1, Wn).
497 ==
498 Calls _Pred_ on all elements of `List1` and collects a result in _Accumulator_. Same as
499 foldr/3.
500*/
501foldl(Goal, List, V0, V) :-
502 foldl_(List, Goal, V0, V).
503
504foldl_([], _, V, V).
505foldl_([H|T], Goal, V0, V) :-
506 call(Goal, H, V0, V1),
507 foldl_(T, Goal, V1, V).
508
509/**
510 @pred foldl(: _Pred_, + _List1_, + _List2_, ? _AccIn_, ? _AccOut_)
511
512 Calls _Pred_ on all elements of _List1_ and
513 _List2_ and collects a result in _Accumulator_. Same as
514 foldr/4.
515
516*/
517foldl(Goal, List1, List2, V0, V) :-
518 foldl_(List1, List2, Goal, V0, V).
519
520foldl_([], [], _, V, V).
521foldl_([H1|T1], [H2|T2], Goal, V0, V) :-
522 call(Goal, H1, H2, V0, V1),
523 foldl_(T1, T2, Goal, V1, V).
524
525/**
526
527@pred foldl(Goal, List1, List2, List3, V0, V)
528
529Apply _Goal_ plus five arguuments, three map to lists,
530two can be used as a difference_type.
531
532*/
533foldl(Goal, List1, List2, List3, V0, V) :-
534 foldl_(List1, List2, List3, Goal, V0, V).
535
536foldl_([], [], [], _, V, V).
537foldl_([H1|T1], [H2|T2], [H3|T3], Goal, V0, V) :-
538 call(Goal, H1, H2, H3, V0, V1),
539 foldl_(T1, T2, T3, Goal, V1, V).
540
541
542/**
543
544*/
545foldl(Goal, List1, List2, List3, List4, V0, V) :-
546 foldl_(List1, List2, List3, List4, Goal, V0, V).
547
548foldl_([], [], [], [], _, V, V).
549foldl_([H1|T1], [H2|T2], [H3|T3], [H4|T4], Goal, V0, V) :-
550 call(Goal, H1, H2, H3, H4, V0, V1),
551 foldl_(T1, T2, T3, T4, Goal, V1, V).
552
553
554/**
555 @pred foldl2(: _Pred_, + _List_, ? _X0_, ? _X_, ? _Y0_, ? _Y_)
556
557 Calls _Pred_ on all elements of `List` and collects a result in
558 _X_ and _Y_.
559
560*/
561foldl2(Goal, List, V0, V, W0, W) :-
562 foldl2_(List, Goal, V0, V, W0, W).
563
564foldl2_([], _, V, V, W, W).
565foldl2_([H|T], Goal, V0, V, W0, W) :-
566 call(Goal, H, V0, V1, W0, W1),
567 foldl2_(T, Goal, V1, V, W1, W).
568
569/**
570v @pred foldl2(: _Pred_, + _List_, ? _List1_, ? _X0_, ? _X_, ? _Y0_, ? _Y_)
571
572 Calls _Pred_ on all elements of _List_ and _List1_ and collects a result in
573 _X_ and _Y_.
574*/
575foldl2(Goal, List1, List2, V0, V, W0, W) :-
576 foldl2_(List1, List2, Goal, V0, V, W0, W).
577
578foldl2_([], [], _Goal, V, V, W, W).
579foldl2_([H1|T1], [H2|T2], Goal, V0, V, W0, W) :-
580 call(Goal, H1, H2, V0, V1, W0, W1),
581 foldl2_(T1, T2, Goal, V1, V, W1, W).
582
583/**
584 @pred foldl2(: _Pred_, + _List_, ? _List1_, ? _List2_, ? _X0_, ? _X_, ? _Y0_, ? _Y_)
585
586 Calls _Pred_ on all elements of _List_, _List1_ and _List2_ and collects a result in
587 _X_ and _Y_.
588
589*/
590foldl2(Goal, List1, List2, List3, V0, V, W0, W) :-
591 foldl2_(List1, List2, List3, Goal, V0, V, W0, W).
592
593foldl2_([], [], [], _Goal, V, V, W, W).
594foldl2_([H1|T1], [H2|T2], [H3|T3], Goal, V0, V, W0, W) :-
595 call(Goal, H1, H2, H3, V0, V1, W0, W1),
596 foldl2_(T1, T2, T3, Goal, V1, V, W1, W).
597
598
599/**
600 @pred foldl3(: _Pred_, + _List1_, ? _List2_, ? _X0_, ? _X_, ? _Y0_, ? _Y_, ? _Z0_, ? _Z_)
601
602
603 Calls _Pred_ on all elements of `List` and collects a
604 result in _X_, _Y_ and _Z_.
605*/
606foldl3(Goal, List, V0, V, W0, W, X0, X) :-
607 foldl3_(List, Goal, V0, V, W0, W, X0, X).
608
609foldl3_([], _, V, V, W, W, X, X).
610foldl3_([H|T], Goal, V0, V, W0, W, X0, X) :-
611 call(Goal, H, V0, V1, W0, W1, X0, X1),
612 fold3_(T, Goal, V1, V, W1, W, X1, X).
613
614/**
615 @pred foldl4(: _Pred_, + _List1_, ? _List2_, ? _X0_, ? _X_, ? _Y0_, ? _Y_, ? _Z0_, ? _Z_, ? _W0_, ? _W_)
616
617
618 Calls _Pred_ on all elements of `List` and collects a
619 result in _X_, _Y_, _Z_ and _W_.
620*/
621foldl4(Goal, List, V0, V, W0, W, X0, X, Y0, Y) :-
622 foldl4_(List, Goal, V0, V, W0, W, X0, X, Y0, Y).
623
624foldl4_([], _, V, V, W, W, X, X, Y, Y).
625foldl4_([H|T], Goal, V0, V, W0, W, X0, X, Y0, Y) :-
626 call(Goal, H, V0, V1, W0, W1, X0, X1, Y0, Y1),
627 foldl4_(T, Goal, V1, V, W1, W, X1, X, Y1, Y).
628
629
630
631/*******************************
632 * SCANL *
633 *******************************/
634
635%% scanl(:Goal, +List, +V0, -Values).
636%% scanl(:Goal, +List1, +List2, +V0, -Values).
637%% scanl(:Goal, +List1, +List2, +List3, +V0, -Values).
638%% scanl(:Goal, +List1, +List2, +List3, +List4, +V0, -Values).
639%
640% Left scan of list. The scanl family of higher order list
641% operations is defined by:
642%
643% ==
644% scanl(P, [X11,...,X1n], ..., [Xm1,...,Xmn], V0, [V0,V1,...,Vn]) :-
645% P(X11, ..., Xmn, V0, V1),
646% ...
647% P(X1n, ..., Xmn, V', Vn).
648% ==
649
650/**
651
652
653Left scan of list. The scanl family of higher order list
654operations is defined by:
655
656```
657 scanl(P, [X11,...,X1n], ..., [Xm1,...,Xmn], V0, [V0,V1,...,Vn]) :-
658 P(X11, ..., Xm1, V0, V1),
659 ...
660 P(X1n, ..., Xmn, Vn-1, Vn).
661```
662*/
663scanl(Goal, List, V0, [V0|Values]) :-
664 scanl_(List, Goal, V0, Values).
665
666scanl_([], _, _, []).
667scanl_([H|T], Goal, V, [VH|VT]) :-
668 call(Goal, H, V, VH),
669 scanl_(T, Goal, VH, VT).
670
671/**
672 scanl(: _Pred_, + _List1_, + _List2_, ? _V0_, ? _Vs_)
673
674Left scan of list.
675 */
676scanl(Goal, List1, List2, V0, [V0|Values]) :-
677 scanl_(List1, List2, Goal, V0, Values).
678
679scanl_([], [], _, _, []).
680scanl_([H1|T1], [H2|T2], Goal, V, [VH|VT]) :-
681 call(Goal, H1, H2, V, VH),
682 scanl_(T1, T2, Goal, VH, VT).
683
684/**
685 scanl(: _Pred_, + _List1_, + _List2_, + _List3_, ? _V0_, ? _Vs_)
686
687Left scan of list.
688*/
689scanl(Goal, List1, List2, List3, V0, [V0|Values]) :-
690 scanl_(List1, List2, List3, Goal, V0, Values).
691
692scanl_([], [], [], _, _, []).
693scanl_([H1|T1], [H2|T2], [H3|T3], Goal, V, [VH|VT]) :-
694 call(Goal, H1, H2, H3, V, VH),
695 scanl_(T1, T2, T3, Goal, VH, VT).
696
697/**
698 scanl(: _Pred_, + _List1_, + _List2_, + _List3_, + _List4_, ? _V0_, ? _Vs_)
699
700 Left scan of list.
701*/
702scanl(Goal, List1, List2, List3, List4, V0, [V0|Values]) :-
703 scanl_(List1, List2, List3, List4, Goal, V0, Values).
704
705scanl_([], [], [], [], _, _, []).
706scanl_([H1|T1], [H2|T2], [H3|T3], [H4|T4], Goal, V, [VH|VT]) :-
707 call(Goal, H1, H2, H3, H4, V, VH),
708 scanl_(T1, T2, T3, T4, Goal, VH, VT).
709
710
711goal_expansion(checklist(Meta, List), Mod:Goal) :-
712 goal_expansion,
713 callable(Meta),
714 current_source_module(Mod,Mod),
715 aux_preds(Meta, MetaVars, Pred, PredVars, Proto),
716 aux_preds,
717 % the new goal
718 pred_name(checklist, 2, Proto, GoalName),
719 append(MetaVars, [List], GoalArgs),
720 Goal =.. [GoalName|GoalArgs],
721 % the new predicate declaration
722 HeadPrefix =.. [GoalName|PredVars],
723 append_args(HeadPrefix, [[]], Base),
724 append_args(HeadPrefix, [[In|Ins]], RecursionHead),
725 append_args(Pred, [In], Apply),
726 append_args(HeadPrefix, [Ins], RecursiveCall),
727 compile_aux([
728 Base,
729 (RecursionHead :- Apply, RecursiveCall)
730 ], Mod).
731
732goal_expansion(maplist(Meta, List), Mod:Goal) :-
733 goal_expansion,
734 callable(Meta),
735 current_source_module(Mod,Mod),
736 aux_preds(Meta, MetaVars, Pred, PredVars, Proto),
737 aux_preds,
738 % the new goal
739 pred_name(maplist, 2, Proto, GoalName),
740 append(MetaVars, [List], GoalArgs),
741 Goal =.. [GoalName|GoalArgs],
742 % the new predicate declaration
743 HeadPrefix =.. [GoalName|PredVars],
744 append_args(HeadPrefix, [[]], Base),
745 append_args(HeadPrefix, [[In|Ins]], RecursionHead),
746 append_args(Pred, [In], Apply),
747 append_args(HeadPrefix, [Ins], RecursiveCall),
748 compile_aux([
749 Base,
750 (RecursionHead :- Apply, RecursiveCall)
751 ], Mod).
752
753goal_expansion(maplist(Meta, ListIn, ListOut), Mod:Goal) :-
754 goal_expansion,
755 callable(Meta),
756 current_source_module(Mod,Mod),
757 aux_preds(Meta, MetaVars, Pred, PredVars, Proto),
758 aux_preds,
759 % the new goal
760 pred_name(maplist, 3, Proto, GoalName),
761 append(MetaVars, [ListIn, ListOut], GoalArgs),
762 Goal =.. [GoalName|GoalArgs],
763 % the new predicate declaration
764 HeadPrefix =.. [GoalName|PredVars],
765 append_args(HeadPrefix, [[], []], Base),
766 append_args(HeadPrefix, [[In|Ins], [Out|Outs]], RecursionHead),
767 append_args(Pred, [In, Out], Apply),
768 append_args(HeadPrefix, [Ins, Outs], RecursiveCall),
769 compile_aux([ Base,
770 (RecursionHead :- Apply, RecursiveCall)
771 ], Mod).
772
773goal_expansion(maplist(Meta, L1, L2, L3), Mod:Goal) :-
774 goal_expansion,
775 callable(Meta),
776 current_source_module(Mod,Mod),
777 aux_preds(Meta, MetaVars, Pred, PredVars, Proto),
778 aux_preds,
779 % the new goal
780 pred_name(maplist, 4, Proto, GoalName),
781 append(MetaVars, [L1, L2, L3], GoalArgs),
782 Goal =.. [GoalName|GoalArgs],
783 % the new predicate declaration
784 HeadPrefix =.. [GoalName|PredVars],
785 append_args(HeadPrefix, [[], [], []], Base),
786 append_args(HeadPrefix, [[A1|A1s], [A2|A2s], [A3|A3s]], RecursionHead),
787 append_args(Pred, [A1, A2, A3], Apply),
788 append_args(HeadPrefix, [A1s, A2s, A3s], RecursiveCall),
789 compile_aux([
790 Base,
791 (RecursionHead :- Apply, RecursiveCall)
792 ], Mod).
793
794goal_expansion(maplist(Meta, L1, L2, L3, L4), Mod:Goal) :-
795 goal_expansion,
796 callable(Meta),
797 current_source_module(Mod,Mod),
798 aux_preds(Meta, MetaVars, Pred, PredVars, Proto),
799 aux_preds,
800 % the new goal
801 pred_name(maplist, 5, Proto, GoalName),
802 append(MetaVars, [L1, L2, L3, L4], GoalArgs),
803 Goal =.. [GoalName|GoalArgs],
804 % the new predicate declaration
805 HeadPrefix =.. [GoalName|PredVars],
806 append_args(HeadPrefix, [[], [], [], []], Base),
807 append_args(HeadPrefix, [[A1|A1s], [A2|A2s], [A3|A3s], [A4|A4s]], RecursionHead),
808 append_args(Pred, [A1, A2, A3, A4], Apply),
809 append_args(HeadPrefix, [A1s, A2s, A3s, A4s], RecursiveCall),
810 compile_aux([
811 Base,
812 (RecursionHead :- Apply, RecursiveCall)
813 ], Mod).
814
815goal_expansion(maplist(Meta, L1, L2, L3, L4, L5), Mod:Goal) :-
816 goal_expansion,
817 callable(Meta),
818 current_source_module(Mod,Mod),
819 aux_preds(Meta, MetaVars, Pred, PredVars, Proto),
820 aux_preds,
821 % the new goal
822 pred_name(maplist, 6, Proto, GoalName),
823 append(MetaVars, [L1, L2, L3, L4, L5], GoalArgs),
824 Goal =.. [GoalName|GoalArgs],
825 % the new predicate declaration
826 HeadPrefix =.. [GoalName|PredVars],
827 append_args(HeadPrefix, [[], [], [], [], []], Base),
828 append_args(HeadPrefix, [[A1|A1s], [A2|A2s], [A3|A3s], [A4|A4s], [A5|A5s]], RecursionHead),
829 append_args(Pred, [A1, A2, A3, A4, A5], Apply),
830 append_args(HeadPrefix, [A1s, A2s, A3s, A4s, A5s], RecursiveCall),
831 compile_aux([
832 Base,
833 (RecursionHead :- Apply, RecursiveCall)
834 ], Mod).
835
836goal_expansion(selectlist(Meta, ListIn, ListOut), Mod:Goal) :-
837 goal_expansion,
838 callable(Meta),
839 current_source_module(Mod,Mod),
840 aux_preds(Meta, MetaVars, Pred, PredVars, Proto),
841 aux_preds,
842 % the new goal
843 pred_name(selectlist, 3, Proto, GoalName),
844 append(MetaVars, [ListIn, ListOut], GoalArgs),
845 Goal =.. [GoalName|GoalArgs],
846 % the new predicate declaration
847 HeadPrefix =.. [GoalName|PredVars],
848 append_args(HeadPrefix, [[], []], Base),
849 append_args(HeadPrefix, [[In|Ins], Outs], RecursionHead),
850 append_args(Pred, [In], Apply),
851 append_args(HeadPrefix, [Ins, NOuts], RecursiveCall),
852 compile_aux([
853 Base,
854 (RecursionHead :-
855 (Apply -> Outs = [In|NOuts]; Outs = NOuts),
856 RecursiveCall)
857 ], Mod).
858
859goal_expansion(selectlist(Meta, ListIn, ListIn1, ListOut), Mod:Goal) :-
860 goal_expansion,
861 callable(Meta),
862 current_source_module(Mod,Mod),
863 aux_preds(Meta, MetaVars, Pred, PredVars, Proto),
864 aux_preds,
865 % the new goal
866 pred_name(selectlist, 3, Proto, GoalName),
867 append(MetaVars, [ListIn, ListIn1, ListOut], GoalArgs),
868 Goal =.. [GoalName|GoalArgs],
869 % the new predicate declaration
870 HeadPrefix =.. [GoalName|PredVars],
871 append_args(HeadPrefix, [[], [], []], Base),
872 append_args(HeadPrefix, [[In|Ins], [In1|Ins1], Outs], RecursionHead),
873 append_args(Pred, [In, In1], Apply),
874 append_args(HeadPrefix, [Ins, Ins1, NOuts], RecursiveCall),
875 compile_aux([
876 Base,
877 (RecursionHead :-
878 (Apply -> Outs = [In|NOuts]; Outs = NOuts),
879 RecursiveCall)
880 ], Mod).
881
882goal_expansion(selectlists(Meta, ListIn, ListIn1, ListOut, ListOut1), Mod:Goal) :-
883 goal_expansion,
884 callable(Meta),
885 current_source_module(Mod,Mod),
886 aux_preds(Meta, MetaVars, Pred, PredVars, Proto),
887 aux_preds,
888 % the new goal
889 pred_name(selectlists, 4, Proto, GoalName),
890 append(MetaVars, [ListIn, ListIn1, ListOut, ListOut1], GoalArgs),
891 Goal =.. [GoalName|GoalArgs],
892 % the new predicate declaration
893 HeadPrefix =.. [GoalName|PredVars],
894 append_args(HeadPrefix, [[], [], [], []], Base),
895 append_args(HeadPrefix, [[In|Ins], [In1|Ins1], Outs, Outs1], RecursionHead),
896 append_args(Pred, [In, Out], Apply),
897 append_args(HeadPrefix, [Ins, Ins1, NOuts, NOuts1], RecursiveCall),
898 compile_aux([
899 Base,
900 (RecursionHead :-
901 (Apply -> Outs = [Out|NOuts], Outs1 = [In1|NOuts1]; Outs = NOuts, Outs1 = NOuts1),
902 RecursiveCall)
903 ], Mod).
904
905% same as selectlist
906goal_expansion(include(Meta, ListIn, ListOut), Mod:Goal) :-
907 goal_expansion,
908 callable(Meta),
909 current_source_module(Mod,Mod),
910 aux_preds(Meta, MetaVars, Pred, PredVars, Proto),
911 aux_preds,
912 % the new goal
913 pred_name(include, 3, Proto, GoalName),
914 append(MetaVars, [ListIn, ListOut], GoalArgs),
915 Goal =.. [GoalName|GoalArgs],
916 % the new predicate declaration
917 HeadPrefix =.. [GoalName|PredVars],
918 append_args(HeadPrefix, [[], []], Base),
919 append_args(HeadPrefix, [[In|Ins], Outs], RecursionHead),
920 append_args(Pred, [In], Apply),
921 append_args(HeadPrefix, [Ins, NOuts], RecursiveCall),
922 compile_aux([
923 Base,
924 (RecursionHead :-
925 (Apply -> Outs = [In|NOuts]; Outs = NOuts),
926 RecursiveCall)
927 ], Mod).
928
929goal_expansion(exclude(Meta, ListIn, ListOut), Mod:Goal) :-
930 goal_expansion,
931 callable(Meta),
932 current_source_module(Mod,Mod),
933 aux_preds(Meta, MetaVars, Pred, PredVars, Proto),
934 aux_preds,
935 % the new goal
936 pred_name(exclude, 3, Proto, GoalName),
937 append(MetaVars, [ListIn, ListOut], GoalArgs),
938 Goal =.. [GoalName|GoalArgs],
939 % the new predicate declaration
940 HeadPrefix =.. [GoalName|PredVars],
941 append_args(HeadPrefix, [[], []], Base),
942 append_args(HeadPrefix, [[In|Ins], Outs], RecursionHead),
943 append_args(Pred, [In], Apply),
944 append_args(HeadPrefix, [Ins, NOuts], RecursiveCall),
945 compile_aux([
946 Base,
947 (RecursionHead :-
948 (Apply -> Outs = NOuts; Outs = [In|NOuts]),
949 RecursiveCall)
950 ], Mod).
951
952goal_expansion(partition(Meta, ListIn, List1, List2), Mod:Goal) :-
953 goal_expansion,
954 callable(Meta),
955 current_source_module(Mod,Mod),
956 aux_preds(Meta, MetaVars, Pred, PredVars, Proto),
957 aux_preds,
958 % the new goal
959 pred_name(partition, 4, Proto, GoalName),
960 append(MetaVars, [ListIn, List1, List2], GoalArgs),
961 Goal =.. [GoalName|GoalArgs],
962 % the new predicate declaration
963 HeadPrefix =.. [GoalName|PredVars],
964 append_args(HeadPrefix, [[], [], []], Base),
965 append_args(HeadPrefix, [[In|Ins], Outs1, Outs2], RecursionHead),
966 append_args(Pred, [In], Apply),
967 append_args(HeadPrefix, [Ins, NOuts1, NOuts2], RecursiveCall),
968 compile_aux([
969 Base,
970 (RecursionHead :-
971 (Apply -> Outs1 = [In|NOuts1], Outs2 = NOuts2; Outs1 = NOuts1, Outs2 = [In|NOuts2]),
972 RecursiveCall)
973 ], Mod).
974
975goal_expansion(partition(Meta, ListIn, List1, List2, List3), Mod:Goal) :-
976 goal_expansion,
977 callable(Meta),
978 current_source_module(Mod,Mod),
979 aux_preds(Meta, MetaVars, Pred, PredVars, Proto),
980 aux_preds,
981 % the new goal
982 pred_name(partition2, 5, Proto, GoalName),
983 append(MetaVars, [ListIn, List1, List2, List3], GoalArgs),
984 Goal =.. [GoalName|GoalArgs],
985 % the new predicate declaration
986 HeadPrefix =.. [GoalName|PredVars],
987 append_args(HeadPrefix, [[], [], [], []], Base),
988 append_args(HeadPrefix, [[In|Ins], Outs1, Outs2, Outs3], RecursionHead),
989 append_args(Pred, [In,Diff], Apply),
990 append_args(HeadPrefix, [Ins, NOuts1, NOuts2, NOuts3], RecursiveCall),
991 compile_aux([
992 Base,
993 (RecursionHead :-
994 Apply,
995 (Diff == (<) ->
996 Outs1 = [In|NOuts1],
997 Outs2 = NOuts2,
998 Outs3 = NOuts3
999 ;
1000 Diff == (=) ->
1001 Outs1 = NOuts1,
1002 Outs2 = [In|NOuts2],
1003 Outs3 = NOuts3
1004 ;
1005 Diff == (>) ->
1006 Outs1 = NOuts1,
1007 Outs2 = NOuts2,
1008 Outs3 = [In|NOuts3]
1009 ;
1010 must_be(oneof([<,=,>]), Diff)
1011 ),
1012 RecursiveCall)
1013 ], Mod).
1014
1015goal_expansion(convlist(Meta, ListIn, ListOut), Mod:Goal) :-
1016 goal_expansion,
1017 callable(Meta),
1018 current_source_module(Mod,Mod),
1019 aux_preds(Meta, MetaVars, Pred, PredVars, Proto),
1020 aux_preds,
1021 % the new goal
1022 pred_name(convlist, 3, Proto, GoalName),
1023 append(MetaVars, [ListIn, ListOut], GoalArgs),
1024 Goal =.. [GoalName|GoalArgs],
1025 % the new predicate declaration
1026 HeadPrefix =.. [GoalName|PredVars],
1027 append_args(HeadPrefix, [[], []], Base),
1028 append_args(HeadPrefix, [[In|Ins], Outs], RecursionHead),
1029 append_args(Pred, [In, Out], Apply),
1030 append_args(HeadPrefix, [Ins, NOuts], RecursiveCall),
1031 compile_aux([
1032 Base,
1033 (RecursionHead :-
1034 (Apply -> Outs = [Out|NOuts]; Outs = NOuts),
1035 RecursiveCall)
1036 ], Mod).
1037
1038goal_expansion(convlist(Meta, ListIn, ListExtra, ListOut), Mod:Goal) :-
1039 goal_expansion,
1040 callable(Meta),
1041 current_source_module(Mod,Mod),
1042 aux_preds(Meta, MetaVars, Pred, PredVars, Proto),
1043 aux_preds,
1044 % the new goal
1045 pred_name(convlist, 4, Proto, GoalName),
1046 append(MetaVars, [ListIn, ListExtra, ListOut], GoalArgs),
1047 Goal =.. [GoalName|GoalArgs],
1048 % the new predicate declaration
1049 HeadPrefix =.. [GoalName|PredVars],
1050 append_args(HeadPrefix, [[], [], []], Base),
1051 append_args(HeadPrefix, [[In|Ins], [Extra|Extras], Outs], RecursionHead),
1052 append_args(Pred, [In, Extra, Out], Apply),
1053 append_args(HeadPrefix, [Ins, Extras, NOuts], RecursiveCall),
1054 compile_aux([
1055 Base,
1056 (RecursionHead :-
1057 (Apply -> Outs = [Out|NOuts]; Outs = NOuts),
1058 RecursiveCall)
1059 ], Mod).
1060
1061goal_expansion(sumlist(Meta, List, AccIn, AccOut), Mod:Goal) :-
1062 goal_expansion,
1063 callable(Meta),
1064 current_source_module(Mod,Mod),
1065 aux_preds(Meta, MetaVars, Pred, PredVars, Proto),
1066 aux_preds,
1067 % the new goal
1068 pred_name(sumlist, 4, Proto, GoalName),
1069 append(MetaVars, [List, AccIn, AccOut], GoalArgs),
1070 Goal =.. [GoalName|GoalArgs],
1071 % the new predicate declaration
1072 HeadPrefix =.. [GoalName|PredVars],
1073 append_args(HeadPrefix, [[], Acc, Acc], Base),
1074 append_args(HeadPrefix, [[In|Ins], Acc1, Acc2], RecursionHead),
1075 append_args(Pred, [In, Acc1, Acc3], Apply),
1076 append_args(HeadPrefix, [Ins, Acc3, Acc2], RecursiveCall),
1077 compile_aux([
1078 Base,
1079 (RecursionHead :- Apply, RecursiveCall)
1080 ], Mod).
1081
1082goal_expansion(foldl(Meta, List, AccIn, AccOut), Mod:Goal) :-
1083 goal_expansion,
1084 callable(Meta),
1085 current_source_module(Mod,Mod),
1086 aux_preds(Meta, MetaVars, Pred, PredVars, Proto),
1087 aux_preds,
1088 % the new goal
1089 pred_name(foldl, 4, Proto, GoalName),
1090 append(MetaVars, [List, AccIn, AccOut], GoalArgs),
1091 Goal =.. [GoalName|GoalArgs],
1092 % the new predicate declaration
1093 HeadPrefix =.. [GoalName|PredVars],
1094 append_args(HeadPrefix, [[], Acc, Acc], Base),
1095 append_args(HeadPrefix, [[In|Ins], Acc1, Acc2], RecursionHead),
1096 append_args(Pred, [In, Acc1, Acc3], Apply),
1097 append_args(HeadPrefix, [Ins, Acc3, Acc2], RecursiveCall),
1098 compile_aux([
1099 Base,
1100 (RecursionHead :- Apply, RecursiveCall)
1101 ], Mod).
1102
1103goal_expansion(foldl(Meta, List1, List2, AccIn, AccOut), Mod:Goal) :-
1104 goal_expansion,
1105 callable(Meta),
1106 current_source_module(Mod,Mod),
1107 aux_preds(Meta, MetaVars, Pred, PredVars, Proto),
1108 aux_preds,
1109 % the new goal
1110 pred_name(foldl, 5, Proto, GoalName),
1111 append(MetaVars, [List1, List2, AccIn, AccOut], GoalArgs),
1112 Goal =.. [GoalName|GoalArgs],
1113 % the new predicate declaration
1114 HeadPrefix =.. [GoalName|PredVars],
1115 append_args(HeadPrefix, [[], [], Acc, Acc], Base),
1116 append_args(HeadPrefix, [[In|Ins], [I2|Is2], Acc1, Acc2], RecursionHead),
1117 append_args(Pred, [In, I2, Acc1, Acc3], Apply),
1118 append_args(HeadPrefix, [Ins, Is2, Acc3, Acc2], RecursiveCall),
1119 compile_aux([
1120 Base,
1121 (RecursionHead :- Apply, RecursiveCall)
1122 ], Mod).
1123
1124goal_expansion(foldl(Meta, List1, List2, List3, AccIn, AccOut), Mod:Goal) :-
1125 goal_expansion,
1126 callable(Meta),
1127 current_source_module(Mod,Mod),
1128 aux_preds(Meta, MetaVars, Pred, PredVars, Proto),
1129 aux_preds,
1130 % the new goal
1131 pred_name(foldl, 6, Proto, GoalName),
1132 append(MetaVars, [List1, List2, List3, AccIn, AccOut], GoalArgs),
1133 Goal =.. [GoalName|GoalArgs],
1134 % the new predicate declaration
1135 HeadPrefix =.. [GoalName|PredVars],
1136 append_args(HeadPrefix, [[], [], [], Acc, Acc], Base),
1137 append_args(HeadPrefix, [[In|Ins], [I2|I2s], [I3|I3s], Acc1, Acc2], RecursionHead),
1138 append_args(Pred, [In, I2, I3, Acc1, Acc3], Apply),
1139 append_args(HeadPrefix, [Ins, I2s, I3s, Acc3, Acc2], RecursiveCall),
1140 compile_aux([
1141 Base,
1142 (RecursionHead :- Apply, RecursiveCall)
1143 ], Mod).
1144
1145goal_expansion(foldl2(Meta, List, AccIn, AccOut, W0, W), Mod:Goal) :-
1146 goal_expansion,
1147 callable(Meta),
1148 current_source_module(Mod,Mod),
1149 aux_preds(Meta, MetaVars, Pred, PredVars, Proto),
1150 aux_preds,
1151 % the new goal
1152 pred_name(foldl2, 6, Proto, GoalName),
1153 append(MetaVars, [List, AccIn, AccOut, W0, W], GoalArgs),
1154 Goal =.. [GoalName|GoalArgs],
1155 % the new predicate declaration
1156 HeadPrefix =.. [GoalName|PredVars],
1157 append_args(HeadPrefix, [[], Acc, Acc, W, W], Base),
1158 append_args(HeadPrefix, [[In|Ins], Acc1, Acc2, W1, W2], RecursionHead),
1159 append_args(Pred, [In, Acc1, Acc3, W1, W3], Apply),
1160 append_args(HeadPrefix, [Ins, Acc3, Acc2, W3, W2], RecursiveCall),
1161 compile_aux([
1162 Base,
1163 (RecursionHead :- Apply, RecursiveCall)
1164 ], Mod).
1165
1166goal_expansion(foldl2(Meta, List1, List2, AccIn, AccOut, W0, W), Mod:Goal) :-
1167 goal_expansion,
1168 callable(Meta),
1169 current_source_module(Mod,Mod),
1170 aux_preds(Meta, MetaVars, Pred, PredVars, Proto),
1171 aux_preds,
1172 % the new goal
1173 pred_name(foldl2, 7, Proto, GoalName),
1174 append(MetaVars, [List1, List2, AccIn, AccOut, W0, W], GoalArgs),
1175 Goal =.. [GoalName|GoalArgs],
1176 % the new predicate declaration
1177 HeadPrefix =.. [GoalName|PredVars],
1178 append_args(HeadPrefix, [[], [], Acc, Acc, W, W], Base),
1179 append_args(HeadPrefix, [[In1|Ins1], [In2|Ins2], Acc1, Acc2, W1, W2], RecursionHead),
1180 append_args(Pred, [In1, In2, Acc1, Acc3, W1, W3], Apply),
1181 append_args(HeadPrefix, [Ins1, Ins2, Acc3, Acc2, W3, W2], RecursiveCall),
1182 compile_aux([
1183 Base,
1184 (RecursionHead :- Apply, RecursiveCall)
1185 ], Mod).
1186
1187goal_expansion(foldl2(Meta, List1, List2, List3, AccIn, AccOut, W0, W), Mod:Goal) :-
1188 goal_expansion,
1189 callable(Meta),
1190 current_source_module(Mod,Mod),
1191 aux_preds(Meta, MetaVars, Pred, PredVars, Proto),
1192 aux_preds,
1193 % the new goal
1194 pred_name(foldl2, 7, Proto, GoalName),
1195 append(MetaVars, [List1, List2, List3, AccIn, AccOut, W0, W], GoalArgs),
1196 Goal =.. [GoalName|GoalArgs],
1197 % the new predicate declaration
1198 HeadPrefix =.. [GoalName|PredVars],
1199 append_args(HeadPrefix, [[], [], [], Acc, Acc, W, W], Base),
1200 append_args(HeadPrefix, [[In1|Ins1], [In2|Ins2], [In3|Ins3], Acc1, Acc2, W1, W2], RecursionHead),
1201 append_args(Pred, [In1, In2, In3, Acc1, Acc3, W1, W3], Apply),
1202 append_args(HeadPrefix, [Ins1, Ins2, Ins3, Acc3, Acc2, W3, W2], RecursiveCall),
1203 compile_aux([
1204 Base,
1205 (RecursionHead :- Apply, RecursiveCall)
1206 ], Mod).
1207
1208goal_expansion(foldl3(Meta, List, AccIn, AccOut, W0, W, X0, X), Mod:Goal) :-
1209 goal_expansion,
1210 callable(Meta),
1211 current_source_module(Mod,Mod),
1212 aux_preds(Meta, MetaVars, Pred, PredVars, Proto),
1213 aux_preds,
1214 % the new goal
1215 pred_name(foldl3, 8, Proto, GoalName),
1216 append(MetaVars, [List, AccIn, AccOut, W0, W, X0, X], GoalArgs),
1217 Goal =.. [GoalName|GoalArgs],
1218 % the new predicate declaration
1219 HeadPrefix =.. [GoalName|PredVars],
1220 append_args(HeadPrefix, [[], Acc, Acc, W, W, X, X], Base),
1221 append_args(HeadPrefix, [[In|Ins], Acc1, Acc2, W1, W2, X1, X2], RecursionHead),
1222 append_args(Pred, [In, Acc1, Acc3, W1, W3, X1, X3], Apply),
1223 append_args(HeadPrefix, [Ins, Acc3, Acc2, W3, W2, X3, X2], RecursiveCall),
1224 compile_aux([
1225 Base,
1226 (RecursionHead :- Apply, RecursiveCall)
1227 ], Mod).
1228
1229goal_expansion(foldl4(Meta, List, AccIn, AccOut, W0, W, X0, X, Y0, Y), Mod:Goal) :-
1230 goal_expansion,
1231 callable(Meta),
1232 current_source_module(Mod,Mod),
1233 aux_preds(Meta, MetaVars, Pred, PredVars, Proto),
1234 aux_preds,
1235 % the new goal
1236 pred_name(foldl4, 8, Proto, GoalName),
1237 append(MetaVars, [List, AccIn, AccOut, W0, W, X0, X, Y0, Y], GoalArgs),
1238 Goal =.. [GoalName|GoalArgs],
1239 % the new predicate declaration
1240 HeadPrefix =.. [GoalName|PredVars],
1241 append_args(HeadPrefix, [[], Acc, Acc, W, W, X, X, Y, Y], Base),
1242 append_args(HeadPrefix, [[In|Ins], Acc1, Acc2, W1, W2, X1, X2, Y1, Y2], RecursionHead),
1243 append_args(Pred, [In, Acc1, Acc3, W1, W3, X1, X3, Y1, Y3], Apply),
1244 append_args(HeadPrefix, [Ins, Acc3, Acc2, W3, W2, X3, X2, Y3, Y2], RecursiveCall),
1245 compile_aux([
1246 Base,
1247 (RecursionHead :- Apply, RecursiveCall)
1248 ], Mod).
1249
1250goal_expansion(mapnodes(Meta, InTerm, OutTerm), Mod:Goal) :-
1251 goal_expansion,
1252 callable(Meta),
1253 current_source_module(Mod,Mod),
1254 aux_preds(Meta, MetaVars, Pred, PredVars, Proto),
1255 aux_preds,
1256 % the new goal
1257 pred_name(mapnodes, 3, Proto, GoalName),
1258 append(MetaVars, [[InTerm], [OutTerm]], GoalArgs),
1259 Goal =.. [GoalName|GoalArgs],
1260 % the new predicate declaration
1261 HeadPrefix =.. [GoalName|PredVars],
1262 append_args(HeadPrefix, [[], []], Base),
1263 append_args(HeadPrefix, [[In|Ins], [Out|Outs]], RecursionHead),
1264 append_args(Pred, [In, Temp], Apply),
1265 append_args(HeadPrefix, [InArgs, OutArgs], SubRecursiveCall),
1266 append_args(HeadPrefix, [Ins, Outs], RecursiveCall),
1267 compile_aux([
1268 Base,
1269 (RecursionHead :-
1270 Apply,
1271 (compound(Temp)
1272 ->
1273 Temp =.. [F|InArgs],
1274 SubRecursiveCall,
1275 Out =.. [F|OutArgs]
1276 ;
1277 Out = Temp
1278 ),
1279 RecursiveCall)
1280 ], Mod).
1281
1282goal_expansion(checknodes(Meta, Term), Mod:Goal) :-
1283 goal_expansion,
1284 callable(Meta),
1285 current_source_module(Mod,Mod),
1286 aux_preds(Meta, MetaVars, Pred, PredVars, Proto),
1287 aux_preds,
1288 % the new goal
1289 pred_name(checknodes, 2, Proto, GoalName),
1290 append(MetaVars, [[Term]], GoalArgs),
1291 Goal =.. [GoalName|GoalArgs],
1292 % the new predicate declaration
1293 HeadPrefix =.. [GoalName|PredVars],
1294 append_args(HeadPrefix, [[]], Base),
1295 append_args(HeadPrefix, [[In|Ins]], RecursionHead),
1296 append_args(Pred, [In], Apply),
1297 append_args(HeadPrefix, [Args], SubRecursiveCall),
1298 append_args(HeadPrefix, [Ins], RecursiveCall),
1299 compile_aux([
1300 Base,
1301 (RecursionHead :-
1302 Apply,
1303 (compound(In)
1304 ->
1305 In =.. [_|Args],SubRecursiveCall
1306 ;
1307 true
1308 ),
1309 RecursiveCall)
1310 ], Mod).
1311
1312goal_expansion(sumnodes(Meta, Term, AccIn, AccOut), Mod:Goal) :-
1313 goal_expansion,
1314 callable(Meta),
1315 current_source_module(Mod,Mod),
1316 aux_preds(Meta, MetaVars, Pred, PredVars, Proto),
1317 aux_preds,
1318 % the new goal
1319 pred_name(sumnodes, 4, Proto, GoalName),
1320 append(MetaVars, [[Term], AccIn, AccOut], GoalArgs),
1321 Goal =.. [GoalName|GoalArgs],
1322 % the new predicate declaration
1323 HeadPrefix =.. [GoalName|PredVars],
1324 append_args(HeadPrefix, [[], Acc, Acc], Base),
1325 append_args(HeadPrefix, [[In|Ins], Acc1, Acc2], RecursionHead),
1326 append_args(Pred, [In, Acc1, Acc3], Apply),
1327 append_args(HeadPrefix, [Args, Acc3, Acc4], SubRecursiveCall),
1328 append_args(HeadPrefix, [Ins, Acc4, Acc2], RecursiveCall),
1329 compile_aux([
1330 Base,
1331 (RecursionHead :-
1332 Apply,
1333 (compound(In)
1334 ->
1335 In =.. [_|Args],SubRecursiveCall
1336 ;
1337 Acc3 = Acc4
1338 ),
1339 RecursiveCall)
1340 ], Mod).
1341
1342/**
1343@}
1344*/
1345
callable( ?_Goal_ )
include(+ F)
use_module( +Files )
call(+ Closure,...,? Ai,...)
arg(+ N,+ T, A)
atomic(T)
compound( T)
functor( T, F, N)
var( T)
format_to_chars(+ Form, + Args, - Result)
read_from_chars( + Chars, - Term)
append(? List1,? List2,? List3)
checklist( 1:Pred, + List)
checknodes(+ Pred, + Term)
convlist(: Pred, + ListIn, ? ListOut)
convlist(: Pred, ? ListIn, ?ExtraList, ? ListOut)
exclude( 2:Goal, + List1, ? List2)
foldl2(: Pred, + List, ? X0, ? X, ? Y0, ? Y)
foldl2(: Pred, + List, ? List1, ? List2, ? X0, ? X, ? Y0, ? Y)
foldl(: Pred, + List1, + List2, ? AccIn, ? AccOut)
foldl(:Goal, +List, +V0, -V, +W0, -WN)
include( 2:Pred, + ListIn, ? ListOut)
maplist( 2:Pred, + List1,+ List2)
maplist(3:Pred,+ List1,+ List2,+ List4)
maplist(: Pred, ? L1, ? L2, ? L3, ? L4)
maplist(: Pred, ? L1, ? L2, ? L3, ? L4, ? L5)
mapnodes(+ Pred, + TermIn, ? TermOut)
partition(1:Pred, + List1, ? Included, ? Excluded)
partition(2:Pred, + List1, ? Lesser, ? Equal, ? Greater)
selectlist(1:Pred, + ListIn, ? ListOut)
selectlist( 2:Pred, + ListIn, + ListInAux, ? ListOut)
selectlist( 2:Pred, + ListIn, + ListInAux, ? ListOut, ? ListOutAux)
sumlist(: Pred, + List, ? AccIn, ? AccOut)
sumnodes(+ Pred, + Term, ? AccIn, ? AccOut)