Commits

Anonymous committed 3f2fac8

Store everything in a Mercurial repository.

Comments (0)

Files changed (63)

+syntax: glob
+TODO
+*.pyc
+Copyright (c) 2010, Giulio Piancastelli. All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+   1. Redistributions of source code must retain the above copyright notice,
+      this list of conditions and the following disclaimer.
+
+   2. Redistributions in binary form must reproduce the above copyright notice,
+      this list of conditions and the following disclaimer in the documentation
+      and/or other materials provided with the distribution.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDER AND CONTRIBUTORS ``AS IS''
+AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
+CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
+OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

examples/99pp/p08.pl

+% P08 (**): Eliminate consecutive duplicates of list elements.
+
+% compress(L1, L2) :- the list L2 is obtained from the list L1 by
+%    compressing repeated occurrences of elements into a single copy
+%    of the element.
+% template: compress(+list, ?list)
+
+compress([], []).
+compress([X], [X]).
+compress([X,X|Xs], Zs) :- compress([X|Xs], Zs).
+compress([X,Y|Ys], [X|Zs]) :- X \= Y, compress([Y|Ys], Zs).
+
+% Example:
+% ?- compress([a,a,a,a,b,c,c,a,a,d,e,e,e,e], X).
+% X = [a,b,c,a,d,e]

examples/99pp/p09.pl

+% P09 (**):  Pack consecutive duplicates of list elements into sublists.
+
+% pack(L1, L2) :- the list L2 is obtained from the list L1 by packing
+%    repeated occurrences of elements into separate sublists.
+% template: pack(+list, ?list)
+
+pack([], []).
+pack([X|Xs], [Z|Zs]) :- transfer(X, Xs, Ys, Z), pack(Ys, Zs).
+
+% transfer(X, Xs, Ys, Z) :- Ys is the list that remains from the list
+%    Xs when all leading copies of X are removed and transferred to Z
+
+transfer(X, [], [], [X]).
+transfer(X, [Y|Ys], [Y|Ys], [X]) :- X \= Y.
+transfer(X, [X|Xs], Ys, [X|Zs]) :- transfer(X, Xs, Ys, Zs).
+
+% Example:
+% ?- pack([a,a,a,a,b,c,c,a,a,d,e,e,e,e], X).
+% X = [[a,a,a,a],[b],[c,c],[a,a],[d],[e,e,e,e]]

examples/99pp/p10.pl

+% P10 (*):  Run-length encoding of a list
+
+% encode(L1, L2) :- the list L2 is obtained from the list L1 by run-length
+%    encoding. Consecutive duplicates of elements are encoded as terms [N, E],
+%    where N is the number of duplicates of the element E.
+% template: encode(+list, ?list)
+
+:- ensure_loaded(p09).
+
+encode(L1, L2) :- pack(L1, L), transform(L, L2).
+
+transform([], []).
+transform([[X|Xs]|Ys], [[N,X]|Zs]) :- length([X|Xs], N), transform(Ys, Zs).
+
+% Example:
+% ?- encode([a,a,a,a,b,c,c,a,a,d,e,e,e,e], X).
+% X = [[4,a],[1,b],[2,c],[2,a],[1,d][4,e]]

examples/99pp/p11.pl

+% P11 (*):  Modified run-length encoding
+
+% encode_modified(L1, L2) :- the list L2 is obtained from the list L1 by 
+%    run-length encoding. Consecutive duplicates of elements are encoded 
+%    as terms [N,E], where N is the number of duplicates of the element E.
+%    However, if N equals 1 then the element is simply copied into the 
+%    output list.
+% template: encode_modified(+list, ?list)
+
+:- ensure_loaded(p10).
+
+encode_modified(L1, L2) :- encode(L1, L), strip(L, L2).
+
+strip([], []).
+strip([[1,X]|Ys], [X|Zs]) :- strip(Ys, Zs).
+strip([[N,X]|Ys], [[N,X]|Zs]) :- N > 1, strip(Ys, Zs).
+
+% Example:
+% ?- encode_modified([a,a,a,a,b,c,c,a,a,d,e,e,e,e], X).
+% X = [[4,a],b,[2,c],[2,a],d,[4,e]]

examples/99pp/p12.pl

+% P12 (**): Decode a run-length compressed list.
+
+% decode(L1, L2) :- L2 is the uncompressed version of the run-length
+%    encoded list L1.
+% template: decode(+list, ?list)
+
+decode([], []).
+decode([X|Ys], [X|Zs]) :- not(list(X)), decode(Ys, Zs).
+decode([[1,X]|Ys], [X|Zs]) :- decode(Ys, Zs).
+decode([[N,X]|Ys], [X|Zs]) :- N > 1, N1 is N - 1, decode([[N1,X]|Ys], Zs).
+
+% Example:
+% ?- decode([[4,a],b,[2,c],[2,a],d,[4,e]], X).
+% X = [a,a,a,a,b,c,c,a,a,d,e,e,e,e]

examples/99pp/p13.pl

+% P13 (**): Run-length encoding of a list (direct solution) 
+
+% encode_direct(L1, L2) :- the list L2 is obtained from the list L1 by 
+%    run-length encoding. Consecutive duplicates of elements are encoded 
+%    as terms [N,E], where N is the number of duplicates of the element E.
+%    However, if N equals 1 then the element is simply copied into the 
+%    output list.
+% template: encode_direct(+list, ?list)
+
+encode_direct([], []).
+encode_direct([X|Xs], [Z|Zs]) :- count(X, Xs, Ys, 1, Z), encode_direct(Ys, Zs).
+
+% count(X,Xs,Ys,K,T) :- Ys is the list that remains from the list Xs
+%    when all leading copies of X are removed. T is the term [N,X],
+%    where N is K plus the number of X's that can be removed from Xs.
+%    In the case of N=1, T is X, instead of the term [1,X].
+
+count(X, [], [], 1, X).
+count(X, [], [], N, [N,X]) :- N > 1.
+count(X, [Y|Ys], [Y|Ys], 1, X) :- X \= Y.
+count(X, [Y|Ys], [Y|Ys], N, [N,X]) :- N > 1, X \= Y.
+count(X, [X|Xs], Ys, K, T) :- K1 is K + 1, count(X, Xs, Ys, K1, T).
+
+% Example:
+% ?- encode_direct([a,a,a,a,b,c,c,a,a,d,e,e,e,e],X).
+% X = [[4,a],b,[2,c],[2,a],d,[4,e]]
+

examples/99pp/p19.pl

+% P19 (**): Rotate a list N places to the left 
+
+% rotate(L1,N,L2) :- the list L2 is obtained from the list L1 by 
+%    rotating the elements of L1 N places to the left.
+%    Examples: 
+%    rotate([a,b,c,d,e,f,g,h],3,[d,e,f,g,h,a,b,c])
+%    rotate([a,b,c,d,e,f,g,h],-2,[g,h,a,b,c,d,e,f])
+%    (list,integer,list) (+,+,?)
+
+:- ensure_loaded(p17).
+
+rotate(L1,N,L2) :- N >= 0, 
+   length(L1,NL1), N1 is N mod NL1, rotate_left(L1,N1,L2).
+rotate(L1,N,L2) :- N < 0,
+   length(L1,NL1), N1 is NL1 + (N mod NL1), rotate_left(L1,N1,L2).
+
+rotate_left(L,0,L).
+rotate_left(L1,N,L2) :- N > 0, split(L1,N,S1,S2), append(S2,S1,L2).
+
+% Based on a wrong definition of mod/2 in SWI-Prolog &c.
+% The answer to the second example is just 'no.'

examples/99pp/p26.pl

+% P26 (**):  Generate the combinations of k distinct objects
+%            chosen from the n elements of a list.
+
+% combination(K, L, C) :- C is a list of K distinct elements 
+%    chosen from the list L
+
+combination(0, _, []).
+combination(K, L, [X|Xs]) :- K > 0,
+    el(X, L, R), K1 is K - 1, combination(K1, R, Xs).
+
+% Find out what the following predicate el/3 exactly does.
+
+el(X, [X|L], L).
+el(X, [_|L], R) :- el(X, L, R).
+
+% Example:
+% ?- combination(3,[a,b,c,d,e,f],L).
+% L = [a,b,c] ;
+% L = [a,b,d] ;
+% L = [a,b,e] ;
+% ...

examples/99pp/p41.pl

+% P41 (*) A list of Goldbach compositions. 
+% Given a range of integers by its lower and upper limit, 
+% print a list of all even numbers and their Goldbach composition.
+
+% :- ensure_loaded(p40).
+% P40 (**) Goldbach's conjecture. 
+% Goldbach's conjecture says that every positive even number greater 
+% than 2 is the sum of two prime numbers. Example: 28 = 5 + 23.
+
+% :- ensure_loaded(p31).
+is_prime(2).
+is_prime(3).
+is_prime(P) :- integer(P), P > 3, P mod 2 =\= 0, \+ has_factor(P,3).  
+
+% has_factor(N,L) :- N has an odd factor F >= L.
+%    (integer, integer) (+,+)
+
+has_factor(N,L) :- N mod L =:= 0.
+has_factor(N,L) :- L * L < N, L2 is L + 2, has_factor(N,L2).
+
+% goldbach(N,L) :- L is the list of the two prime numbers that
+%    sum up to the given N (which must be even).
+%    (integer,integer) (+,-)
+
+goldbach(4,[2,2]) :- !.
+goldbach(N,L) :- N mod 2 =:= 0, N > 4, goldbach(N,L,3).
+
+goldbach(N,[P,Q],P) :- Q is N - P, is_prime(Q), !.
+goldbach(N,L,P) :- P < N, next_prime(P,P1), goldbach(N,L,P1).
+
+next_prime(P,P1) :- P1 is P + 2, is_prime(P1), !.
+next_prime(P,P1) :- P2 is P + 2, next_prime(P2,P1).
+
+% goldbach_list(A,B) :- print a list of the Goldbach composition
+%    of all even numbers N in the range A <= N <= B
+%    (integer,integer) (+,+)
+
+goldbach_list(A,B) :- goldbach_list(A,B,2).
+
+% goldbach_list(A,B,L) :- perform goldbach_list(A,B), but suppress
+% all output when the first prime number is less than the limit L.
+
+goldbach_list(A,B,L) :- A =< 4, !, g_list(4,B,L).
+goldbach_list(A,B,L) :- A1 is ((A+1) // 2) * 2, g_list(A1,B,L).
+
+g_list(A,B,_) :- A > B, !.
+g_list(A,B,L) :- 
+   goldbach(A,[P,Q]),
+   print_goldbach(A,P,Q,L),
+   A2 is A + 2,
+   g_list(A2,B,L).
+
+print_goldbach(A,P,Q,L) :- P >= L, !,
+%   writef('%t = %t + %t',[A,P,Q]), nl.
+    write(A), write(' = '), write(P), write(' + '), write(Q), nl.
+print_goldbach(_,_,_,_).
+

examples/99pp/p46.pl

+% P46 (**) Truth tables for logical expressions.
+% Define predicates and/2, or/2, nand/2, nor/2, xor/2, impl/2 
+% and equ/2 (for logical equivalence) which succeed or
+% fail according to the result of their respective operations; e.g.
+% and(A,B) will succeed, if and only if both A and B succeed.
+% Note that A and B can be Prolog goals (not only the constants
+% true and fail).
+% A logical expression in two variables can then be written in 
+% prefix notation, as in the following example: and(or(A,B),nand(A,B)).
+%
+% Now, write a predicate table/3 which prints the truth table of a
+% given logical expression in two variables.
+%
+% Example:
+% ?- table(A, B, and(A, or(A, B))).
+% true  true  true
+% true  fail  true
+% fail  true  fail
+% fail  fail  fail
+    
+and(A, B) :- A, B.
+
+or(A, _) :- A.
+or(_, B) :- B.
+
+equ(A, B) :- or(and(A, B), and(not(A), not(B))).
+
+xor(A, B) :- not(equ(A, B)).
+
+nor(A, B) :- not(or(A, B)).
+
+nand(A, B) :- not(and(A, B)).
+
+impl(A, B) :- or(not(A), B).
+
+% bind(X) :- instantiate X to be true and false successively
+
+bind(true).
+bind(fail).
+
+table(A, B, Expr) :- bind(A), bind(B), do(A, B, Expr), fail.
+
+do(A, B, _) :- write(A), write('  '), write(B), write('  '), fail.
+do(_, _, Expr) :- Expr, !, write(true), nl.
+do(_, _, _) :- write(fail), nl.
+
+
+
+
+
+
+
+

examples/99pp/p47.pl

+% P47 (*) Truth tables for logical expressions (2).
+% Continue problem P46 by defining and/2, or/2, etc as being
+% operators. This allows to write the logical expression in the
+% more natural way, as in the example: A and (A or not B).
+% Define operator precedence as usual; i.e. as in Java.
+%
+% Example:
+% ?- table(A, B, A and (A or not B)).
+% true  true  true
+% true  fail  true
+% fail  true  fail
+% fail  fail  fail
+    
+:- ensure_loaded(p46).
+
+:- op(900, fy, not).
+:- op(910, yfx, and).
+:- op(910, yfx, nand).
+:- op(920, yfx, or).
+:- op(920, yfx, nor).
+:- op(930, yfx, impl).
+:- op(930, yfx, equ).
+:- op(930, yfx, xor).
+
+% Note that not binds stronger than (and, nand), which bind stronger than
+% (or, nor) which in turn bind stronger than implication, equivalence and xor.

examples/99pp/p48.pl

+% P48 (**) Truth tables for logical expressions (3).
+% Generalize problem P47 in such a way that the logical
+% expression may contain any number of logical variables.
+%
+% Example:
+% ?- table([A,B,C], A and (B or C) equ A and B or A and C).
+% true  true  true  true
+% true  true  fail  true
+% true  fail  true  true
+% true  fail  fail  true
+% fail  true  true  true
+% fail  true  fail  true
+% fail  fail  true  true
+% fail  fail  fail  true
+
+:- ensure_loaded(p47).
+
+% table(List,Expr) :- print the truth table for the expression Expr,
+%   which contains the logical variables enumerated in List.
+
+table(VarList, Expr) :- bindList(VarList), do(VarList, Expr), fail.
+
+bindList([]).
+bindList([V|Vs]) :- bind(V), bindList(Vs).
+
+do(VarList, Expr) :- writeVarList(VarList), writeExpr(Expr), nl.
+
+writeVarList([]).
+writeVarList([V|Vs]) :- write(V), write('  '), writeVarList(Vs).
+
+writeExpr(Expr) :- Expr, !, write(true).
+writeExpr(_) :- write(fail).

examples/99pp/p55.pl

+% P55 (**) Construct completely balanced binary trees for a given 
+% number of nodes.
+
+% cbal_tree(N,T) :- T is a completely balanced binary tree with N nodes.
+% (integer, tree)  (+,?)
+
+cbal_tree(0, nil) :- !.
+cbal_tree(N, t(x,L,R)) :- N > 0,
+    N0 is N - 1, 
+    N1 is N0 // 2, N2 is N0 - N1,
+    distrib(N1, N2, NL, NR),
+    cbal_tree(NL, L), cbal_tree(NR, R).
+
+distrib(N, N, N, N) :- !.
+distrib(N1, N2, N1, N2).
+distrib(N1, N2, N2, N1).

examples/99pp/p57.pl

+% P57 (**) Binary search trees (dictionaries)
+
+% Use the predicate add/3, developed in chapter 4 of the course,
+% to write a predicate to construct a binary search tree 
+% from a list of integer numbers. Then use this predicate to test 
+% the solution of the problem P56
+
+% :- ensure_loaded(p56).
+symmetric(nil).
+symmetric(t(_,L,R)) :- '$mirror'(L, R).
+'$mirror'(nil, nil).
+'$mirror'(t(_,L1,R1), t(_,L2,R2)) :- '$mirror'(L1, R2), '$mirror'(R1, L2).
+
+% add(X, T1, T2) :- the binary dictionary T2 is obtained by 
+% adding the item X to the binary dictionary T1
+% (element,binary-dictionary,binary-dictionary) (i,i,o)
+
+add(X, nil, t(X,nil,nil)).
+add(X, t(Root,L,R), t(Root,L1,R)) :- X @< Root, add(X, L, L1).
+add(X, t(Root,L,R), t(Root,L,R1)) :- X @> Root, add(X, R, R1).
+
+construct(L, T) :- construct(L, T, nil).
+
+construct([], T, T).
+construct([N|Ns], T, T0) :- add(N, T0, T1), construct(Ns, T, T1).
+ 	
+test_symmetric(L) :- construct(L, T), symmetric(T).
+
+% Examples:
+% ?- test_symmetric([5,3,18,1,4,12,21]).
+% yes
+% ?- test_symmetric([3,2,5,7,4]).
+% no

examples/99pp/p59.pl

+% P59 (**) Construct height-balanced binary trees
+% In a height-balanced binary tree, the following property holds for
+% every node: The height of its left subtree and the height of  
+% its right subtree are almost equal, which means their
+% difference is not greater than one.
+% Write a predicate hbal_tree/2 to construct height-balanced
+% binary trees for a given height. The predicate should
+% generate all solutions via backtracking. Put the letter 'x'
+% as information into all nodes of the tree.
+
+% hbal_tree(D, T) :- T is a height-balanced binary tree with depth T
+
+hbal_tree(0, nil) :- !.
+hbal_tree(1, t(x,nil,nil)) :- !.
+hbal_tree(D, t(x,L,R)) :- D > 1,
+    D1 is D - 1, D2 is D - 2,
+    distr(D1, D2, DL, DR),
+    hbal_tree(DL, L), hbal_tree(DR, R).
+
+distr(D1, _, D1, D1).
+distr(D1, D2, D1, D2).
+distr(D1, D2, D2, D1).

examples/99pp/p63.pl

+% P63 (**) Construct a complete binary tree
+%
+% A complete binary tree with height H is defined as follows: 
+% The levels 1,2,3,...,H-1 contain the maximum number of nodes 
+% (i.e 2**(i-1) at the level i, note that we start counting the 
+% levels from 1 at the root). In level H, which may contain less 
+% than the maximum number possible of nodes, all the nodes are 
+% "left-adjusted". This means that in a levelorder tree traversal 
+% all internal nodes come first, the leaves come second, and
+% empty successors (the nils which are not really nodes!) 
+% come last. Complete binary trees are used for heaps.
+
+% :- ensure_loaded(p57).
+
+% complete_binary_tree(N, T) :- T is a complete binary tree with
+% N nodes. (+,?)
+
+complete_binary_tree(N, T) :- complete_binary_tree(N, T, 1).
+
+complete_binary_tree(N, nil, A) :- A > N, !.
+complete_binary_tree(N, t(_,L,R), A) :- A =< N,
+    AL is 2 * A, AR is AL + 1,
+    complete_binary_tree(N, L, AL),
+    complete_binary_tree(N, R, AR).

examples/99pp/p64.pl

+% P64 (**) Layout a binary tree (1)
+%
+% Given a binary tree as the usual Prolog term t(X,L,R) (or nil).
+% As a preparation for drawing the tree, a layout algorithm is
+% required to determine the position of each node in a rectangular
+% grid. Several layout methods are conceivable, one of them is
+% the following:
+%
+% The position of a node v is obtained by the following two rules:
+%   x(v) is equal to the position of the node v in the inorder sequence
+%   y(v) is equal to the depth of the node v in the tree
+%
+% In order to store the position of the nodes, we extend the Prolog 
+% term representing a node (and its successors) as follows:
+%    nil represents the empty tree (as usual)
+%    t(W,X,Y,L,R) represents a (non-empty) binary tree with root
+%        W positionned at (X,Y), and subtrees L and R
+%
+% Write a predicate layout_binary_tree/2:
+
+% layout_binary_tree(T,PT) :- PT is the "positionned" binary
+%    tree obtained from the binary tree T. (+,?) or (?,+)
+
+:- ensure_loaded(p57). % for test
+
+layout_binary_tree(T, PT) :- layout_binary_tree(T, PT, 1, _, 1).
+
+% layout_binary_tree(T,PT,In,Out,D) :- T and PT as in layout_binary_tree/2;
+%    In is the position in the inorder sequence where the tree T (or PT)
+%    begins, Out is the position after the last node of T (or PT) in the 
+%    inorder sequence. D is the depth of the root of T (or PT). 
+%    (+,?,+,?,+) or (?,+,+,?,+)
+ 
+layout_binary_tree(nil, nil, I, I, _).
+layout_binary_tree(t(W,L,R), t(W,X,Y,PL,PR), Iin, Iout, Y) :- 
+    Y1 is Y + 1,
+    layout_binary_tree(L, PL, Iin, X, Y1), 
+    X1 is X + 1,
+    layout_binary_tree(R, PR, X1, Iout, Y1).
+
+% Test (see example given in the problem description):
+% ?-  construct([n,k,m,c,a,h,g,e,u,p,s,q], T), layout_binary_tree(T, PT).
+% or use layout_binary_tree with
+% t(n,t(k,t(c,t(a,nil,nil),t(h,t(g,t(e,nil,nil),nil),nil)),t(m,nil,nil)),t(u,t(p,nil,t(s,t(q,nil,nil),nil)),nil))

examples/99pp/p68a.pl

+% P68 (**) Preorder and inorder sequences of binary trees
+
+% We consider binary trees with nodes that are identified by
+% single lower-case letters.
+
+% a1) Given a binary tree, construct its preorder sequence
+
+preorder(T, S) :- '$preorder'(T, L), atom_chars(S, L).
+
+'$preorder'(nil, []).
+'$preorder'(t(X,Left,Right), [X|List]) :-
+    '$preorder'(Left, ListLeft),
+    '$preorder'(Right, ListRight),
+    append(ListLeft, ListRight, List).
+
+% a2) Given a binary tree, construct its preorder sequence
+
+inorder(T, S) :- '$inorder'(T, L), atom_chars(S, L).
+
+'$inorder'(nil, []).
+'$inorder'(t(X,Left,Right), List) :-
+    '$inorder'(Left, ListLeft),
+    '$inorder'(Right, ListRight),
+    append(ListLeft, [X|ListRight], List).

examples/99pp/p68b.pl

+% P68b (**) Preorder and inorder sequences of binary trees
+
+% b) Make preorder/2 and inorder/2 reversible.
+
+% Similar to the solution p68a.pl. However, for the flow pattern (-,+) 
+% we have to modify the order of the subgoals in the second clauses 
+% of preorder_l/2 and inorder_l/2
+
+% preorder(T,S) :- S is the preorder tre traversal sequence of the
+%    nodes of the binary tree T. (tree,atom) (+,?) or (?,+)
+
+preorder(T, S) :- nonvar(T), !, preorder_tl(T, L), atom_chars(S, L).
+preorder(T, S) :- atom(S), atom_chars(S, L), preorder_lt(T, L).
+
+preorder_tl(nil, []).
+preorder_tl(t(X,Left,Right), [X|List]) :-
+    preorder_tl(Left, ListLeft),
+    preorder_tl(Right, ListRight),
+    append(ListLeft, ListRight, List).
+
+preorder_lt(nil, []).
+preorder_lt(t(X,Left,Right), [X|List]) :-
+    append(ListLeft, ListRight, List),
+    preorder_lt(Left, ListLeft),
+    preorder_lt(Right, ListRight).
+
+% inorder(T,S) :- S is the inorder tre traversal sequence of the
+%    nodes of the binary tree T. (tree,atom) (+,?) or (?,+)
+
+inorder(T, S) :- nonvar(T), !, inorder_tl(T, L), atom_chars(S, L).
+inorder(T, S) :- atom(S), atom_chars(S, L), inorder_lt(T, L).
+
+inorder_tl(nil, []).
+inorder_tl(t(X,Left,Right), List) :-
+    inorder_tl(Left, ListLeft),
+    inorder_tl(Right, ListRight),
+    append(ListLeft, [X|ListRight], List).
+
+inorder_lt(nil, []).
+inorder_lt(t(X,Left,Right), List) :-
+    append(ListLeft, [X|ListRight], List),
+    inorder_lt(Left, ListLeft),
+    inorder_lt(Right, ListRight).

examples/99pp/p68d.pl

+% P68d (**) Preorder and inorder sequences of binary trees
+
+% Work with difference lists
+
+% pre_in_tree_d(P,I,T) :- T is the binary tree that has the preorder
+%   sequence P and inorder sequence I.
+%   (atom,atom,tree) (+,+,?)
+
+pre_in_tree_d(P, I, T) :-  
+   atom_chars(P, PL), atom_chars(I, IL), pre_in_tree_dl(PL-[], IL-[], T).
+
+pre_in_tree_dl(P-P, I-I, nil).
+pre_in_tree_dl(P1-P4, I1-I4, t(X,Left,Right)) :-
+    symbol(X, P1-P2), symbol(X, I2-I3),
+    pre_in_tree_dl(P2-P3, I1-I2, Left),
+    pre_in_tree_dl(P3-P4, I3-I4, Right).
+
+symbol(X, [X|Xs]-Xs).
+
+% Isn't it cool? But the best of it is the performance!
+
+% With the generate-and-test solution (p68c):
+% ?- time(pre_in_tree(abdecfg,dbeacgf,_)).
+% 9,048 inferences in 0.01 seconds (904800 Lips)  
+
+% With the "pushed" generate-and-test solution (p68c):
+% ?- time(pre_in_tree_push(abdecfg,dbeacgf,_)).
+% 67 inferences in 0.00 seconds (Infinite Lips)
+  
+% With the difference list solution (p68d):
+% ?- time(pre_in_tree_d(abdecfg,dbeacgf,_)).
+% 32 inferences in 0.00 seconds (Infinite Lips)                     
+
+% Note that the predicate pre_in_tree_dl/3 runs in almost any
+% flow pattern. Try it out!
+

examples/benchmark/crypt.pl

+% Test with: crypt(Result).
+%
+% crypt
+%
+% Cryptomultiplication:
+% Find the unique answer to:
+%   OEE
+%    EE
+%   ---
+%      EOEE
+%      EOE
+%      ----
+%      OOEE
+%
+% where E=even, O=odd.
+% This program generalizes easily
+% to any such problem.
+% Written by Peter Van Roy
+
+%:- ensure_loaded(harness).
+
+crypt([A, B, C, D, E, F, G, H, I, J, K, L, M, N, O, P]) :-
+    odd(A), even(B), even(C), even(E),
+    mult([C, B, A], E, [I, H, G, F | X]),
+    lefteven(F), odd(G), even(H), even(I), zero(X), lefteven(D),
+    mult([C, B, A], D, [L, K, J | Y]),
+    lefteven(J), odd(K), even(L), zero(Y),
+    sum2([I, H, G, F], [0, L, K, J], [P, O, N, M | Z]),
+    odd(M), odd(N), even(O), even(P), zero(Z).
+
+% In the usual source this predicate is named sum. However, sum is a
+% language construct in NU-Prolog, and cannot be defined as a predicate.
+% If you try, nc comes up with an obscure error message.
+
+sum2(AL, BL, CL) :-
+    sum2(AL, BL, 0, CL).
+
+sum2([A | AL], [B | BL], Carry, [C | CL]) :- !,
+    X is (A + B + Carry),
+    C is X mod 10,
+    NewCarry is X // 10,
+    sum2(AL, BL, NewCarry, CL).
+sum2([], BL, 0, BL) :- !.
+sum2(AL, [], 0, AL) :- !.
+sum2([], [B | BL], Carry, [C | CL]) :- !,
+    X is B + Carry,
+    NewCarry is X // 10,
+    C is X mod 10,
+    sum2([], BL, NewCarry, CL).
+sum2([A | AL], [], Carry, [C | CL]) :- !,
+    X is A + Carry,
+    NewCarry is X // 10,
+    C is X mod 10,
+    sum2([], AL, NewCarry, CL).
+sum2([], [], Carry, [Carry]).
+
+mult(AL, D, BL) :- mult(AL, D, 0, BL).
+
+mult([], _, Carry, [C, Cend]) :-
+    C is Carry mod 10,
+    Cend is Carry // 10.
+mult([A | AL], D, Carry, [B | BL] ) :-
+    X is A * D + Carry,
+    B is X mod 10,
+    NewCarry is X // 10,
+    mult(AL, D, NewCarry, BL).
+
+zero([]).
+zero([0 | L]) :- zero(L).
+
+odd(1).
+odd(3).
+odd(5).
+odd(7).
+odd(9).
+
+even(0).
+even(2).
+even(4).
+even(6).
+even(8).
+
+lefteven(2).
+lefteven(4).
+lefteven(6).
+lefteven(8).
+

examples/benchmark/deriv.pl

+% Test with: deriv(R).
+
+deriv(quad(E1, E2, E3, E4)) :-
+    ops8(E1), divide10(E2), log10(E3), times10(E4).
+
+ops8(E) :-
+    d((x + 1) * (('^'(x, 2) + 2) * ('^'(x, 3) + 3)), x, E).
+
+divide10(E) :-
+    d(((((((((x / x) / x) / x) / x) / x) / x) / x) / x) / x, x, E).
+
+log10(E) :-
+    d(log(log(log(log(log(log(log(log(log(log(x)))))))))), x, E).
+
+times10(E) :-
+    d(((((((((x * x) * x) * x) * x) * x) * x) * x) * x) * x, x, E).
+
+d(U + V, X, DU + DV) :-
+    !,
+    d(U, X, DU),
+    d(V, X, DV).
+d(U - V, X, DU - DV) :-
+    !,
+    d(U, X, DU),
+    d(V, X, DV).
+d(U * V, X, DU * V + U * DV) :-
+    !,
+    d(U, X, DU),
+    d(V, X, DV).
+d(U / V, X, (DU * V - U * DV) / '^'(V, 2)) :-
+    !,
+    d(U, X, DU),
+    d(V, X, DV).
+d('^'(U, N), X, DU * N * '^'(U, N1)) :-
+    !,
+    N1 is N - 1,
+    d(U, X, DU).
+d(-U, X, -DU) :-
+    !,
+    d(U, X, DU).
+d(exp(U), X, exp(U) * DU) :-
+    !,
+    d(U, X, DU).
+d(log(U), X, DU / U) :-
+    !,
+    d(U, X, DU).
+d(X, X, 1) :-
+    !.
+d(_, _, 0).

examples/benchmark/nrev_append.pl

+% Test with: nrev([1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30], R).
+
+nrev([],[]).
+nrev([X|Rest],Ans) :- nrev(Rest,L), append(L,[X],Ans).
+
+append([],L2,L2).
+append([E|T1],L2,[E|T2]) :- append(T1,L2,T2).

examples/benchmark/poly.pl

+% Test with: data(D), poly_exp(10, D, Result).
+%
+%   poly_10
+%
+%   Ralph Haygood (based on Prolog version by Rick McGeer
+%                  based on Lisp version by R. P. Gabriel)
+%
+%   raise a polynomial (1+x+y+z) to the 10th power (symbolically)
+
+data(Data) :-
+    test_poly(Data).
+
+benchmark(Data, Out) :-
+    poly_exp(10, Data, Out).
+
+test_poly(P) :-
+    poly_add(poly(x, [term(0,1), term(1,1)]), poly(y, [term(1, 1)]), Q),
+    poly_add(poly(z, [term(1,1)]), Q, P).
+
+poly_add(poly(Var,Terms1), poly(Var,Terms2), poly(Var,Terms)) :- !,
+    term_add(Terms1, Terms2, Terms).
+poly_add(poly(Var1,Terms1), poly(Var2,Terms2), poly(Var1,Terms)) :-
+    Var1 @< Var2, !,
+    add_to_order_zero_term(Terms1, poly(Var2,Terms2), Terms).
+poly_add(Poly, poly(Var,Terms2), poly(Var,Terms)) :- !,
+    add_to_order_zero_term(Terms2, Poly, Terms).
+poly_add(poly(Var,Terms1), C, poly(Var,Terms)) :- !,
+    add_to_order_zero_term(Terms1, C, Terms).
+poly_add(C1, C2, C) :-
+    C is C1 + C2.
+
+term_add([], X, X) :- !.
+term_add(X, [], X) :- !.
+term_add([term(E,C1)|Terms1], [term(E,C2)|Terms2], [term(E,C)|Terms]) :- !,
+    poly_add(C1, C2, C),
+    term_add(Terms1, Terms2, Terms).
+term_add([term(E1,C1)|Terms1], [term(E2,C2)|Terms2], [term(E1,C1)|Terms]) :-
+    E1 < E2, !,
+    term_add(Terms1, [term(E2,C2)|Terms2], Terms).
+term_add(Terms1, [term(E2,C2)|Terms2], [term(E2,C2)|Terms]) :-
+    term_add(Terms1, Terms2, Terms).
+
+add_to_order_zero_term([term(0,C1)|Terms], C2, [term(0,C)|Terms]) :- !,
+    poly_add(C1, C2, C).
+add_to_order_zero_term(Terms, C, [term(0,C)|Terms]).
+
+poly_exp(0, _, 1) :- !.
+poly_exp(N, Poly, Result) :-
+    N/\1 =:= 0, !,
+    M is N>>1,
+    poly_exp(M, Poly, Part),
+    poly_mul(Part, Part, Result).
+poly_exp(N, Poly, Result) :-
+    M is N - 1,
+    poly_exp(M, Poly, Part),
+    poly_mul(Poly, Part, Result).
+
+poly_mul(poly(Var,Terms1), poly(Var,Terms2), poly(Var,Terms)) :- !,
+    term_mul(Terms1, Terms2, Terms).
+poly_mul(poly(Var1,Terms1), poly(Var2,Terms2), poly(Var1,Terms)) :-
+    Var1 @< Var2, !,
+    mul_through(Terms1, poly(Var2,Terms2), Terms).
+poly_mul(P, poly(Var,Terms2), poly(Var,Terms)) :- !,
+    mul_through(Terms2, P, Terms).
+poly_mul(poly(Var,Terms1), C, poly(Var,Terms)) :- !,
+    mul_through(Terms1, C, Terms).
+poly_mul(C1, C2, C) :-
+    C is C1 * C2.
+
+term_mul([], _, []) :- !.
+term_mul(_, [], []) :- !.
+term_mul([Term|Terms1], Terms2, Terms) :-
+    single_term_mul(Terms2, Term, PartA),
+    term_mul(Terms1, Terms2, PartB),
+    term_add(PartA, PartB, Terms).
+
+single_term_mul([], _, []).
+single_term_mul([term(E1,C1)|Terms1], term(E2,C2),
+        [term(E,C)|Terms]) :-
+    E is E1 + E2,
+    poly_mul(C1, C2, C),
+    single_term_mul(Terms1, term(E2,C2), Terms).
+
+mul_through([], _, []).
+mul_through([term(E,Term)|Terms], Poly, [term(E,NewTerm)|NewTerms]) :-
+    poly_mul(Term, Poly, NewTerm),
+    mul_through(Terms, Poly, NewTerms).
+

examples/benchmark/primes.pl

+% Test with: data(D), primes(D, Result).
+
+data(98).
+
+primes(Limit, Ps) :-
+    integers(2, Limit, Is),
+    sift(Is, Ps).
+
+integers(Low, High, [Low | Rest]) :- 
+    Low =< High, !,
+    M is Low + 1,
+    integers(M, High, Rest).
+integers(_,_,[]).
+
+sift([], []).
+sift([I | Is], [I | Ps]) :-
+    remove(I, Is, New),
+    sift(New, Ps).
+
+remove(_P,[],[]).
+remove(P,[I | Is], Nis0) :-
+    I mod P =\= 0, !,
+    Nis0 = [I | Nis],
+    remove(P,Is,Nis).
+remove(P,[_I | Is], Nis) :-
+    remove(P,Is,Nis).

examples/benchmark/qsort.pl

+% Test with: qsort([27,74,17,33,94,18,46,83,65,2,32,53,28,85,99,47,28,82,6,11,55,29,39,81,90,37,10,0,66,51,7,21,85,27,31,63,75,4,95,99,11,28,61,74,18,92,40,53,59,8],R,[]).
+
+qsort([], R, R).
+qsort([X|L], R, R0) :-
+    partition(L, X, L1, L2),
+    qsort(L2, R1, R0),
+    qsort(L1, R, [X|R1]).
+
+partition([],_,[],[]).
+partition([X|L],Y,[X|L1],L2) :-
+    X =< Y, !,
+    partition(L,Y,L1,L2).
+partition([X|L],Y,L1,[X|L2]) :-
+    partition(L,Y,L1,L2).

examples/benchmark/queens.pl

+% Test with: data(NQueens), queen(NQueens, Result).
+%
+% 9-queens program
+
+data([1,2,3,4,5,6,7,8,9]).
+
+% #if   defined(CONSTRAINT_PROPAGATION)
+
+queen(Data, Out) :-
+    queen_2(Data, [], Out).
+
+queen_2([], _, []).
+queen_2([H|T], History, [Q|M]) :-
+    qdelete(Q, H, T, L1),
+    nodiag(History, Q, 1),
+    queen_2(L1, [Q|History], M).
+
+% #elif defined(COROUTINING)
+% 
+% queen(Data, Out) :-
+%   safe(Out),
+%   qperm(Data, Out).
+% 
+% #else
+% 
+% queen(Data, Out) :-
+%   qperm(Data, Out),
+%   safe(Out).
+% 
+% #endif
+
+qperm([], []).
+qperm([X|Y], [U|V]) :-
+    qdelete(U, X, Y, Z),
+    qperm(Z, V).
+
+qdelete(A, A, L, L).
+qdelete(X, A, [H|T], [A|R]) :-
+    qdelete(X, H, T, R).
+
+safe([]).
+safe([N|L]) :-
+    nodiag(L, N, 1),
+    safe(L).
+
+nodiag([], _, _).
+nodiag([N|L], B, D) :-
+    D =\= N - B,
+    D =\= B - N,
+    D1 is D + 1,
+    nodiag(L, B, D1).

examples/benchmark/query.pl

+% Test with: query(Result).
+
+query(quad(C1, D1, C2, D2)) :- 
+    density(C1, D1), 
+    density(C2, D2),
+    D1 > D2,
+    T1 is 20 * D1,
+    T2 is 21 * D2,
+    T1 < T2.
+
+density(C, D) :- 
+    pop(C, P),
+    area(C, A),
+    D is P * 100 // A.
+
+% populations in 100000s
+pop('china',        8250).
+pop('india',        5863).
+pop('ussr',     2521).
+pop('usa',      2119).
+pop('indonesia',    1276).
+pop('japan',        1097).
+pop('brazil',       1042).
+pop('bangladesh',    750).
+pop('pakistan',      682).
+pop('w_germany',     620).
+pop('nigeria',       613).
+pop('mexico',        581).
+pop('uk',        559).
+pop('italy',         554).
+pop('france',        525).
+pop('philippines',   415).
+pop('thailand',      410).
+pop('turkey',        383).
+pop('egypt',         364).
+pop('spain',         352).
+pop('poland',        337).
+pop('s_korea',       335).
+pop('iran',      320).
+pop('ethiopia',      272).
+pop('argentina',     251).
+
+% areas in 1000s of square miles
+area('china',       3380).
+area('india',       1139).
+area('ussr',        8708).
+area('usa',     3609).
+area('indonesia',    570).
+area('japan',        148).
+area('brazil',      3288).
+area('bangladesh',    55).
+area('pakistan',     311).
+area('w_germany',     96).
+area('nigeria',      373).
+area('mexico',       764).
+area('uk',        86).
+area('italy',        116).
+area('france',       213).
+area('philippines',   90).
+area('thailand',     200).
+area('turkey',       296).
+area('egypt',        386).
+area('spain',        190).
+area('poland',       121).
+area('s_korea',       37).
+area('iran',         628).
+area('ethiopia',     350).
+area('argentina',   1080).

examples/benchmark/tak.pl

+% Test with: data(D), tak(D, Result).
+
+data(triple(18, 12, 6)).
+
+tak(triple(X, Y, Z), Out) :-
+    tak(X, Y, Z, Out).
+
+tak(X,Y,Z,A) :-
+    X =< Y, !,
+    Z = A.
+tak(X,Y,Z,A) :-
+    % X > Y,
+    X1 is X - 1,
+    tak(X1,Y,Z,A1),
+    Y1 is Y - 1,
+    tak(Y1,Z,X,A2),
+    Z1 is Z - 1,
+    tak(Z1,X,Y,A3),
+    tak(A1,A2,A3,A).
+

examples/family.pl

+% The family program
+% From figure 1.8 in
+%     Ivan Bratko
+%     "Prolog Programming for Artificial Intelligence", 3rd edition
+%     Addison-Wesley, 2001
+
+parent(pam, bob).  % Pam is a parent of Bob
+parent(tom, bob).
+parent(tom, liz).
+parent(bob, ann).
+parent(bob, pat).
+parent(pat, jim).
+
+female(pam).  % Pam is female
+male(tom).  % Tom is male
+male(bob).
+female(liz).
+female(ann).
+female(pat).
+male(jim).
+
+% Y is an offspring of X if X is a parent of Y
+offspring(Y, X) :- parent(X, Y).
+
+mother(X, Y) :-      % X is the mother of Y if...
+    parent(X, Y),    % ...X is a parent of Y and...
+    female(X).       % ...X is female
+
+grandparent(X, Z) :-    % X is a grandparent of Z if...
+    parent(X, Y),       % ...X is a parent of Y and...
+    parent(Y, Z).       % ...Y is a parent of Z
+
+sister(X, Y) :-
+    parent(Z, X), parent(Z, Y),
+    female(X),
+    different(X, Y).
+
+% The predecessor/2 predicate
+predecessor(X, Z) :- parent(X, Z).
+predecessor(X, Z) :-
+    parent(X, Y),
+    predecessor(Y, Z).
+
+% Dummy different/2 predicate
+different(X, Y) :- X \== Y.
+member(E, [E|_]).
+member(E, [_|L]) :- member(E, L).
+
+append([], L2, L2).
+append([E|T1], L2, [E|T2]) :- append(T1, L2, T2).
+
+reverse(L1, L2) :- reverse(L1, [], L2).
+reverse([], Acc, Acc).
+reverse([H|T], Acc, Y) :- reverse(T, [H|Acc], Y).
+
+delete(E, [], []).
+delete(E, [E|T], L) :- !, delete(E, T, L).
+delete(E, [H|T], [H|L]) :- delete(E, T, L).
+
+% Find the last element of a list.
+last([X], X).
+last([_|L], X) :- last(L, X).
+
+% Find the last but one element of a list.
+last_but_one([X,_], X).
+last_but_one([_,Y|Ys], X) :- last_but_one([Y|Ys], X).
+
+% nth(+index, ?element, ?list)
+% Find the Nth element of a list (starting by 1). This is very
+% limited w.r.t. the standard nth/3, where index is specified
+% as ? rather than +. So, in particular, here the generative
+% queries (e.g. nth(N, [1,2,3], E) & nth(N, T, E)) do not work.
+nth(1, [X|_], X).
+nth(N, [_|L], X) :- N > 1, N1 is N - 1, nth(N1, L, X).
+
+length(L, S) :- number(S), !, '$lengthN'(L, S), !.
+length(L, S) :- var(S), '$lengthX'(L, S).
+'$lengthN'([], 0).
+'$lengthN'(_, N) :- N < 0, !, fail.
+'$lengthN'([_|L], N) :- '$lengthN'(L, M), N is M + 1.
+'$lengthX'([], 0).
+'$lengthX'([_|L], N) :- '$lengthX'(L, M), N is M + 1.
+
+palindrome(L) :- reverse(L, L).
+
+list(X) :- var(X), !, fail.
+list([]).
+list([_|T]) :- list(T).
+
+% flatten(+list, ?list)
+% Flatten a nested list structure. (I am told that the template
+% for the "standard" flatten/2 is flatten(+list, -list).)
+flatten(X, [X]) :- not(list(X)).
+flatten([], []).
+flatten([X|Xs], Zs) :- flatten(X, Y), flatten(Xs, Ys), append(Y, Ys, Zs).
+
+% duplicate(?list, ?list)
+% Duplicate all elements in a list.
+duplicate([], []).
+duplicate([X|Xs], [X,X|Ys]) :- duplicate(Xs, Ys).
+
+% duplicate(?list, +integer, ?list)
+% Duplicate the elements of a list a given number of times.
+duplicate(L1, N, L2) :- '$duplicate'(L1, N, L2, N).
+'$duplicate'([], _, [], _).
+'$duplicate'([_|Xs], N, Ys, 0) :- '$duplicate'(Xs, N, Ys, N).
+'$duplicate'([X|Xs], N, [X|Ys], K) :- K > 0, K1 is K - 1, '$duplicate'([X|Xs], N, Ys, K1).
+
+% drop(?list, +integer, ?list)
+% Drop every Nth element from a list.
+drop(L1, N, L2) :- '$drop'(L1, N, L2, N).
+'$drop'([], _, [], _).
+'$drop'([_|Xs], N, Ys, 1) :- '$drop'(Xs, N, Ys, N).
+'$drop'([X|Xs], N, [X|Ys], K) :- K > 1, K1 is K - 1, '$drop'(Xs, N, Ys, K1).
+
+% split(?list, +integer, ?list, ?list)
+% Split a list into two parts.
+split(L, 0, [], L).
+split([X|Xs], N, [X|Ys], Zs) :- N > 0, N1 is N - 1, split(Xs, N1, Ys, Zs).
+
+% slice(?list, +integer, +integer, ?list)
+% Extract a slice from a list (boundaries included), where indexes start from 1.
+slice([X|_], 1, 1, [X]).
+slice([X|Xs], 1, K, [X|Ys]) :- K > 1, K1 is K - 1, slice(Xs, 1, K1, Ys).
+slice([_|Xs], I, K, Ys) :- I > 1, I1 is I - 1, K1 is K - 1, slice(Xs, I1, K1, Ys).
+
+% remove(?list, +integer, ?element, ?list)
+% Remove the Nth element from a list, starting from 1.
+remove([X|Xs], 1, X, Xs).
+remove([Y|Xs], K, X, [Y|Ys]) :- K > 1, K1 is K - 1, remove(Xs, K1, X, Ys).
+
+% insert(?list, +integer, ?element, ?list)
+% Insert an element at a given position into a list, starting from 1.
+insert(L, K, X, R) :- remove(R, K, X, L).
+
+% range(+integer, +integer, ?list)
+% Create a list containing all integers within a given range.
+range(I, I, [I]).
+range(I, K, [I|L]) :- I < K, I1 is I + 1, range(I1, K, L).
+
+
+% prime(+integer)
+% Determine whether a given integer number is prime. 
+prime(2).
+prime(3).
+prime(P) :- integer(P), P > 3, P mod 2 =\= 0, not('$has_odd_factor'(P,3)).
+'$has_odd_factor'(N, L) :- N mod L =:= 0.
+'$has_odd_factor'(N, L) :- L * L < N, L2 is L + 2, '$has_odd_factor'(N, L2).
+
+% gcd(+integer, +integer, ?integer)
+% Determine the greatest common divisor of two positive integers.
+gcd(X, 0, X) :- X > 0.
+gcd(X, Y, G) :- Y > 0, Z is X mod Y, gcd(Y, Z, G).
+
+% coprime(+integer, +integer)
+% Determine whether two positive integer numbers are coprime. 
+% Two numbers are coprime if their GCD equals 1.
+coprime(X, Y) :- gcd(X, Y, 1).
+
+% prime_factors(+integer, ?list)
+% Determine the prime factors of a given positive integer. 
+prime_factors(N, L) :- N > 0, '$prime_factors'(N, L, 2).
+'$prime_factors'(1, [], _) :- !.
+'$prime_factors'(N, [F|L], F) :- % N is multiple of F
+    R is N // F, N =:= R * F, !, '$prime_factors'(R, L, F).
+'$prime_factors'(N, L, F) :- % N is not multiple of F
+    '$next_factor'(N, F, NF), '$prime_factors'(N, L, NF).
+'$next_factor'(_, 2, 3) :- !.
+'$next_factor'(N, F, NF) :- F * F < N, !, NF is F + 2.
+'$next_factor'(N, _, N). % F > sqrt(N)
+
+% prime_factors_with_multiplicity(+integer, ?list)
+% Determine the prime factors of a given positive integer, producing 
+% a list containing the prime factors and their multiplicity.
+prime_factors_with_multiplicity(N, L) :- N > 0, '$prime_factors_with_multiplicity'(N, L, 2).
+'$prime_factors_with_multiplicity'(1, [], _) :- !.
+'$prime_factors_with_multiplicity'(N, [[F,M]|L], F) :- '$divide'(N, F, M, R), !, % F divides N
+    '$next_factor'(R, F, NF), '$prime_factors_with_multiplicity'(R, L, NF).
+'$prime_factors_with_multiplicity'(N, L, F) :- !, % F does not divide N
+    '$next_factor'(N, F, NF), '$prime_factors_with_multiplicity'(N, L, NF).
+'$divide'(N, F, M, R) :- '$divide'(N, F, M, R, 0), M > 0.
+'$divide'(N, F, M, R, K) :- S is N // F, N =:= S * F, !, % F divides N
+    K1 is K + 1, '$divide'(S, F, M, R, K1).
+'$divide'(N, _, M, N, M).
+
+% phi(+integer, -integer)
+% Calculate Euler's totient function phi(m), defined as the number
+% of positive integers r (1 <= r < m) that are coprime to m. %'
+phi(N, Phi) :- prime_factors_with_multiplicity(N, L), '$phi'(L, Phi).
+'$phi'([], 1).
+'$phi'([[F,1]|L], Phi) :- !, '$phi'(L, Phi1), Phi is Phi1 * (F - 1).
+'$phi'([[F,M]|L], Phi) :- M > 1, M1 is M - 1, '$phi'([[F,M1]|L], Phi1), Phi is Phi1 * F.
+
+% primes(+integer, +interger, ?list)
+% Given a range of integers by its lower and upper limit,
+% constructs a list of all prime numbers in that range.
+primes(A, B, L) :- A =< 2, !, '$primes'(2, B, L).
+primes(A, B, L) :- A1 is (A // 2) * 2 + 1, '$primes'(A1, B, L).
+'$primes'(A, B, []) :- A > B, !.
+'$primes'(A, B, [A|L]) :- prime(A), !, '$next'(A, A1), '$primes'(A1, B, L). 
+'$primes'(A, B, L) :- '$next'(A, A1), '$primes'(A1, B, L).
+'$next'(2, 3) :- !.
+'$next'(A, A1) :- A1 is A + 2.
+
+% gray(N,C)
+% C is the N-bit Gray code
+gray(1, ['0','1']).
+gray(N, C) :- N > 1, N1 is N-1,
+    gray(N1, C1), reverse(C1, C2),
+    '$prepend'('0', C1, C1P),
+    '$prepend'('1', C2, C2P),
+    append(C1P, C2P, C).
+'$prepend'(_, [], []) :- !.
+'$prepend'(X, [C|Cs], [CP|CPs]) :- atom_concat(X, C, CP), '$prepend'(X, Cs, CPs).

examples/mtree.pl

+% mtree(T)
+% Check if T is a term representing a multiway tree.
+mtree(t(_,F)) :- forest(F).
+forest([]).
+forest([T|Ts]) :- mtree(T), forest(Ts).
+
+% count_nodes(T, N)
+% Count the nodes in a multiway tree T.
+count_nodes(t(_,F), N) :- count_nodes(F, NF), N is NF + 1.
+count_nodes([], 0).
+count_nodes([T|Ts], N) :- count_nodes(T, NT), count_nodes(Ts, NTs), N is NT + NTs.
+
+% build_tree(S, T)
+% Build a multiway tree from a string.
+% We suppose that the nodes of a multiway tree contain single characters.
+% In the depth-first order sequence of its nodes, a special character ^
+% has been inserted whenever, during the tree traversal, the move is a
+% backtrack to the previous level.
+build_tree(TS, T) :- atom(TS), !, atom_chars(TS, TL), '$build_tree'(TL-[], T).
+build_tree(TS, T) :- nonvar(T), '$build_tree'(TL-[], T), atom_chars(TS, TL).
+'$build_tree'([X|F1]-T, t(X,F)) :- '$build_forest'(F1-['^'|T], F).
+'$build_forest'(F-F, []).
+'$build_forest'(F1-F3, [T|F]) :- '$build_tree'(F1-F2, T), '$build_forest'(F2-F3, F).
+
+% ipl(T, L)
+% Determine the internal path length of a tree.
+% We define the internal path length of a multiway tree as the total
+% sum of the path lengths from the root to all nodes of the tree.
+ipl(T, L) :- ipl(T, 0, L).
+ipl(t(_,F), D, L) :- D1 is D + 1, ipl(F, D1, LF), L is LF + D.
+ipl([], _, 0).
+ipl([T1|Ts], D, L) :- ipl(T1, D, L1), ipl(Ts, D, Ls), L is L1 + Ls.
+
+% bus(T, L).
+% Construct the bottom-up order sequence L of the nodes in the tree T
+bus(T, Seq) :- nonvar(T), !, '$bus_forest'(T, Seq).
+bus(T, Seq) :- nonvar(Seq), '$bus_tree'(T, Seq).
+
+'$bus_forest'(t(X,F), Seq) :-
+    '$bus_forest'(F, SeqF), append(SeqF, [X], Seq).
+'$bus_forest'([], []).
+'$bus_forest'([T|Ts], Seq) :-
+    '$bus_forest'(T, SeqT), '$bus_forest'(Ts, SeqTs), append(SeqT, SeqTs, Seq).
+
+'$bus_tree'(t(X,F) ,Seq) :-
+    append(SeqF, [X], Seq), '$bus_tree_forest'(F, SeqF).
+
+'$bus_tree_forest'([], []).
+'$bus_tree_forest'([T|Ts], Seq) :-
+    append(SeqT, SeqTs, Seq),
+    '$bus_tree'(T, SeqT), '$bus_tree_forest'(Ts, SeqTs).
+
+% mtree_ltl(T, L)
+% Lisp-like representation of a multiway tree T
+mtree_ltl(T, L) :- '$mtree_ltl'(T, L-[]).
+'$mtree_ltl'(t(X,[]), [X|L]-L) :- X \= '('.
+'$mtree_ltl'(t(X,[T|Ts]), ['(',X|L]-R) :- '$forest_ltl'([T|Ts], L-[')'|R]).
+'$forest_ltl'([], L-L).
+'$forest_ltl'([T|Ts], L-R) :- '$mtree_ltl'(T, L-M), '$forest_ltl'(Ts, M-R).

examples/palindromes.txt

+civic
+even
+deified
+dad
+want
+because
+any
+mom
+these
+devoved
+give
+peeweep
+day
+most
+us
+repaper
+kayak
+different
+small
+minim
+large
+radar
+next
+murdrum
+madam
+lemel
+early
+young
+important
+level
+few
+racecar
+radar
+public
+redder
+private
+bob
+pop
+tot
+bad
+refer
+more
+same
+able
+reviver
+government
+rotator
+company
+rotavator
+number
+stats
+solos
+group
+problem
+tenet
+woman
+terret
+drink
+testset
+sleep

examples/parser-benchmark.py

+from timeit import Timer
+
+repetitions = 1000
+term = "A ; B :- A =.. ['->', C, T], !, (C, !, T ; B)."
+s = 'parser = PrologParser("' + term + '"); parser.read_term()'
+setup = 'from prologlib.parser import PrologParser'
+timer = Timer(s, setup)
+try:
+    result = timer.timeit(repetitions)
+    # 5.25x w.r.t. tuProlog 2.1 (851 ms)
+    print('Time parsing %d terms: %f seconds.' % (repetitions, result))
+except:
+    timer.print_exc()

examples/parser-examples.py

+'''
+Examples of usage for the Prolog parser module.
+
+Should this eventually merged with real unit/functional tests? How?
+'''
+
+from prologlib.parser import PrologTokenizer, EOF, PrologParser
+
+def tokenizer_sample():
+    f = open('sample.pl', 'r')
+    lexer = PrologTokenizer(f)
+    token = lexer.read_token()
+    while token.type != EOF:
+        print(token)
+        token = lexer.read_token()
+    f.close()
+
+def parser_sample():
+    f = open('sample.pl', 'r')
+    parser = PrologParser(f)
+    # the sample comes from a Prolog system where the
+    # following non-ISO operator has been defined
+    parser._ot._table['#'] = [(500, 'yfx')]
+    term = parser.read_term()
+    while term:
+        print(term)
+        term = parser.read_term()
+    f.close()
+
+def parser_family():
+    f = open('family.pl', 'r')
+    parser = PrologParser(f)
+    term = parser.read_term()
+    while term:
+        print(term)
+        term = parser.read_term()
+    f.close()
+
+
+if __name__ == '__main__':
+    import sys
+    selected = sys.argv[1]
+    # runners = {'p' : 'parser_sample', 't' : 'tokenizer_sample'}
+    # runner = runners[selected]
+    if selected == 'p':
+        parser_sample()
+    else:
+        tokenizer_sample()
+    # parser_family()

examples/partition.pl

+% partition(L, X) :- samesize(X, Y), part(L, Y), X = Y.
+partition(L, X) :- samesize(X, Y), part(L, Y), Y = X.
+
+part([], [[]]).
+part([], [[] | T]) :- part([], T).
+part([H | L], O) :- copy_term(O, O2), part(L, O2), update(O2, H, O).
+
+update([X | T], A, [[A | X] | T]).
+update([X | T], A, [X | T2]) :- not(member(A, X)), update(T, A, T2).
+% update([X | T], A, [X | T2]) :- \+(member(A, X)), update(T, A, T2).
+
+samesize([], []).
+samesize([_ | T1], [_ | T2]) :- samesize(T1, T2).
+
+member(E, [E | _]).
+member(E, [_ | L]) :- member(E, L).
+
+% ?- partition([a, b], [X, Y]).

examples/sample.pl

+% BinProlog x.xx Copyright (C) 1992 Paul Tarau. All rights reserved.
+% COMPILER: dcgs --> prolog --> binary progs --> code
+% works on a clause at a time, uses no side effects
+
+cutp(X):-name(X,"$cut").
+
+bin_bu(('$bin_cut'(X,Cont):-true(Cont))):-cutp(X).
+bin_bu(C):-  
+	bu(B,_,Where),
+	bu_body(Where,B,C).
+
+bu_body(in_head,B,(B:-true(Cont))):-
+	functor(B,_,N),arg(N,B,Cont).
+bu_body(in_body,B,(B:-B)).
+
+compile_mem(File):-see(File),compile_mem1(mem,File),seen.
+
+% Mode must be mem
+compile_mem1(Mode,File):-
+	ttyprint(compiling(to(Mode),File,'...')),
+	statistics(runtime,_),
+	mcomp_file(Mode,File),
+	terminate_file(mem,'$end1',1),
+	!,
+	statistics(runtime,[_,T]),
+	ttyprint(compile_time(T)),
+	abort.
+compile_mem1(_,_):-
+	ttyprint('compilation aborted'),
+	restart,
+	abort.
+
+% modes: wam,asm,bin
+compile0(Mode,[F|Fs],OutFile):-!,
+  statistics(runtime,[T1,_]),
+  xcompile(Mode,[F|Fs],OutFile),
+  statistics(runtime,[T2,_]),
+  T is T2-T1,
+  write(total_compile_time(T)),nl.
+compile0(Mode,File,OutFile):-xcompile(Mode,[File],OutFile).
+
+xcompile(Mode,InFiles,OutFile):-
+	tell(OutFile),
+	cc_bus(Mode),
+	member(InFile,InFiles),
+	ttyprint(compiling(to(Mode),InFile,'...')),
+	statistics(runtime,_),
+	comp_file(Mode,InFile),
+	statistics(runtime,[_,T]),
+	ttyprint(compile_time(T)),
+	fail.
+xcompile(Mode,_,_):-
+	terminate_file(Mode,'$end0',0),
+	fail.
+xcompile(_,_,_):-
+	told.
+
+terminate_file(Mode,Dummy,Level):-
+	cc(Mode,Dummy),
+	emit_code(Mode,[[ii(end,?,Level,Mode)]]).
+
+survive_cleanup(F0,F):-
+	name(F0,Survivor),  % Survivor is now a list on the heap
+	restart,     % total cleanup of name-spaces, strings, files etc...
+	name(F,Survivor),   % F is now a valid name
+	see(F),seen.      % F is now linked to an internal file pointer
+
+% compiles to memory	
+mcomp_file(Mode,InFile):-
+	survive_cleanup(InFile,F),
+	translate_all(F,Mode).
+
+comp_file(Mode,InFile):-
+	member(Mode,[wam,asm,bin]),!,
+	translate_all(InFile,Mode).
+
+translate_all(F,Mode):-
+	seeing(F0),
+		see(F),
+			repeat,
+				read(C),
+				translate(C,Mode),
+			!,
+		seen,
+	see(F0).
+
+translate(end_of_file,_):-!.
+translate(':-'(C),Mode):-!,translate_cmd(C,Mode),fail.
+translate('::-'(H,B),Mode):-!,cc_bin(Mode,(H:-B)),fail.
+translate(C,Mode):-cc(Mode,C),fail.
+
+translate_cmd([F],Mode):-!,include_file(F,Mode).
+translate_cmd(compile(F),Mode):-!,include_file(F,Mode).
+translate_cmd(op(X,Y,Z),wam):-!,
+	op(X,Y,Z), 
+	encode('operator',op(X,Y,Z),0,wam).
+translate_cmd(C,_):-
+  telling(F),tell(user),exec_cmd(C),told,tell(F),fail.
+
+exec_cmd(C):-is_compiled(C),!,(C,fail;true).
+exec_cmd(C):-errmes(bad_command,C).
+
+include_file(IFile,Mode):-
+	seeing(CF1),
+	find_file(IFile,F),
+	ttyprint(begin(including(F),in(CF1))),
+	translate_all(F,Mode),
+	seeing(CF2),ttyprint(end(including(F),in(CF2))).
+
+preprocess(Clause,BinClause):-
+	preprocess(Clause,_,_,BinClause).
+
+preprocess(C,M,D,B):-
+	std_expand_term(C,E),
+	fact2rule(E,M),    
+	mdef_to_def(M,D),
+	def_to_mbin(D,B).
+
+cc(Mode,C):-
+	preprocess(C,M,D,B),
+	show_steps(Mode,M,D),
+	cc_bin(Mode,B).
+
+fact2rule((:-B),(:-B)):-!.
+fact2rule((H:-B),(H:-B)):-!.
+fact2rule(H,(H:-true)).
+
+% BINARY CLAUSE COMPILER
+
+cc_bus(Mode):-Mode\==bin,bin_bu(B),cc_bin(Mode,B),fail.
+cc_bus(_).
+
+cc_bin(bin,C):-!,portray_clause(C),fail.
+cc_bin(asm,C):-write('BINARY:'),nl,portray_clause(C),nl,fail.
+cc_bin(Mode,C):-
+	comp_clause(C,CodeC,Def,Exec),
+	emit_code(Mode,[Def,CodeC,Exec]),
+	!.
+cc_bin(Mode,C):-
+	errmes(failing_to_compile_clause(Mode),C).
+
+emit_code(mem,C):-gen_code(mem,C).
+emit_code(wam,C):-gen_code(wam,C).
+emit_code(asm,C):-show_code(C).
+
+show_steps(asm,M,D):-
+  nl,M\==D,write('EXPANDED:'),nl,portray_clause(M),nl,fail
+; write('DEFINITE:'),nl,portray_clause(D),nl,fail.
+show_steps(_,_,_).
+	
+comp_clause(C,OCode,
+	[ii(clause,?,F1,N1),ii(firstarg,?,G/M,LastN)],
+	[ii(execute,?,F2,N2)]):-
+	add_true(C,(H:-B)),
+	firstarg(H,G/M),
+	cc_h_b(H,F1/N1,B,F2/N2,RCode),
+	max(N1,N2,MaxN),FirstN is MaxN+1,
+	vars(RCode,OCode),
+	functor(Dict,dict,MaxN),
+	fill_info(OCode,Dict),
+	collapse_args(Dict,1,MaxN),
+	allocate_regs(OCode,FirstN/FirstN-[],FirstN/LastN-_).
+
+cc_h_b(H,F1/N1,B,F2/N2,RCode):-
+	cc_h(H,F1/N1,get-RCode,get-Rest), % pp(h=H),
+	cc_b(B,F2/N2,put-Rest,put-[]),!. % pp(b=B)
+
+firstarg(H,G/M):-arg(1,H,A),nonvar(A),!,functor(A,G,M).
+firstarg(_,'_'/0).
+
+cc_h(B,F/N)-->{bu(B,No,in_head)},!,
+	{functor(B,F,N),arg(N,B,Cont)},
+	emit(get,ii(builtin,?,No,Cont)).
+cc_h(T,F/N)-->
+	{functor(T,F,N),N>0},!,{functor(CT,F,N)},
+	emit_head_top_term(N,T,CT).
+cc_h(T,_)-->{errmes(unexpected_head_atom,T)}.
+
+cc_b(Cont,true/1)-->{var(Cont)},!,
+	emit_body_top_term(1,true(_),true(Cont)).
+cc_b(true,true/0)-->!.
+cc_b('$bin_cut'(_cutp,Cont),FN)-->!,
+	emit(put,ii(put,_,temp(1),_cutp)),  
+	cc_b(Cont,FN).
+cc_b(=(A,B,Cont),FN)-->!,
+	cc_t(V1=A),
+	cc_t(V2=B),
+	emit(put,ii(put,_,temp(0),V1)),
+	emit(put,ii(get,_,temp(0),V2)), 
+	cc_b(Cont,FN).
+cc_b(B,FN)-->{bu(B,No,in_body)},!,
+	cc_b_bu(No,B,FN).
+cc_b(T,F/N)-->
+	{functor(T,F,N),N>0},!,{functor(CT,F,N)},
+	emit_body_top_term(N,T,CT).
+cc_b(T,_)-->{errmes(unexpected_body_atom,T)}.
+
+/*
+arith_op(Op):-bu(B,arith(_,_),_),!,functor(B,Op,_).
+
+% arith_no(No):-bu(_,arith(No,_),_).
+
+% arith_outargs(K):-bu(_,arith(_,K),_).
+*/
+
+out_reg(0,_,0).
+out_reg(1,Res,Res).
+
+cc_b_bu(arith(No,NbOutArgs),OpArgsCont,FN)-->!,
+	{ functor(OpArgsCont,Op,N1),arg(N1,OpArgsCont,Cont),
+		N is N1-1, arg(N,OpArgsCont,X), out_reg(NbOutArgs,X,Res),
+		I is N-NbOutArgs,functor(NewOpArgs,Op,I) % NbOutArgs = 0,1
+	},
+	handle_constant_res(NbOutArgs,VarRes=Res),
+	emit_top_bargs(1,I,OpArgsCont,NewOpArgs),
+	emit(put,ii(arith,_Type,No,VarRes)),
+	cc_b(Cont,FN).
+cc_b_bu(No,BodyAndCont,FN)-->
+	{ functor(BodyAndCont,_,N),N1 is N-1,
+		arg(N,BodyAndCont,Cont),
+		arg(1,BodyAndCont,Arg)
+	},
+	cc_b_args(N1,Arg),
+	emit(put,ii(inline,_,No,_)), % inline=>void variable
+	cc_b(Cont,FN).
+
+handle_constant_res(0,_)-->!.
+handle_constant_res(1,X=C)-->{var(C)},!,{X=C}.
+handle_constant_res(1,X=C)-->{atomic(C)},!,
+	emit(put,ii(put,_,temp(0),C)),
+	emit(put,ii(get,_,temp(0),X)).
+handle_constant_res(1,X=C)-->!,
+	cc_t(X=C).
+
+% handle_constant_res(1,_=C)-->{errmes(must_be_atomic_or_var,C)}.
+
+classif_load(X,A,_)-->{var(A)},!,{X=A}.
+classif_load(X,A,constant)-->{atomic(A)},!,{X=A}.
+classif_load(X,A,_)-->cc_t(X=A).
+	
+cc_b_args(0,_)-->[].
+cc_b_args(1,Arg)-->cc_t(V=Arg),
+	emit(put,ii(put,_,temp(0),V)).
+
+emit_top_bargs(I,N,_,_) --> {I>N},!.
+emit_top_bargs(I,N,T,CT) --> {I=<N,I1 is I+1},
+	{arg(I,T,A),arg(I,CT,X)},
+	classif_load(X,A,Type),
+	emit(put,ii(load,Type,I,X)),
+	emit_top_bargs(I1,N,T,CT).
+
+emit_top_bargs(I,N,T,CT) --> {I=<N},
+	{arg(I,T,A),arg(I,CT,X)},
+	!,
+	cc_t(X=A),
+	{I1 is I+1},
+	emit_top_bargs(I1,N,T,CT).
+
+emit_head_top_term(N,T,CT) --> 
+	emit_top_args(get,1,1,T,CT),
+	cc_arg(1,1,CT,T),
+	emit_top_args(get,2,N,T,CT),
+	cc_arg(2,N,CT,T).
+	
+emit_body_top_term(N,T,CT) --> 
+	cc_arg(1,N,CT,T),!,
+	emit_top_args(put,1,N,T,CT).
+
+emit_top_args(_,I,N,_,_) --> {I>N},!.
+emit_top_args(Op,I,N,T,CT) --> {I=<N},
+  {arg(I,T,A),arg(I,CT,X),classif_arg(X,A,Type)}, % must be int. if const!
+  !,
+  emit(Op,ii(Op,Type,arg(I),X)),
+  {I1 is I+1},
+  emit_top_args(Op,I1,N,T,CT).
+
+cc_t(X=T) --> {var(T)},!,{X=T}.
+cc_t(X=T) --> {atomic(T)},!,{X=T}.
+cc_t(X=T) --> {functor(T,F,N)},{N>0},!,
+	{functor(CT,F,N)},
+	emit_term(X,F,N,T,CT).
+
+emit_term(X,F,N,T,CT) --> emit_wam(get,X,F,N,T,CT),!,cc_arg(1,N,CT,T).
+emit_term(X,F,N,T,CT) --> cc_arg(1,N,CT,T),emit_wam(put,X,F,N,T,CT).
+
+cc_arg(I,N,_,_) -->  {I>N},!.
+cc_arg(I,N,CT,T) --> {I=<N},
+	{arg(I,T,A),arg(I,CT,X)},
+	{I1 is I+1},!,
+	cc_t(X=A),
+	cc_arg(I1,N,CT,T).
+
+emit_wam(Op,X,F,N,T,CT) --> {N>0},
+	emit(Op,ii(Op,structure,F/N,X)),
+	emit_args(1,N,T,CT).
+
+emit_args(I,N,_,_) --> {I>N},!.
+emit_args(I,N,T,CT) --> {I=<N},
+	{arg(I,T,A),arg(I,CT,X),classif_arg(X,A,Type)},
+	!,
+	emit(Op,ii(UnifyOp,Type,Op,X)),
+	{unify_op(Op,UnifyOp),I1 is I+1},
+	emit_args(I1,N,T,CT).
+
+unify_op(put,write).
+unify_op(get,unify).
+
+classif_arg(X,A,_):-var(A),!,X=A.
+classif_arg(X,A,constant):-atomic(A),!,X=A.
+classif_arg(_,_,_).
+
+emit(Mode,E,Mode-[E|Es],Mode-Es).
+
+max(X,Y,Z):-X>Y,!,Z=X.
+max(_,Y,Y).
+
+add_true((H:-B),(H:-B)):-!.
+add_true(H,(H:-true)).
+
+
+% VARIABLE OCCURRENCE CLASSIFIER
+
+% vars(T,R) :-
+% each (selected) variable V of T gives in R a term
+%
+%   var(NewVar,OccNo/MaxOccurrences)
+%
+% and T is subject to (an ugly) side effect as selected
+% variables get unified to '$OCC'(s(s(...)),MaxOccurrences)
+
+vars(T,R):-
+	find_occurrences(T,R,Vars,[]),
+	count_occurrences(Vars).
+
+find_occurrences([],[])-->[].
+find_occurrences([ii(Op,Type,Val,Var)|L],[ii(Op,Type,Val,Occ)|R])-->
+	occurrence(Var,Occ),
+	find_occurrences(L,R).
+
+occurrence(A,A)-->{atomic(A)},!.
+occurrence(V,var(NewV,1/Max))-->{var(V)},!,
+	newvar(X=Max),
+	{V='$OCC'(NewV,X=Max)}.
+occurrence('$OCC'(OldV,X=Max),var(OldV,K/Max))-->!,
+	oldvar(X=Max,K).
+occurrence(Var,Occ)-->{errmes(bad_occurrence,at(var=Var,occ=Occ))}.
+
+inc(V,K,K):-var(V),!,V=s(_).
+inc(s(V),K1,K3):-K2 is K1+1,inc(V,K2,K3).
+
+oldvar(X=_,K,Xs,Xs):-inc(X,2,K).
+
+newvar(E,[E|Es],Es).
+
+count_occurrences([]):-!.
+count_occurrences([X=Max|Vs]):-inc(X,1,Max),count_occurrences(Vs).
+
+
+% ARGUMENT REGISTER OPTIMIZER
+
+% fills Dict and and marks still free slots in variables
+% with information on liftime of arguments
+
+fill_info(Is,Dict):-fill_all(Is,Dict,0,_).
+
+tpoint(T2,T1,T2):-T2 is T1+1. % gets a time-point
+
+fill_all([],_)-->[].
+fill_all([I|Is],Dict)-->
+	{fill_var_type(I)},
+	fill_one(I,Dict),
+	fill_all(Is,Dict).
+
+% fills in liftime information using occurrence numbers
+
+fill_var_type(ii(_,Type,_,var(_,Occ))):-var(Type),!,get_var_type(Occ,Type).
+fill_var_type(_).
+
+get_var_type(1/_,variable):-!.
+get_var_type(K/Max,value):-K=<Max,!.
+
+fill_one(ii(Op,constant,arg(An),_),Dict)-->!,tpoint(T),
+	{mark_arg(Op,T,An,var(_-T/T,1/1),Dict)}.
+fill_one(ii(_,constant,_,_),_)-->!,tpoint(_).
+fill_one(ii(Op,_,arg(An),Xn),Dict)-->!,tpoint(T),
+	{mark_arg(Op,T,An,Xn,Dict)},
+	{mark_var(T,Xn)}.
+fill_one(ii(_,_,_,var(Id,Occ)),_)-->!,tpoint(T),
+	{mark_var(T,var(Id,Occ))}.
+
+% marks the argument An of Dict with liftime information
+mark_arg(get,From,An,Xn,Dict):-arg(An,Dict,Xn*_-From/_).
+mark_arg(put,To  ,An,Xn,Dict):-arg(An,Dict,_*Xn-_/To).
+
+% marks a variable with liftime information
+mark_var(T,var(_-T/T,1/1)):-!.
+mark_var(T,var(_-T/_,1/Max)):-1<Max,!.
+mark_var(T,var(_-_/T,Max/Max)):-1<Max,!.
+mark_var(_,var(_-_/_,_/_)).
+
+% collapses arguments and variables, if possible
+collapse_args(_,I,Max):-I>Max,!.
+collapse_args(Dict,I,Max):-I=<Max,
+	arg(I,Dict,X),
+	collapse_them(I,X),
+	I1 is I+1,
+	collapse_args(Dict,I1,Max).
+
+default(V1/V2):-set_to(0,V1),set_to(99999,V2).
+
+set_to(Val,Val):-!.
+set_to(_,_).
+
+
+% checks if argument I living ALife can be collapsed with
+%   input head variable H living HLife and 
+%   output body variable B living BLife
+
+collapse_them(I,var(H-HLife,_)*var(B-BLife,_)-ALife):-
+	default(HLife),default(BLife),default(ALife),
+	check_lifetimes(H-HLife,B-BLife,I-ALife).
+
+check_lifetimes(I-HLife,I-BLife,I-ALife):-
+	check_var_arg(HLife,ALife),
+	check_var_var(HLife,BLife),
+	check_var_arg(BLife,ALife),!.
+check_lifetimes(I-HLife,_,I-ALife):-
+	check_var_arg(HLife,ALife),!.
+check_lifetimes(_,I-BLife,I-ALife):-
+	check_var_arg(BLife,ALife),!.
+check_lifetimes(_,_,_).
+
+check_var_var(_/H2,B1/_):-H2=<B1,!.
+check_var_var(H1/_,_/B2):-B2=<H1.
+
+check_var_arg(X1/X2,A1/A2):-
+	A1=<X1,X2=<A2.
+
+
+% TEMPORARY VARIABLE ALOCATOR
+
+allocate_regs([])-->!.
+allocate_regs([I|Is])-->
+	allocate1(I),
+	allocate_regs(Is).
+
+allocate1(ii(_,_,_,var(Reg-_,KMax)))-->allocate_reg(Reg,KMax),!.
+allocate1(_)-->[].
+
+allocate_reg(Reg,1/1)-->{var(Reg)},!,
+	get_reg(Reg),
+	free_reg(Reg).
+allocate_reg(Reg,1/Max)-->{var(Reg),1<Max},!,
+	get_reg(Reg).
+allocate_reg(Reg,Max/Max)-->{1<Max},!,
+	free_reg(Reg).
+
+free_reg(Reg,Min/N-Regs,Min/N-[Reg|Regs]):-Reg>=Min,!.
+free_reg(_,Rs,Rs).
+
+get_reg(Reg,Min/N-[Reg|Regs],Min/N-Regs):-!.
+get_reg(N,Min/N-Regs,Min/N1-Regs):-N1 is N+1.
+
+
+%----------PREPROCESSOR TO BINARY LOGIC PROGRAMS-------------
+
+% Transforms definite metaprograms to binary meta-programs
+% definite meta clause -> definite clause+ some replacements
+
+mdef_to_def((H:-B),(H:-NewB)):-repl_body(B,NewB).
+mdef_to_def((:-B),(:-NewB)):-repl_body(B,NewB),!,
+	NewB,  % called here and not propagated to the next step
+	fail.
+
+% replaces metavars and some builtins in clause bodies
+			 
+repl_body(MetaVar,call(MetaVar)):-var(MetaVar),!.
+repl_body(M,ExpM):-repl_macro(M,ExpM),!.
+repl_body(A,NewA):-split_op(A,L),!,strip_nil(L,NewA).
+repl_body(A,A).
+
+repl_macro('!','$bin_cut'(X)):-cutp(X).
+repl_macro(var(X),Known):-nonvar(X),repl_known(var(X),Known).
+repl_macro(nonvar(X),Known):-nonvar(X),repl_known(nonvar(X),Known).
+repl_macro(atomic(X),Known):-nonvar(X),repl_known(atomic(X),Known).
+repl_macro(float(X),Known):-nonvar(X),repl_known(float(X),Known).
+repl_macro(atomic(X),Known):-nonvar(X),repl_known(atomic(X),Known).
+repl_macro((A,B),NewAB):-repl_conj(A,B,NewAB).
+repl_macro((A;B),NewAB):-repl_disj(A,B,NewAB).
+repl_macro((A->B),(NewA->NewB)):-
+	repl_body(A,NewA),
+	repl_body(B,NewB).
+repl_macro(compare(R,A,B),compare0(A,B,R)):-
+repl_macro(A==B,compare0(A,B,=)).
+repl_macro(A@<B,compare0(A,B,<)).
+repl_macro(A@>B,compare0(A,B,>)).
+repl_macro('=>'(K,X),lval(K1,K2,X)):-repl_lval(K,K1,K2).
+
+repl_conj(A,B,NewAB):-nonvar(A),split_op(A,NewA),!,
+	repl_body(B,NewB),
+	app_body(NewA,NewB,NewAB).
+repl_conj(A,B,(NewA,NewB)):-
+	repl_body(A,NewA),
+	repl_body(B,NewB).
+
+repl_disj(If,C,if(NewA,NewB,NewC)):-nonvar(If),If=(A->B),!,
+	repl_body(A,NewA),
+	repl_body(B,NewB),
+	repl_body(C,NewC).
+repl_disj(A,B,or(NewA,NewB)):-
+	repl_body(A,NewA),
+	repl_body(B,NewB).
+
+repl_lval('#'(K1,K2),K1,K2):-!.
+repl_lval(K,K,K).
+
+repl_known(X,true):-X,!.
+repl_known(_,fail).
+	
+split_op(X is B,R):-split_is_rel(X,B,R).
+split_op(A < B,R):-split_rel(less,A,B,R).
+split_op(A > B,R):-split_rel(greater,A,B,R).
+split_op(A =< B,R):-split_rel(less_eq,A,B,R).
+split_op(A >= B,R):-split_rel(greater_eq,A,B,R).
+split_op(A =:= B,R):-split_rel(arith_eq,A,B,R).
+split_op(A =\= B,R):-split_rel(arith_dif,A,B,R).
+
+split_is_rel(X,B,[+(B,0,X)]):-var(B),!.
+split_is_rel(X,B,[+(B,0,X)]):-atomic(B),!.
+split_is_rel(X,B,[+(B,0,X)]):-float(B),!.
+split_is_rel(X,B,R):-split_is(X,B,R,[]).
+
+app_body([],Bs,Bs):-!.
+app_body([A|As],Bs,(A,Cs)):-app_body(As,Bs,Cs).
+
+strip_nil([A],A):-!.
+strip_nil([A|As],(A,Bs)):-strip_nil(As,Bs).
+
+split_rel(Op,A,B,Res):-split_rel_1(Op,A,B,Res,[]).
+
+split_rel_1(Op,A,B)-->
+	split_is(X,A),
+	split_is(Y,B),
+	{OpXY=..[Op,X,Y]},
+	emit_is(OpXY).
+
+split_is(X,A)-->{var(A)},!,{X=A}.
+split_is(X,A)-->{atomic(A)},!,{X=A}.
+split_is(X,A)-->{float(A)},!,{X=A}.
+split_is(R,OpAB)-->
+	{OpAB=..[Op,A,B]},!,
+	split_is(VA,A),
+	split_is(VB,B),
+	{OpArgs=..[Op,VA,VB,R]},
+	emit_is(OpArgs).
+split_is(R,OpA)-->
+	{OpA=..[Op,A]},
+	split_is(VA,A),
+	{OpArgs=..[Op,VA,R]},
+	emit_is(OpArgs).
+
+emit_is(X,[X|Xs],Xs).
+
+% converts a definite clause to a binary metaclause
+%    where each metavariable Cont represents a "continuation"
+%    and a goal G is represented by a clause :- G.
+
+% def_to_mbin((:-B),(:-BC)):-!,add_cont(B,true,BC).
+def_to_mbin((H:-B),(HC:-BC)) :- !,
+		 termcat(H,Cont,HC), 
+		 add_cont(B,Cont,BC).
+def_to_mbin(H,(HCont:-true(Cont))):-
+		 termcat(H,Cont,HCont).
+
+% adds a continuation to a term
+
+add_cont((true,Gs),C,GC):-!,add_cont(Gs,C,GC).
+add_cont((fail,_),C,fail(C)):-!.
+add_cont((G,Gs1),C,GC):-!,
+		 add_cont(Gs1,C,Gs2),
+		 termcat(G,Gs2,GC).
+add_cont(G,C,GC):-termcat(G,C,GC).
+
+% ------------------------------------------------------------------
+% simple WAM-code lister
+
+show_code(IIs):-
+	write('WAM-ASSEMBLER:'),nl,
+	member(Is,IIs),
+	member(I,Is),
+	show_or_skip(I),
+	fail.
+show_code(_):-nl.
+
+show_or_skip(ii(get,variable,arg(I),var(I-_,_))):-!.
+show_or_skip(ii(put,value,arg(I),var(I-_,_))):-!.
+show_or_skip(ii(Op,T,X,Y)):-
+	write(Op),write('_'),write(T),write(' '),write((X,Y)),nl.
+	
+% ------------------------------------------------------------------
+% BYTE CODE GENERATOR
+
+% eliminates redundancies and beautifies the code
+beautify(arg(X),Op,Type,V,To):-!,encode_arg(X,Op,Type,V,To).
+beautify(temp(X),Op,Type,V,To):-!,encode_arg(X,Op,Type,V,To).
+beautify(Val,Op,Type,var(Xn-_,_),To):-!,encode2(Op,Type,Val,Xn,To).
+beautify(put,write,constant,X,To):-cutp(X),!,encode2(push,cut,?,?,To).
+beautify(Y,Op,X,Z,To):-encode2(Op,X,Y,Z,To).
+
+encode_arg(I,get,variable,var(I-_,_),_):-!.
+encode_arg(I,put,value,var(I-_,_),_):-!.
+encode_arg(An,Op,Type,var(Xn-_,_),To):-!,encode2(Op,Type,Xn,An,To).
+encode_arg(1,Op,constant,X,To):-cutp(X),!