!<arch>
all             0           0     0     100400  797       `
/* all: Load all the current bits of the standard Prolog system

                                                 Fernando Pereira
                                                 Updated: 17 September 83
*/

:-([
	'cplog:tty',			%  tty* predicates
	'cplog:error',			%  $error and $message
	'cplog:arith',			%  arithmetic expression flattener
	'cplog:grammar',			%  DCG grammar rule translation
	'cplog:sort',			%  sort, keysort, merge, msort
	'cplog:setof',			%  setof, bagof, ^ 
	'cplog:tracing',			%  Debugging evaluable predicates
	'cplog:listing',			%  Listing and other output
	'cplog:ops',			%  Operator declaration/lookup
	'cplog:ground',			%  numbervars/ground
	'cplog:unify',			%  unify/occurs_check
	'cplog:lib'			%  lib/libdirectory
]).

:-([
	'cplog:protect'			%  Lock things up
]).


arith           0           0     0     100400  3446      `
%   File   : pl/arith
%   Author : Fernando Pereira
%   Updated: 18 November 1983
%   Purpose: Preprocess arithmetic expressions.

/*  The point of all this junk is that C Prolog normally doesn't do
    anything special with arithmetic, so that in a goal such as
	X is Y+1
    C Prolog says to itself "Aha!  Y occurs inside a structure inside
    an argument, I must make it a GLOBAL variable!"  The trouble with
    global variables is that they don't go away until you fail, so a
    simple little program which does a lot of computing may tie up
    enormous amounts of global stack it doesn't really need.  One cure
    for this would be to provide a garbage collector.  Joking aside,
    this file cures the problem by translating arithmetic goals into
    calls on is/3 and is/4.  But only if the $carith flag is on.
    Beware!  "X is Y" identifies X and Y at compile time!!!!!!
    I have made the expansion simplify lists and evaluate constants
    as well, so (Up is Lo+("a"-"A")) => is(Up, +, Lo, 32).
*/

$compile_arith(P0, P) :-
	$carith(1, 1), !,
	$expand_arith(P0, P).
$compile_arith(P, P).

$expand_arith(P, P) :-
	var(P), !.
$expand_arith((P0,Q0), (P,Q)) :- !,
	$expand_arith(P0, P),
	$expand_arith(Q0, Q).
$expand_arith((P0;Q0), (P;Q)) :- !,
	$expand_arith(P0, P),
	$expand_arith(Q0, Q).
$expand_arith((P0->Q0), (P;Q)) :- !,
	$expand_arith(P0, P),
	$expand_arith(Q0, Q).
$expand_arith(X is Y, P) :-
	nonvar(Y),		%  Don't bother rewriting simple expressions.
	\+ atomic(Y),		%  In fact we mustn't rewrite variables.
	!,
	$user_call(expand_expression(Y, P0, X0)),
	$drop_is(X0, X, P1),
	and(P0, P1, P).
$expand_arith(Comp0, R) :-
	$compop(Comp0, Op, E, F), !,
	$compop(Comp,  Op, U, V),
	$user_call(expand_expression(E, P, U)),
	$user_call(expand_expression(F, Q, V)),
	and(P, Q, R0),
	and(R0, Comp, R).
$expand_arith(P, P).

and(true, P, P) :- !.
and(P, true, P) :- !.
and(P, Q, (P,Q)).

$drop_is(V, V, true) :- var(V), !.
$drop_is(V, X, X is V).

$compop(X < Y, < , X, Y).
$compop(X > Y, > , X, Y).
$compop(X=< Y,=< , X, Y).
$compop(X >=Y, >=, X, Y).
$compop(X=:=Y,=:=, X, Y).
$compop(X=\=Y,=\=, X, Y).

expand_expression(V, true, V) :-
	var(V), !.
expand_expression([T], P, V) :- !,
	expand_expression(T, P, V).
expand_expression(A, true, A) :-
	atomic(A), !.
expand_expression(T, P, V) :-
	unaryop(T, O, A), !,
	expand_expression(A, Q, X),
	expand_expression(V, O, X, Q, P).
expand_expression(T, P, V) :-
	binaryop(T, O, A, B), !,
	expand_expression(A, Q, X),
	expand_expression(B, R, Y),
	expand_expression(V, O, X, Y, Q, P),
	and(Q, S, P).

expand_expression(Y, O, X, Q, Q) :-
	number(X), !,
	is(Y, O, X).
expand_expression(V, O, X, Q, P) :-
	and(Q, is(V,O,X), P).

expand_expression(Z, O, X, Y, Q, Q) :-
	number(X), number(Y), !,
	is(Z, O, X, Y).
expand_expression(Z, O, X, Y, Q, P) :-
	and(Q, is(V,O,X,Y), P).


unaryop(+X,	+,	X).
unaryop(-X,	-,	X).
unaryop(\X,	\,	X).
unaryop(exp(X),exp,	X).
unaryop(log(X),log,	X).
unaryop(log10(X),log10,X).
unaryop(sqrt(X), sqrt, X).
unaryop(sin(X),sin,	X).
unaryop(cos(X),cos,	X).
unaryop(tan(X),tan,	X).
unaryop(asin(X), asin, X).
unaryop(acos(X), acos, X).
unaryop(atan(X), atan, X).
unaryop(floor(X),floor,X).

binaryop(X+Y,	+,	X,Y).
binaryop(X-Y,	-,	X,Y).
binaryop(X*Y,	*,	X,Y).
binaryop(X/Y,	/,	X,Y).
binaryop(X mod Y, mod,	X,Y).
binaryop(X//Y,	//,	X,Y).
binaryop(X/\Y,	/\,	X,Y).
binaryop(X\/Y,	\/,	X,Y).
binaryop(X<<Y,	<<,	X,Y).
binaryop(X>>Y,	>>,	X,Y).
binaryop(X^Y,	^,	X,Y).

error           0           0     0     100400  1013      `
/*  File   : pl/error
    Author : Richard O'Keefe
    Updated: 17 September 83, 1983, 7:42:14 pm
    Purpose: display error messages at the terminal.

	This is just the beginning of a better  error  handling  system.
    $error(Message,  Culprit)  writes  an  error  Message  on the "user"
    stream, and prints the Culprit.  On UNIX, we really should  have  an
    "error"  stream  that these messages can be sent to, and the tracing
    messages should also go there.  In practice, "user" will serve.

	Some errors should cause aborts, some failures, and  some  ought
    to  switch  debugging  on.  This needs thinking about.  The culprits
    used to be 'print'ed, they are now 'write'n.   I really have not the
    least idea which is better.
*/

$error(Message, Culprit) :-
	telling(Old, user),
	write('
! '),	write(Message),
	write('
! goal: '),
	write(Culprit),
	nl,
	tell(Old),
	!, fail.


$message(Message, Culprit) :-
	telling(Old, user),
	nl, write(Message),
	write(Culprit),
	nl,
	tell(Old),
	!.
	

flag            0           0     0     100400  2419      `
/*  flag(Variable, OldValue, NewValue)

    is an omnium-gatherum predicate used to replace a number of old system
    predicates for switching miscellaneous things on and off.  It may also
    be used for switching your own variables on and off as well.

    The OldValue is unified with the current value of the Variable, then
    the NewValue (which must be an arithmetic expression) is evaluated, and
    assigned to the Variable.  This is not a very "logical" operation, I am
    afraid, but there it is.

    $flag/3 is the genuine primitive.
*/

flag(Char, Old, New) :-
	integer(Char),
	(   Char < 0
	|   Char > 127
	),  !,
	$error('first argument is not an Ascii character', flag(Char,Old,New)).
flag(Char, Old, New) :-
	integer(Char), !,
	$flag(Char, Old, New).
flag(Flag, Old, New),
	var(Flag), !,
	$error('first argument is a variable', flag(Flag,Old,New)).
flag(Flag, Old, New) :-
	$flag(Flag, Code), !,
	$flag(Code, Old, New).
flag(User, Old, New) :-
	clause(flag(User, Old), true, Ref),
	Val is New, !,
	asserta(flag(User, Val)),
	erase(Ref).
flag(Dud, Old, New) :-
	$error('no flag/2 fact or bad new value', flag(Dud,Old,New)).


%   table of system flags and their codes

$flag(recons,		128).		%  consulting/reconsulting?
$flag('LC',		129).		%  capitals start atoms/variables?
$flag(fileerrors,	130).		%  file problems fail/error?
$flag(unknown,		131).		%  undefined preds fail/error?
$flag(trace,		132).		%  tracing/quiet?
$flag(debug,		133).		%  debug info kept/discarded?
$flag(leash,		134).		%  stop at which ports?
$flag(all_float,	135).		%  force floating arithmetic?


%   specialised predicates for compatibility with Dec-10 Prolog and older
%   versions of C Prolog.

trace :-
	$flag(132, _, 1),
	$flag(133, _, 1).


'NOLC' :-
	$flag(129, _, 0).
'LC' :-
	$flag(129, _, 1).


fileerrors :-
	$flag(130, _, 0).
nofileerrors :-
	$flag(130, _, 1).


all_float(X, Y) :-
	$flag(135, X0, X0),
	$flag_code(X0, all_float, X),
	nonvar(Y),
	$flag_code(Y0, all_float, Y),
	$flag(135, X0, Y0).


unknown(X, Y) :-
	$flag(131, X0, X0),
	$flag_code(X0, unknown, X),
	nonvar(Y),
	$flag_code(Y0, unknown, Y),
	$flag(131, X0, Y0).


$flag_code(1, all_float,  on).
$flag_code(0, all_float, off).
$flag_code(1, unknown, trace).
$flag_code(0, unknown,  fail).


%   temporary predicates to be unfolded in-line

$leash(P, N) :-
	$flag(134, P, N).

$debug(P, N) :-
	$flag(133, P, N).

$recons(X) :-
	$flag(128, _, X).


grammar         0           0     0     100400  1399      `
/*  File   : pl/grammar
    Author : Fernando Pereira
    Updated: Wednesday May 11th, 1983, 7:29:05 pm
    Purpose: translation of grammar rules
*/


$translate_rule((LP-->[]), H) :- !,
	$t_head(LP, S, S, H).
$translate_rule((LP-->RP), (H:-B)):-
	$t_head(LP, S, SR, H),
	$t_body(RP, S, SR, B1),
	$t_tidy(B1, B).


$t_head((LP,List), S, SR, H):- !,
	$append(List, SR, List2),
	$extend([S,List2], LP, H).
$t_head(LP, S, SR, H) :-
	$extend([S,SR], LP, H).


$t_body(!, S, S, !) :- !.
$t_body([], S, S1, S=S1) :- !.
$t_body([X], S, SR, 'C'(S,X,SR)) :- !.
$t_body([X|R], S, SR, ('C'(S,X,SR1),RB)) :- !,
	$t_body(R, SR1, SR, RB).
$t_body({T}, S, S, T) :- !.
$t_body((T,R), S, SR, (Tt,Rt)) :- !,
	$t_body(T, S, SR1, Tt),
	$t_body(R, SR1, SR, Rt).
$t_body((T;R), S, SR, (Tt;Rt)) :- !,
	$t_body(T, S, S1, T1), $t_fill(S, SR, S1, T1, Tt),
	$t_body(R, S, S2, R1), $t_fill(S, SR, S2, R1, Rt).
$t_body(T, S, SR, Tt) :-
	$extend([S,SR], T, Tt).


$t_fill(S, SR, S1, T, (T,SR=S)) :-
	S1 == S, !.
$t_fill(S, SR, SR, T, T).


$extend(More, OldT, NewT) :-
	OldT =.. OldL,
	$append(OldL, More, NewL),
	NewT =.. NewL.


$append([], L, L) :- !.
$append([H|T], L, [H|R]) :-
	$append(T, L, R).


$t_tidy((P1;P2), (Q1;Q2)) :- !,
	$t_tidy(P1, Q1),
	$t_tidy(P2, Q2).
$t_tidy(((P1,P2),P3), Q) :-
	$t_tidy((P1,(P2,P3)), Q).
$t_tidy((P1,P2), (Q1,Q2)) :- !,
	$t_tidy(P1, Q1),
	$t_tidy(P2, Q2).
$t_tidy(A, A).


'C'([X|S],X,S).


ground          0           0     0     100400  3146      `
/*  File   : <prolog>/pl/ground
    Author : R.A.O'Keefe
    Updated: 17 September 83
    Purpose: define the numbervars/3 and ground/1 predicate.

    numbervars(Term, Init, Final) is mainly used to make terms
    ground.  The type system in particular needs it so that it
    can use unification to peform a subsumption test.  If the
    Init argument is 0, the Final argument is the number of
    distinct variables in the Term.

    A fairly common way of using this is to achieve one-way
    pattern matching.  By binding all the variables in this term
    to $VAR(N) terms, we ensure that they cannot be bound again.
    The trouble is, at the end of the day, we want these bindings
    to go away as well.  So we have to fail, even when we might
    have succeeded.  This leads to a structure similar to that of
    negation:
	one_way(Term, ...) :-
		not not_one_way(Term, ...).

	not_one_way(Term, ...) :-
		numbervars(Term, 0, _),
		good_outcome(......), !,
		fail.
	not_one_way(Term, ...).
    One arrives at this pattern by thinking about the effect of
    backtracking in a positive procedural sort of way, and it is
    very definitely not the sort of thing a beginner could come
    up with.

    It can occasionally be useful to test whether a term is ground,
    i.e. whether it contains any variables.  The obvious way to do
    it is	numbervars(Term,0,0)
    (if it isn't obvious, my explanation of numbervars is at fault).
    However, we can make the test in less time and less space by
    just working from the definnition: a term is ground if it
    doesn't contain any variables.

    numbervars and ground are typical of "meta-logical" predicates
    which examine terms as data-structures.  If variables were just
    another kind of constant (so that they didn't pattern match
    against the variables in our clauses), these predicates could
    be ordinary straight-forward logic, which is why we call them
    "meta-logical" (they are logic at the meta-level).  Like Lisp,
    Prolog puns the meta-level into the object level, which makes
    for a powerful programming language, but does horrible things to
    its elegance.  For example, meta-logical predicates cannot be
    type-checked.  Our current ideas about type-checking them are
    based on introducing an explicit meta-level, which gets
    "compiled" into object-level Prolog *after* type-checking.
*/

numbervars('$VAR'(M), M, N) :- !,
	succ(M, N).
numbervars(Atomic, M, M) :-
	atomic(Atomic), !.
numbervars(Term, M, N) :-
	functor(Term, _, Arity),
	$numbervars(0, Arity, Term, M, N).

$numbervars(A, A, _, N, N) :- !.
$numbervars(Am, Arity, Term, M, N) :-
	succ(Am, An),
	arg(An, Term, Arg),
	numbervars(Arg, M, K), !,
	$numbervars(An, Arity, Term, K, N).


ground(Term) :-
	var(Term), !,		/* non ground */
	fail.			/* so fail */
ground(Term) :-
	atomic(Term), !.	/* numbers and atoms are ground */

ground(Term) :-			/* compound terms are ground if */
	functor(Term, _, Arity),/* all their subterms are ground*/
	$ground(Arity, Term).

$ground(0, _) :- !.
$ground(N, Term) :-
	succ(M, N),
	arg(N, Term, ArgN),
	ground(ArgN), !,
	$ground(M, Term).


init            0           0     0     100400  12975     `
/*  File   : pl/init
    Author : Fernando Pereira + R.A.O'Keefe
    Updated: 20 November 1983
    Purpose: Initial boot file for building the Prolog system.
*/

                        %  Atoms that the code requires
'[]'.			%  this order has CHANGED
','.
'{}'.
< .
= .
> .
- .
; .			%  this atom has been ADDED
end_of_file.
true.
user.
$yes.
$no.
$live.
$break.

                         % Functors that the code requires
call(_).
','(_,_).
'{}'(_).
'.'(_,_).
':-'(_,_).
':-'(_).
$hidden_call(_).


                         % And now we start properly

%   Predicates are attached to evaluable predicates defined in the
%   code by one of two methods:
%
%	1) pred(....) :- N.
%	2)  :- $sysp(pred(....),N).
%
%   where N is an integer specifying the evaluable predicate;
%   N is the value of the switch label in "main.c".
%   The difference between these is that with the first method a
%   (local) frame will be built which will contain the arguments
%   to the procedure; whereas in the second case no frame is built.

                         % Set up the Operators

:-(op(P,T,A),105).

:-(op(1200, fx,[(:-), (?-)])).
:- op(1200,xfx,[(:-), (-->)]).
:- op(1100,xfy,(';')).
:- op(1050,xfy,('->')).
:- op(1000,xfy,(',')).
:- op( 900, fy,[\+, not, spy, nospy]).
:- op( 700,xfx,[=:=, =\=,  <,  >=,  >,  =<, is, =..]).
:- op( 700,xfx,[ ==, \==, @<, @>=, @>, @=<,  =,  \=]).
:- op( 500,yfx,[+, -, /\, \/]).
:- op( 500, fx,[+, -, \]).
:- op( 400,yfx,[*, /, //, <<, >>]).
:- op( 300,xfx,mod).
:- op( 200,xfy,'^').

                         % And now all the evaluable predicates

$sysp(F,N) :-		112.
$sysflgs(F,N) :-	113.

:- $sysp((A,B),		 1).
:- $sysp($hidden_call(P),2).
$user_call(_) :-	 3.		% same as call, but restores tracing
call(P) :-		 4.
:- $sysp(!,		 5).
repeat :-		 6.
:- $sysp(abort,		 7).
:- $sysp($call(_),	 8).
                         % Various hacky system predicates

:- $sysp(halt,		11).		%  exit Prolog
:- $sysp($break(_),	12).
:- $sysp($break_start,	13).
:- $sysp($break_end,	14).
:- $sysp($exit_break,	15).
$user_exec(_) :-	16.
:- $sysp($repply,	17).
fail :-			18.
true.

X = X.

X \= X :- !, fail.
X \= Y.

not(Goal) :- $user_call(Goal), !, fail.
not(Goal).

\+(Goal)  :- $user_call(Goal), !, fail.
\+(Goal).

once(Goal) :- call(Goal), !.
&(A,B) :- call(A), call(B).

(If -> Then; Else) :- !, $cond(If, Then, Else).

         $cond(If, Then, Else) :- $user_call(If), !, $user_call(Then).
         $cond(If, Then, Else) :- $user_call(Else).

(If -> Then) :- $user_call(If), !, $user_call(Then).

(A;B) :- $call(A).
(A;B) :- $call(B).

/*  The following three predicates are known to the system, but may be
    added to or retracted by the user.  So we have to tell "unknown" not
    to bother about them.  Predicate code 0 is of course NULL.
*/
:- $sysp(libdirectory(_),	0).
:- $sysp(portray(_),		0).
:- $sysp(term_expansion(_,_),	0).


/*----------------------------------------------------------------------+
|									|
|			ARITHMETIC					|
|									|
+----------------------------------------------------------------------*/

				% nullary operators

:- $sysflgs(cputime,	1).
:- $sysflgs(heapused,	2).
:- $sysflgs(stackused,	3).
:- $sysflgs(pi,		4).
:- $sysflgs(log2,	5).
				% unary operators ([_] is a special case)
:- $sysflgs(+(A),	1).	
:- $sysflgs(-(A),	2).
:- $sysflgs(\(A),	3).
:- $sysflgs(exp(A),	4).
:- $sysflgs(log(A),	5).
:- $sysflgs(log10(A),	6).
:- $sysflgs(sqrt(A),	7).
:- $sysflgs(sin(A),	8).
:- $sysflgs(cos(A),	9).
:- $sysflgs(tan(A),	10).
:- $sysflgs(asin(A),	11).
:- $sysflgs(acos(A),	12).
:- $sysflgs(atan(A),	13).
:- $sysflgs(floor(A),	14).
:- $sysflgs(float(A),	15).
				% binary operators
:- $sysflgs(A+B,	1).
:- $sysflgs(A-B,	2).
:- $sysflgs(A*B,	3).
:- $sysflgs(A/B,	4).
:- $sysflgs(A mod B,	5).
:- $sysflgs(A/\B,	6).
:- $sysflgs(A\/B,	7).
:- $sysflgs(A<<B,	8).
:- $sysflgs(A>>B,	9).
:- $sysflgs(A//B,	10).
:- $sysflgs(A^B,	11).

X =:= Y :-		20.	
X =\= Y :-		21.
X < Y :-		22.
X > Y :-		23.
X =< Y :-		24.
X >= Y :-		25.
succ(X,Y) :-		26.
is(X,Y) :-		27.
is(X,F,A) :-		28.
is(X,F,A,B) :-		29.
plus(X,Y,Z) :-	       117.

/*----------------------------------------------------------------------+
|									|
|			META-LOGICAL					|
|									|
+----------------------------------------------------------------------*/

var(X) :-		30.
nonvar(X) :-		31.
integer(X) :-		32.
number(X) :-		33.
primitive(X) :-		34.
db_reference(X) :-	35.
atomic(X) :-		36.
atom(X) :-		37.
$compare(Op,T1,T2,N) :-	19.		%  new hack
compare(Op,T1,T2) :-	39.
A == B :-		40.
A \== B :-		41.
A @< B :-		42.
A @> B :-		43.
A @=< B :-		44.
A @>= B :-		45.
name(X,L) :-		46.
functor(T,F,N) :-	47.
arg(N,T,A) :-		48.
X=..L :-		49.


/*----------------------------------------------------------------------+
|									|
|			DATA BASE					|
|	Note: C Prolog does not permit integers as data base keys.	|
|	Dec-10 Prolog does, and the lack is rather a nuisance.		|
|									|
+----------------------------------------------------------------------*/


assert(C) :-		50.
assertz(C) :-		50.
asserta(C) :-		51.
assert(C,R) :-		52.
assertz(C,R) :- 	52.
asserta(C,R) :- 	53.
$recordz(_,_,_) :-	54.
$recorda(_,_,_) :-	55.
$assertr(_) :- 		56.
instance(R,T) :-	57.
erase(R) :-		58.
erased(R) :-		59.
$clause(_,_,_):-	60.
$clause(_,_,_):-	61.
$recorded(_,_,_) :-	62.
$recorded(_,_,_) :-	63.
current_atom(A) :-			%  This new clause eliminates the
	nonvar(A), !,			%  need for a jump to "cut" in the
	atom(A).			%  C code.
current_atom(A) :-	64.
current_atom(A) :-	65.
$current_functor(A,N,K,M) :- 66.
$current_functor(A,N,K,M) :- 67.
abolish(F,N) :-		68.


$checkkey(Key) :-
	(   var(Key)
	|   primitive(Key)		%  integer/float/dbref
	),  !,
	$error('Invalid data base key', Key).
$checkkey(_).


clause(Head, Body) :-
	$checkkey(Head),
	$clause((Head:-Body), Ref, Head).

clause(Head, Body, Ref) :-
	var(Ref), !,
	$checkkey(Head),
	$clause((Head:-Body), Ref ,Head).
clause(Head, Body, Ref) :-
	instance(Ref, (Head:-Body)).


retract((Head :- Body)) :- !,
	$checkkey(Head),
	$clause((Head:-Body), Ref, Head),
	erase(Ref).
retract(Unit) :-
	$checkkey(Unit),
	$clause((Unit:-true), Ref, Unit),
	erase(Ref).


retractall(Head) :-			%  PDP-11 compatibility
	$checkkey(Head),
	$clause((Head:-_), Ref, Head),
	erase(Ref),
	fail.
retractall(_).


recorded(K,T,R) :- $checkkey(K), $recorded(T,R,K).
recorda(K,T,R)  :- $checkkey(K), $recorda(K,T,R).
recordz(K,T,R)  :- $checkkey(K), $recordz(K,T,R).
record(K,T,R)   :- $checkkey(K), $recordz(K,T,R).


current_functor(A,P) :-			%  NB: current_functor(1,1) succeeds!
	nonvar(P), !,
	functor(P,A,_).
current_functor(A,P) :-
        current_atom(A),
        $current_functor(A,N,0,0),
        functor(P,A,N).

current_predicate(A,P) :-
        current_atom(A),
        $current_functor(A,N,256,2'11100000),
        functor(P,A,N).


/*----------------------------------------------------------------------+
|									|
|			INPUT/OUTPUT					|
|									|
+----------------------------------------------------------------------*/

see(F) :-		70.
seeing(F) :-		71.
seeing(F,G) :-		72.
seeing(F,G) :-		98.
seen :-			73.
tell(F) :-		74.
append(F) :-		75.
telling(F) :-		76.
telling(F,G) :-		77.
telling(F,G) :-		99.
told :-			78.
close(F) :-		79.
ttyflush(F) :-		119.		%  an afterthought
ttyflush :- ttyflush(0).
read(T) :-		80.
read(T,V) :-		97.		%  an afterthought, drat it!
get0(C) :-		81.
get(C) :-		82.
skip(C) :-		83.
current_line_number(F,N) :- 120.
current_line_number(N) :-
	seeing(F),
	current_line_number(F, N).
display(T) :-		84.
write(T) :-		85.
writeq(T) :-		86.
nl :-			87.
put(C) :-		88.
tab(C) :-		89.
$prompt(_) :-		90.
exists(user) :- !.
exists(F) :-		91.
rename(Old,New) :-	92.
cd(_) :-		93.
sh :-			94.
system(S) :-		95.
shell(S) :-		95.		% PDP-11 compatibility
save(F,N) :-		96.
save(F) :- save(F,_).

fileerrors :-  		100.
nofileerrors :-		101.
'LC'  :-		102.
'NOLC' :-		103.
chtype(Char,Old,New) :- 104.
%op(P,T,O) :-		105.
$is_op(O,K,P,L,R) :-	 69.
prompt(_,_) :-		106.
trace :-		107.
$leash(P,N) :-		108.
$debug(P,N) :-		109.
$flags(F,P,N) :-	110.
$all_float(X,Y) :-	111.
%$sysp(F,P) :-		112.
%$sysflgs(F,N) :-	113.
$recons(_) :-		114.
$carith(Old,New) :-	115.
unknown(Old,New) :-	116.
statistics :-		118.

% Graphics predicates added by FDC
g_colour(C) :-		121.
g_offset(X,Y) :-	122.
g_enable(C) :-		123.
g_plot(X,Y) :-		124.
g_line(X1,Y1,X2,Y2) :-	125.
g_trapeze(X1,X2,Y1,X3,X4,Y2) :-		126.
g_triangle(X1,Y1,X2,Y2,X3,Y3) :-	127.
g_fill(X1,Y1,X2,Y2) :-	128.
g_clear :-		129.
g_mouse(X,Y,B) :-	130.

/*----------------------------------------------------------------------+
|									|
|			TOP LEVEL					|
|									|
+----------------------------------------------------------------------*/

$live :-			%  This is the Prolog session goal
	$cycle(question),	%  top level (interactive) loop
	halt.


$cycle(question):-
	prompt(Old, '|    '),
	repeat,
		$prompt('| ?- '),
		read(Question, Variables),
		$interpret(Question, question, Variables),
	!,
	prompt(_, Old).
$cycle(Status):-
	prompt(Old, '| '),
	repeat,
		read(Clause, Variables),
		$interpret(Clause, Status, Variables),
	!,
	prompt(_, Old).


$interpret(Clause, Status, Variables) :-
	var(Clause), !,
	$bind(Variables),
	$error('Clause is a variable', Clause).
$interpret(end_of_file, _, _) :- !.
$interpret(Clause, Status, Variables):-
	$directive(Clause, Status, Body, Type),
	!,
	prompt(Old, '|: '),
	$dogoal(Type, Body, Variables),
	prompt(_, Old),
	fail.
$interpret(Term, Status, Variables):-
	expand_term(Term, Expanded),
	$assertr(Expanded, Variables),
	!, fail.

$assertr(Clause, _) :-
	$assertr(Clause), !.
$assertr(Clause, Variables) :-
	$bind(Variables),
	$message('! clause: ', Clause).


%   $bind([N=V,...]) binds all the variables to their names, to give
%   slightly more attractive error messages.

$bind([Name=Name|Rest]) :- !,
	$bind(Rest).
$bind([]).


$directive(:-(X),    _, X, command ) :- !.
$directive(?-(X),    _, X, question) :- !.
$directive(X, question, X, question).

$dogoal(command, Command, Variables) :-
	$user_exec(Command), !.
$dogoal(command, Culprit, Variables) :- !,	%  should print the culprit
	$bind(Variables),
	$message('? ', Culprit).
$dogoal(question, Question, Variables) :-
	$user_exec(Question),
	telling(Old, user),
	($repply(Variables, Variables), tell(Old) ; tell(Old), fail),
	!.
$dogoal(question, _, _) :-
	telling(Old, user),
	nl, write(no), nl,
	tell(Old), !.


%   $repply/2 (and hence $repply/0) is only executed when output is
%   directed to 'user'.  If you do :- tell(foo), [baz], told.  the
%   questions will come out on user, which is fair enough, since the
%   prompt is just a single space and isn't all that obvious.

$repply([], []) :- !,
	nl, write(yes), nl.
$repply([], _) :- !,
	$repply,
	nl, write(yes), nl.
$repply([Name=Variable|Variables], _) :-
	nl, write(Name), write(' = '), write(Variable), !,
	$repply(Variables, yes).


%  consult and reconsult

consult(File):-
	$break($csult(0, File)).

reconsult(File) :-
	$break($csult(1, File)).

[File|Files] :- $conlist([File|Files]).

$conlist([]) :- !.
$conlist([File|Files]) :- !,
	$conlist(File),
	$conlist(Files).
$conlist(-File) :- !,
	reconsult(File).
$conlist(File) :-
	consult(File).

$csult(Flag, File) :-
	Heap0 is heapused,
	Time0 is cputime,
	$recons(Flag),
	$checkfile(File),
	$read_file(File, consult),
	is(Time, -, cputime,  Time0),
	is(Heap, -, heapused, Heap0),
	telling(Old, user),
	write(File), $csult(Flag),
	write(Heap), write(' bytes '),
	write(Time), write(' sec.'), nl,
	tell(Old),
	fail.
$csult(_, _) :-
	$exit_break.

$csult(0) :- !,
	write(' consulted ').
$csult(1) :- !,
	write(' reconsulted ').

$read_file(File, Status) :-
	seeing(Input, File),
	telling(Output),
	$cycle(Status),
	seen,
	see(Input),
	tell(Output),
	fail.
$read_file(_, _).

$checkfile(File) :-
	atom(File), exists(File), !.
$checkfile(File) :-
	atom(File), !,
	$error('Can''t read file', File).
$checkfile(File) :-
	$error('File name is not an atom', File).

% break

break :-
	$break($break).

$break :-
	$break_start,
	$read_file(user, question),
	$break_end, !,
	$exit_break.
$break :-
	$exit_break.    % just to make sure

all_float(X, Y) :-
	$all_float(X0, X0),
	$flag_code(X0, X),
	nonvar(Y),
	$flag_code(Y0,Y),
	$all_float(_,Y0).


expanded_exprs(X, Y) :-
	$carith(X0, X0),
	$flag_code(X0, X),
	nonvar(Y),
	$flag_code(Y0,Y),
	$carith(_,Y0).


$flag_code(1, on).
$flag_code(0,off).


%   expand_term(T0, T)
%   applies a sequence of transformations to T0 to produce T.
%   First the user's rules for term_expansion get a crack, then
%   the grammar-rule preprocessor has a go, and finally the
%   arithmetic expression "compiler" has a chance.

expand_term(T0, T) :-
	$user_call(term_expansion(T0, T1)), !,
	$expand_term(T1, T).		%  Bypass grammar rules
expand_term(T0, T) :-
	$translate_rule(T0, T1), !,
	$expand_term(T1, T).
expand_term(T0, T) :-
	$expand_term(T0, T).

$expand_term((H :- B0), (H :- B)) :-
	$compile_arith(B0, B), !.
$expand_term(T, T).

end_of_file.                     % needed here for a special reason...


lib             0           0     0     100400  1443      `
%   File   : pl/lib
%   Author : R.A.O'Keefe
%   Updated: 20 November 1983
%   Purpose: provide the PDP-11 Prolog lib(X) command.

/*  The point of this command is to make it easy for people to load files
    from a common library area.  It also lets you have multiple libraries.

	lib(File)

    reconsults a file, looking for it in each library until it is found.
    If it can't find the file in the library, it tries the file name as
    written.  If you want it to try other places, add your own clauses to

	libdirectory(D)

    which is a user-extensible table of places for the lib command to look.
    If the argument D contains a ? sign, the file name will replace that ?.
    Otherwise a / and the file name will be appended.

	lib(File, FileFound)

    looks for the file like lib/1, but tells you what file it found, and
    leaves it to you to decide what to do with it.
*/

lib([File|Files]) :- !,
	lib(File),
	lib(Files).
lib([]) :- !.
lib(File) :-
	lib(File, FileFound),
	!,
	reconsult(FileFound).
lib(File) :-
	reconsult(File).


lib(File, FileFound) :-
	$lib(File, F),
	libdirectory(Directory),
	$lib(Directory, D),
	$lib(D, F, T),
	name(FileFound, T),
	exists(FileFound), !.


$lib([C|S], [C|S]) :-
	integer(C), !.
$lib(Atomic, String) :-
	name(Atomic, String).


$lib([63|D], F, T) :-	!,	%   63 is "?"
	$append(F, D, T).
$lib([C|D], F, [C|T]) :-
	$lib(D, F, T).
$lib([], F, [58|F]).		%   58 is ":"


libdirectory(cplog).


listing         0           0     0     100400  6777      `
/*  File   : $Prolog/pl/listing
    Authors: Lawrence Byrd + Richard O'Keefe
    Updated: 20 November 1983
    Purpose: Assorted output routines defined in Prolog.

    The predicates defined are print/1, listing/0, and listing/1.
    New: portray_clause(Cl).

    The following magic numbers appear in put(N) calls:
    32 = " ", 40 = "(", 41 = ")", 44 = ",", 91 = "[", 93 = "]", 124 = "|".
    The priority of ',' is assumed to be 1000, which is true in this Prolog.

*/

%----------------------------------------------------------------------------%

%   print(Term)

%   write a Term to the current output, calling the user's portray/1
%   predicate at each step (except for tails of lists which have not
%   been matched in their entirety) to do any special formatting that
%   may be required, or reverting to 'write'-like behaviour if the
%   user doesn't want anything special done.  Ideally, this should be
%   integrated into the debugging system, but alas it is not.
%   It is debatable whether the top level priority should be 1200, as
%   here, or 1000, as elsewhere and earlier.  Input starts at 1200.
%   There are two special hacks for printing some sort of variable
%   names: $VAR(N) prints as <letter><digits>, and $VAR(Atom) prints
%   as Atom without any quotes, even for upper case.

print(Term) :-
	$print(Term, 1200).

%   Print a term taking surrounding operator priorities into account.

$print(Term, Priority) :-
	(   var(Term)			%  _N style of variables
	|   atomic(Term)		%  ordinary atoms & integers
	),  !,
	writeq(Term).			%  quotes around e.g. 'foo baz'
$print('$VAR'(N), Priority) :- !,	%  ex-variables
	$print_var(N).
$print(Term, Priority) :-		%  check for user-defined formatting
	$print(Term), !.
$print({Term}, Priority) :- !,
	put(123),			%  123 is "{"
	$print(Term, 1200),
	put(125).			%  125 is "}"
$print([Head|Tail], Priority) :- !,	%  list
	put(91),			%  91 is "["
	$print(Head, 1000), !,
	$print_tail(Tail).
$print(Term, Priority) :-		%  prefix operator
	functor(Term, Functor, 1),
	$is_op(Functor, 0, Op, _, Rp), !,
	$put_ch(Op, Priority, 40),	%  40 is "("
	$put_op(Functor, 1, 0),
	$print_arg(Rp, Term, 1),
	$put_ch(Op, Priority, 41).	%  41 is ")"
$print(Term, Priority) :-		%  postfix operator
	functor(Term, Functor, 1),
	$is_op(Functor, 2, Op, Lp, _), !,
	$put_ch(Op, Priority, 40),	%  40 is "("
	$print_arg(Lp, Term, 1),
	$put_op(Functor, 0, 1),
	$put_ch(Op, Priority, 41).	%  41 is ")".
$print(Term, Priority) :-		%  infix operator
	functor(Term, Functor, 2),
	$is_op(Functor, 1, Op, Lp, Rp), !,
	$put_ch(Op, Priority, 40),	%  40 is "("
	$print_arg(Lp, Term, 1),
	$put_op(Functor, 0, 0),
	$print_arg(Rp, Term, 2),
	$put_ch(Op, Priority, 41).	%  41 is ")"
$print(Term, Priority) :-
	functor(Term, Functor, N),
	writeq(Functor),
	$print(0, N, Term).


$print(Term) :-
	$print_arg(Term), !, fail.
$print(Term).


%   print_var(X) handles $VAR(X).

$print_var(N) :-
	integer(N), N >= 0, !,
	put("A"+N mod 26),
	(   N < 26
	|   M is N//26, write(N)
	), !.
$print_var(A) :-
	atom(A), !,
	write(A).
$print_var(X) :-
	writeq('$VAR'(X)).


$print_arg(Term) :-
	portray(Term), !, fail.
$print_arg(Term).


%   $print_arg(Priority, Term, ArgNo)

%   print the Argnoth argument of Term with the given Priority.

$print_arg(Priority, Term, ArgNo) :-
	arg(ArgNo, Term, Arg),
	$print(Arg, Priority).

%   $put_op(Op, LeftContext, RightContext)

%   display an operator symbol with spacing dependent on its left and
%   right contexts.  This should be done at the putatomq level, which
%   doesn't exist in this version of Prolog.

$put_op(',', _, _) :- !,
	write(', ').
$put_op(';', _, _) :- !,
	write('; ').
$put_op(Functor, L, R) :-
	$put_ch(1, L, 32),		%  32 is " "
	write(Functor),
	$put_ch(1, R, 32).		%  32 is " "

%   print the arguments of a term

$print(0, N, Term) :- !,
	put(40),			%  40 is "("
	$print_arg(1000, Term, 1), !,
	$print(1, N, Term).
$print(N, N, Term) :- !,
	put(41).			%  41 is ")"
$print(L, N, Term) :-
	succ(L, M),
	write(', '),
	$print_arg(1000, Term, M), !,
	$print(M, N, Term).


%   $put_ch(Priority, Context, Character)

%   print Character if the Priority exceeds that of its Context.

$put_ch(Priority, Context, Character) :-
	Priority > Context, !,
	put(Character).
$put_ch(_, _, _).


%   $print_tail(List)

%   Print the tail of a list, being careful not to instantiate a
%   possible variable at the (current) end of the list.

$print_tail(List) :-
	nonvar(List), List = [Head|Tail], !,
	put(44),			%  44 is ","
	$print(Head, 1000), !,
	$print_tail(Tail).
$print_tail(Tail) :-
	Tail \== [],
	put(124),			%  124 is "|"
	$print(Tail, 1000), !,
	$print_tail([]).
$print_tail([]) :-
	put(93).			%  93 is "]"


%----------------------------------------------------------------------------%


%   listing

%   calls listing(Pred) for each current_predicate Pred.

listing :-
	current_predicate(_,Pred),
	nl,
	$list_clauses(Pred).
listing.


%   listing(PredSpecs)

%   Takes a predicate specifier F/N, a partial specifier F, or a
%   list of such things, and lists each current_predicate Pred
%   matching one of these specifications.

listing(V) :-
	var(V), !.       % ignore variables
listing([]) :- !.
listing([X|Rest]) :- !,
        listing(X),
        listing(Rest).
listing(X) :-
        $functorspec(X,Name,Arity),
        current_predicate(Name,Pred),
        functor(Pred,Name,Arity),
	nl,
        $list_clauses(Pred).
listing(_).


$list_clauses(Pred) :-
	clause(Pred, Body),
	portray_clause((Pred:-Body)),
	fail.


portray_clause((Pred:-Body)) :- 
	numbervars(Pred+Body, 0, _),
	print(Pred),
	$list_clauses(Body, 0, 2, 8), !.
portray_clause((Pred)) :-
	portray_clause((Pred:-true)).


$list_clauses((A,B), L, R, D) :- !,
	$list_clauses(A, L, 1, D), !,
	$list_clauses(B, 1, R, D).
$list_clauses(true, L, 2, D) :- !,
	put(46), nl.			%  46 is "."
$list_clauses((A;B), L, R, D) :- !,
	$list_magic(fail, L, D),
	$list_magic((A;B), 0, 2, D),
	$list_magic(R, '.
').
$list_clauses((A->B), L, R, D) :- !,
	$list_clauses(A, L, 5, D), !,
	$list_clauses(B, 5, R, D).
$list_clauses(Goal, L, R, D) :-
	$list_magic(Goal, L, D),
	print(Goal),
	$list_magic(R, '.
').

$list_magic(!,    0, D) :- !, 
	write(' :- ').
$list_magic(!,    1, D) :- !,
	write(',  ').
$list_magic(Goal, 0, D) :- !,
	write(' :- '),
	nl, tab(D).
$list_magic(Goal, 1, D) :- !,
	put(44),			%  44 is ","
	nl, tab(D).
$list_magic(Goal, 3, D) :- !,
	write('(   ').
$list_magic(Goal, 4, D) :- !,
	write('|   ').
$list_magic(Goal, 5, D) :- !,
	write(' ->'),
	nl, tab(D).

$list_magic(2, C) :- !, write(C).
$list_magic(_, _).

$list_magic((A;B), L, R, D) :- !,
	$list_magic(A, L, 1, D), !,
	$list_magic(B, 1, R, D).
$list_magic(Conj,  L, R, D) :-
	plus(D, 8, E),
	plus(L, 3, M),
	$list_clauses(Conj, M, 1, E),
	nl, tab(D),
	$list_magic(R, ')').



ops             0           0     0     100400  1584      `
%   File   : pl/ops
%   Author : Richard A. O'Keefe
%   Updated: 8 October 1983
%   Purpose: define current_op/3 and is_op/5.

%   current_op(Priority, Type, Operator)

%   succeeds when there is a current definition of Symbol as an operator
%   of type Type and priority Priority.  It may be used to check a given
%   operator or to enumerate them (slowly).

current_op(Priority, Type, Operator) :-
	var(Operator), !,
	current_atom(Operator),
	current_op(Priority, Type, Operator).
current_op(Priority, Type, Operator) :-
	atom(Operator),
	$op(Type, Num),		%  map names to codes 0, 1, 2
	$is_op(Operator, Num, Priority, Left, Right),
	$op(Type, Priority, Left, Right).

$op( fx,  0).	$op( fx, O, _, P) :- succ(P, O).
$op( fy,  0).	$op( fy, O, _, O).
$op(xf,   2).	$op(xf,  O, P, _) :- succ(P, O).
$op(yf,   2).	$op(yf,  O, O, _).
$op(xfy,  1).	$op(xfy, O, P, O) :- succ(P, O).
$op(xfx,  1).	$op(xfx, O, P, P) :- succ(P, O).
$op(yfx,  1).	$op(yfx, O, O, P) :- succ(P, O).


%   is_op(Operator, Fixity, Priority, Left, Right)

%   is true when Operator is currently defined as a prefix/infix/postfix
%   operator {Fixity = fx/xfx/xf} of priority Priority, whose left/right
%   arguments have priorities Left/Right (arbitrary if there is no such
%   argument).  


is_op(Operator, Type, Priority, Left, Right) :-
	var(Operator), !,
	current_atom(Operator),
	is_op(Operator, Type, Priority, Left, Right).
is_op(Operator, Type, Priority, Left, Right) :-
	atom(Operator),
	$is_op(Type, Num),
	$is_op(Operator, Num, Priority, Left, Right).

$is_op( fx, 0).
$is_op(xfx, 1).
$is_op(xf,  2).

protect         0           0     0     100400  1735      `
/* protect : Setting the flags for the system predicates

						Fernando Pereira
						Updated: 17 September 83
*/


$mem(X, [X|_]).
$mem(X, [_|Rest]) :-
	$mem(X, Rest).

$unprotected(term_expansion, 2).
$unprotected(libdirectory, 1).

% Predicate flags used here:
%
%	
%	128 (PROTECTED)
%	 64 (INVISIBLE)
%	 32 (UNTRACEABLE)


%  Cut must be transparent due to the way it is currently
%  implemented (this fixes bug that prevented tracing
%  past cuts).
%  Note that transparent also seem to imply untraceable,
%  which means you don't see cuts at all.

:- $sysflgs(!, 64).


			% This list are all transparent and untraceable.

:-((
	$mem(Pred, [call(_), (_,_), (_;_), $call(_), $hidden_call(_)]),
	$sysflgs(Pred, 96),
	fail
    ;
			% ALL predicates whose names start with a dollar sign
			%  are made untraceable.
	current_atom(Atom),
	name(Atom, [36|_]),
	$current_functor(Atom, Arity, 256, 0),
	functor(Pred, Atom, Arity),
	$flags(Pred, Flags, Flags\/32),
	fail
    ;
			% The following predicates are better off invisible so
 			%  they are made untraceable as well.
	$mem(Pred, [write(_), writeq(_), get0(_), skip(_), put(_), nl, 
		    tab(_), display(_), print(_), listing, listing(_)]),
	$sysflgs(Pred, 32),
	fail
    ;
			% And now - ALL current predicates but those specified
			%  by $unprotected are turned into
			%  system predicates (which cannot be redefined, seen
			%  by listing etc).
	current_atom(Atom),
	$current_functor(Atom, Arity, 256, 0),
	\+ $unprotected(Atom, Arity),
	functor(Pred, Atom, Arity),
	$flags(Pred, Flags, Flags\/128),
	fail
    ;
			% Finally, stop treating $ as a lower-case letter.
			%  Instead, treat it like a cross-hatch
	chtype("#", Symbol, Symbol),
	chtype("$", Letter, Symbol)
)).


samsort         0           0     0     100400  1116      `
samsort([], []) :- !.
samsort(List, Sort) :-
	samsort(List, [], 0, Sort).

samsort([], Stack, R, Ans) :- !,
	fuse(Stack, 0, [Ans]).
samsort(List, Stack, R, Ans) :-
	run_up(List, Run, Rest),
	S is R+1,
	fuse([Run|Stack], S, NewStack), !,
	samsort(Rest, NewStack, S, Ans).

run_up([Head,HdTl|Tail], [Head|More], Rest) :-
	Head =< HdTl, !,
	run_up([HdTl|Tail], More, Rest).
run_up([Head|Tail], [Head], Tail).

fuse([A,B|Rest], K, Ans) :-
	0 is K mod 2, !,
	J is K / 2,
	merge(A, B, C), !,
	fuse([C|Rest], J, Ans).
fuse(Stack, _, Stack).


merge(A, [], A) :- !.
merge([], B, B) :- !.
merge([A|R], [B|S], [B|T]) :-
	A > B, !,
	merge([A|R], S, T).
merge([A|R], B, [A|T]) :-
	merge(R, B, T).

run([Head|Tail], Run, Rest) :-
	Queue = [Head|_], !,
	run(Tail, Queue, Queue, Run, Rest).

	run([Head|Tail], QH, QT, Run, Rest) :- !,
		run(QH, QT, Head, Tail, Run, Rest).
	run([], Run, [_], Run, []).

		run([Ah|At], Qt, H, T, Run, Rest) :-
			H < Ah, !,
			run(T, [H,Ah|At], Qt, Run, Rest).
		run(Qh, [Qt], H, T, Qh, [H|T]) :-
			H < Qt, !.
		run(Qh, [_|Qt], H, T, Run, Rest) :-
			Qt = [H|Nt], !,
			run(T, Qh, Qt, Run, Rest).

setof           0           0     0     100400  3147      `
%   File   : pl/setof
%   Author : David Warren, Fernando Pereira, R.A.O'Keefe
%   Updated: 16 November 1983
%   Purpose: define setof/3, bagof/3, findall/3, and findall/4
%   Needs  : pl/sort, and has to be in the base load.

%   16Nov83: split into setof and sort.  Top level of setof
%	   : rewritten, introducing findall, and $bag bug fixed.

%   The "existential quantifier" symbol is only significant to bagof
%   and setof, which it stops binding the quantified variable.
%   op(200, xfy, ^) is defined in the bootstrap file.

Variable^Goal :-
	call(Goal).


%   findall/3 is a simplified version of bagof which has an implicit
%   existential quantifier on every variable.

findall(Template, Generator, Answers) :-
	recorda($, $, Ref),
	$findall(Template, Generator, Ref, [], Answers).


findall(Template, Generator, SoFar, Answers) :-
	recorda($, $, Ref),
	$findall(Template, Generator, Ref, SoFar, Answers).


$findall(Template, Generator, _, _, _) :-
	$user_call(Generator),
	recorda($, Template, _),
	fail.
$findall(_, _, Ref, SoFar, Answers) :-
	$findall(Ref, SoFar, Answers).

$findall(Ref, SoFar, Answers) :-
	recorded($, Term, Tref),
	!,
	erase(Tref),
	(   Tref == Ref, !, Answers = SoFar
	;   $findall(Ref, [Term|SoFar], Answers)
	).



setof(Template, Generator, Set) :-
	bagof(Template, Generator, Bag),
	sort(Bag, Set0),
	Set = Set0.


bagof(Template, Generator, Bag) :-
	$excess_vars(Generator, Template, [], FreeVars),
	FreeVars \== [],
	!,
	Key =.. [$|FreeVars],
	recorda($, $, Ref),
	$findall(Key-Template, Generator, Ref, [], Bags0),
	keysort(Bags0, Bags),
	$pick(Bags, Key, Bag).
bagof(Template, Generator, Bag) :-
	recorda($, $, Ref),
	$findall(Template, Generator, Ref, [], Bag0),
	Bag0 \== [],
	Bag = Bag0.



$pick(Bags, Key, Bag) :-
	Bags \== [],
	$parade(Bags, Key1, Bag1, Bags1),
	$decide(Key1, Bag1, Bags1, Key, Bag).

$parade([K-X|L1], K, [X|B], L) :- !,
	$parade(L1, K, B, L).
$parade(L, K, [], L).

$decide(Key, Bag, Bags, Key, Bag) :-
	(   Bags = [], !
	;   true
	).
$decide(_, _, Bags, Key, Bag) :-
	$pick(Bags, Key, Bag).


$excess_vars(T, X, L0, L) :-
	var(T),
	!,
	(   $no_occurrence(T, X), !, $introduce(T, L0, L)
	;   L = L0
	).
$excess_vars(X^P, Y, L0, L) :- !,
	$excess_vars(P, (X,Y), L0, L).
$excess_vars(setof(X,P,S), Y, L0, L) :- !,
	$excess_vars((P,S), (X,Y), L0, L).
$excess_vars(bagof(X,P,S), Y, L0, L) :- !,
	$excess_vars((P,S), (X,Y), L0, L).
$excess_vars(T, X, L0, L) :-
	functor(T, _, N),
	$rem_excess_vars(N, T, X, L0, L).

$rem_excess_vars(0, _, _, L, L) :- !.
$rem_excess_vars(N, T, X, L0, L) :-
	succ(M, N),
	arg(N, T, T1),
	$excess_vars(T1, X, L0, L1),
	$rem_excess_vars(M, T, X, L1, L).

$introduce(X, L, L) :-
	$included(X, L), !.
$introduce(X, L, [X|L]).

$included(X, L) :-
	$doesnt_include(L, X),
	!, fail.
$included(X, L).

$doesnt_include([], X).
$doesnt_include([Y|L], X) :-
	Y \== X,
	$doesnt_include(L, X).

$no_occurrence(X, Term) :-
	$contains(Term, X),
	!, fail.
$no_occurrence(X, Term).

$contains(T, X) :-
	var(T), !,
	T == X.
$contains(T, X) :-
	functor(T, _, N),
	$upto(N, I),
	arg(I, T, T1),
	$contains(T1, X).

$upto(N, N).
$upto(N, I) :-
	succ(M, N),
	$upto(M, I).


sort            0           0     0     100400  3847      `
%   File   : pl/sort
%   Authors: David Warren, Fernando Pereira, R.A.O'Keefe
%   Updated: 20 November 1983
%   Purpose: sorting routines.

%   Defines: keysort/2, length/2, merge/3, msort/2, sort/2.

/*  The three sorting routines are all variations of merge-sort, done by
    bisecting the list, sorting the nearly equal halves, and merging the
    results.   The half-lists aren't actually constructed, the number of
    elements is counted instead (which is why 'length' is in this file).
    The Dec-10 version doesn't have msort built in (it can be found in a
    library file -- ordsets), but it is a very convenient thing to have.
    The Dec-10 version of this file had a lot of calls to $comprise, the
    point of that was that by using mode declarations the compiler could
    put more variables on the local stack instead of the global stack. I
    have removed these in favour of clarity.  In the interests of space&
    time saving I have replaced some of the arithmetic by plus and succ.
    Those predicates are not available in Dec-10 Prolog, but are quite a
    saving in C-Prolog.  Also in the interests of space saving, $compare
    has been given a 4th argument to say which component to compare.  It
    will compare Kel=Val as happily as it will  compare  Key-Val.   Most
    significantly,  it  makes  a  space  saving  of 12% in sort, a space
    saving of 18% in keysort, and a time saving of 10% in keysort.   The
    time to sort 200 elements is sort: 7.1 sec, keysort: 6.2 sec, and my
    new msort: 5.0 sec.  A rough figure is 4msec * N * lg(N).
*/

%   length of a list.

length([], 0) :- !.
length([_|L], N) :-
	length(L, M),
	succ(M, N).



%   sort(Random, Ordered)
%   do a merge sort on Random, eliminating duplicates.

sort(L, R) :-
	length(L, N),
	$sort(N, L, _, R1),
	R = R1.

$sort(2, [X1,X2|L], L, R) :- !,
	compare(Delta, X1, X2),
	(   Delta = (<), !, R = [X1,X2]
	;   Delta = (>), !, R = [X2,X1]
	; /*Delta = (=) */  R = [X2]
	).
$sort(1, [X|L], L, [X]) :- !.
$sort(0, L, L, []) :- !.
$sort(N, L1, L3, R) :-
	is(N1, //, N, 2),
	plus(N1, N2, N),
	$sort(N1, L1, L2, R1),
	$sort(N2, L2, L3, R2),
	$merge(R1, R2, R).

$merge([], R, R) :- !.
$merge(R, [], R) :- !.
$merge(R1, R2, [X|R]) :-
	$compare(Delta, R1, R2, 1),
	(   Delta = (<), !, R1 = [X|R1a], $merge(R1a, R2, R)
	;   Delta = (>), !, R2 = [X|R2a], $merge(R1, R2a, R)
	;   /* = */ R1 = [X|R1a], R2 = [_|R2a], $merge(R1a, R2a, R)
	).


%   msort(Random, Ordered)
%   sorts a random list and does not remove duplicates.

msort(L, R) :-
	length(L, N),
	$msort(N, L, _, R1),
	R = R1.

$msort(2, [X1,X2|L], L, R) :- !,
	compare(Delta, X1, X2),
	(   Delta = (>), !, R = [X2,X1]
	; /*Delta/= (>)*/   R = [X1,X2]
	).
$msort(1, [X|L], L, [X]) :- !.
$msort(0, L, L, []) :- !.
$msort(N, L1, L3, R) :-
	is(N1, //, N, 2),
	plus(N1, N2, N),
	$msort(N1, L1, L2, R1),
	$msort(N2, L2, L3, R2),
	merge(R1, R2, R).

merge([], R, R) :- !.
merge(R, [], R) :- !.
merge(R1, R2, [X|R]) :-
	$compare(Delta, R1, R2, 1),
	(   Delta = (>), R2 = [X|L], merge(R1, L, R)
	;   /* = or < */ R1 = [X|L], merge(L, R2, R)
	).


%   keysort(Random, Ordered)
%   sorts a random list of Key-Value pairs, and does not remove duplicates.

keysort(L, R) :-
	length(L, N),
	$keysort(N, L, _, R1),
	R = R1.

$keysort(2, [X1,X2|L], L, R) :- !,
	$compare(Delta, X1, X2, 1),
	(   Delta = (>), !, R = [X2,X1]
	; /*Delta/= (>)*/   R = [X1,X2]
	).
$keysort(1, [X|L], L, [X]) :- !.
$keysort(0, L, L, []) :- !.
$keysort(N, L1, L3, R) :-
	is(N1, //, N, 2),
	plus(N1, N2, N),
	$keysort(N1, L1, L2, R1),
	$keysort(N2, L2, L3, R2),
	$keymerge(R1, R2, R).

$keymerge([], R, R) :- !.
$keymerge(R, [], R) :- !.
$keymerge(R1, R2, [X|R]) :-
	R1 = [X1|R1a],
	R2 = [X2|R2a],
	$compare(Delta, X1, X2, 1),
	(   Delta = (>), !, X = X2, $keymerge(R1, R2a, R)
	; /*Delta\= (>)*/   X = X1, $keymerge(R1a, R2, R)
	).



tracing         0           0     0     100400  4121      `
/*  File   : pl/tracing
    Author : Lawrence Byrd? + Richard O'Keefe
    Updated: 17 September 83, 1983, 8:00:07 pm
    Purpose: interface to tracing flags

    Note: this file is NOT responsible for producing tracing output.
    That is in main.c, which must also agree with this file on which
    bits mean what.
*/

debug :-
	$debug(P, 1),
	(   P = 1, $message('Debug mode already ', on)
	|   P = 0, $message('Debug mode switched ', on)
	),  !.

nodebug :-
	$debug(P, 0),
	(   P = 0, $message('Debug mode already ', off)
	|   P = 1,
	    (	$someleft, $allspyremove,
		$message('All spy-points ', removed)
	    |   true
	    ),
	    $message('Debug mode switched ', off)
	),  !.


spy(X) :-
	$spy(X, on),
	$someleft,
	debug,
	fail.
spy(_).

nospy(X) :-
	$spy(X, off),
	fail.
nospy(_).


leash(Old, New) :-
	$leash(X, X),
	$leashcode(X, Old),
	leash(New).

leash(X) :-
	nonvar(X),
	$leashcode(X, N),
	$leash(P, N), !,
	telling(Old, user),
	$prleash(N),
	tell(Old), !.
leash(X) :-
	$error('Invalid leash specification', leash(X)).

$leashcode(full, 2'1111) :- !.
$leashcode(on,   2'1111):- !.
$leashcode(half, 2'1010) :- !.
$leashcode(loose,2'1000) :- !.
$leashcode(off,  2'0000) :- !.
$leashcode(N,    N) :-
	integer(N), N >= 0, N =< 2'1111, !.


$prleash(N) :-
	$leashcode(Code, N),
	write('Leashing set to '), write(Code), !,
	$prleash([call,exit,back,fail], 8, N, no).

$prleash([_|Codes], Mask, Bits, Seen) :-
	0 is Mask /\ Bits, Next is Mask >> 1, !,
	$prleash(Codes, Next, Bits, Seen).
$prleash([Code|Codes], Mask, Bits, Seen) :-
	Next is Mask >> 1,
	$prleash(Seen, ', ', ' ('), write(Code), !,
	$prleash(Codes, Next, Bits, yes).
$prleash([], _, _, Seen) :-
	$prleash(Seen, ').', '.'), nl.

$prleash(yes, Yes, _) :- !,	write(Yes).
$prleash(no,  _,  No) :- !,	write(No).


debugging :-
	$debug(D, D),
	(   D = 0, !,
		$message('Debug mode is ', off)
	|   D = 1, !,
		$message('Debug mode is ', on),
	    (	$someleft, !,
		    telling(Old, user),
		    write('Spy-points set on : '), nl,
		    (	current_atom(Functor),
			$current_functor(Functor,Arity,2'100010000,2'11110000),
			tab(8), write(Functor/Arity), nl, fail
		    |   tell(Old)
		    )
	    |	$message('There are no spy-points ', set)
	    ),
	    $leash(L, L),
	    $prleash(L)
	),  !.

$spy(V, _) :-
	var(V), !,
	$error('Invalid procedure specification', spy(X)).
$spy([], _) :- !.
$spy([Head|Tail], Flag):- !,
	$spy(Head, Flag),
	$spy(Tail, Flag).
$spy(X, off) :-
	$functorspec(X,Functor,Arity),
	(   var(Arity)
	|   A = Arity
	),
	(   $current_functor(Functor,A,2'100010000,2'11110000), !,
	    (   $current_functor(Functor,Arity,2'100010000,2'11110000),
		functor(T,Functor,Arity),
		$flags(T,P,P/\2'11101111),
		$message('Removed spy-point on ', Functor/Arity),
		fail
	    |	true
	    )
	|   $message('There is no spy-point on ', X)
	),  !.

$spy(X,on) :-
	$functorspec(X,Functor,Arity),
	(   atom(X),
	    (	$current_functor(Functor,Arity,2'100000000,2'11110000),
		functor(Head,Functor,Arity),
		$enter(Head,Functor,Arity),
		fail
	    |	$current_functor(Functor,_,2'100000000,2'11100000)
	    |	$message('You have no clauses for ', X)
	    )
	|   functor(Head,Functor,Arity),
	    (	$current_functor(Functor,Arity,256,2'111100000)
	    |	$message('You have no clauses for ', Functor/Arity)
	    ),
	    $enter(Head,Functor,Arity)
	),  !.

$spy(_,_).


$enter(Head,Functor,Arity) :-
	(   $current_functor(Functor,Arity,2'100010000,2'11110000),
		Message = 'There already is a spy-point on '
	|   $flags(Head,P,P),
		(   P/\2'11100000 =:= 0, $flags(Head,P,P\/2'10000)
		|   true
		),
		Message = 'Spy-point placed on '
	),  !,
	$message(Message, Functor/Arity).

$someleft :-
	current_atom(A),
	$current_functor(A,_,2'10000,2'10000), !.

$allspyremove :-
	current_atom(F),
	$current_functor(F,A,2'100010000,2'11110000),
	functor(T,F,A),
	$flags(T,P,P/\2'11101111),
	fail.
$allspyremove.

$functorspec(V,_,_) :-
	var(V), !,
	$error('Invalid procedure specification', functor(V)).
$functorspec(X,X,_) :-
	atom(X), !.
$functorspec(F/N,F,N) :-
	atom(F), integer(N), !.
$functorspec(X,_,_) :-
	$error('Invalid procedure specification', functor(X)).


tty             0           0     0     100400  1247      `
/*  File   : pl/tty
    Author : R.A.O'Keefe
    Updated: 17 September 83, 1983
    Purpose: define the tty* predicates for Dec-10 compatability
		NB: display does NOT switch to the terminal!

    A particularly nasty thing to watch out for here is that we
    can't afford to fail between the time we switch to 'user' and
    the time we switch back.  Hence the 'is's.  I had put these
    predicates in Prolog before Fernando put them into his C version.
    I have left them in Prolog because they are almost never used.
    Any time they are used, the dominant cost is likely to be I/O.

    ttyflush used to be here.  It is now in C so that people can send
    control sequences to /dev/tty without fear of line folding, but
    can then force the buffered output out.  As a hack, ttyflush(X)
    is equivalent to fflush(X) in C for any output file X.
*/

ttytab(Spaces) :-
	N is Spaces, telling(Old, user), tab(N), tell(Old).

ttyput(Char) :-
	C is Char, telling(Old, user), put(C), tell(Old).

ttynl :-
	telling(Old, user), nl, tell(Old).

ttyget0(Char) :-
	seeing(Old, user), get0(C), see(Old), Char = C.

ttyget(Char) :-
	seeing(Old, user), get(C), see(Old), Char = C.

ttyskip(Char) :-
	C is Char, seeing(Old, user), skip(C), see(Old).


unify           0           0     0     100400  1837      `
/*  File: Unify.Pl	Author: R.A.O'Keefe	Updated: 17 September 83

    This file exports two predicates:
		unify(X, Y)
		occurs_check(X, Y).
    unify(X, Y) is true when the two Prolog terms X and Y can be
    unified, using genuine unification with the occurs check, and is
    guaranteed to do the same bindings as X = Y when it succeeds. If
    you are doing theorem proving or type checking with Prolog, what
    you need is genuine unification, not Prolog's pattern match.  As
    it might be useful, occurs_check(X, Y) fails when X occurs in Y.
    It only works when X is a Prolog variable, but does not check.

    The mode declarations for these predicate may seem surprising. A
    quirk(?) of the mode system is that mode + does permit variables
    to be passed in, provided they are not matched in any clause head.

    No other utilities are needed.

    Adapted to VAX on Wednesday March 16th, 1983, 11:22:59 pm

:- public
	occurs_check/2,		%   var x term ->
	unify/2.		%   term x term ->

:- mode
	occurs_check(+,+),	%   first arg is a variable
	occurs_check(+,+,+),
	unify(+,+),
	unify(+,+,+).
*/


unify(X, Y) :-
	var(X), var(Y), !,
	X = Y.			%  want unify(X,X) which fails occurs_check
unify(X, Y) :-
	var(X), !,
	occurs_check(X, Y),
	X = Y.
unify(X, Y) :-
	var(Y), !,
	occurs_check(Y, X),
	X = Y.
unify(X, Y) :-
	atomic(X), !,
	X = Y.
unify(X, Y) :-
	functor(X, F, N),
	functor(Y, F, N),
	unify(N, X, Y).

	unify(0, X, Y) :- !.
	unify(N, X, Y) :-
		succ(M, N),
		arg(N, X, Xn),
		arg(N, Y, Yn),
		unify(Xn, Yn), !,
		unify(M, X, Y).

occurs_check(X, Y) :-
	var(Y), !,
	X \== Y.
occurs_check(X, Y) :-
	atomic(Y), !.
occurs_check(X, Y) :-
	functor(Y, _, N),
	occurs_check(N, X, Y).

	occurs_check(0, _, _) :- !.
	occurs_check(N, X, Y) :-
		succ(M, N),
		arg(N, Y, Yn),
		occurs_check(X, Yn), !,
		occurs_check(M, X, Y).


visible         0           0     0     100400  1063      `
/* VISIBLE : Make normally hidden system predicates visible again

						Lawrence
						Updated: 16 January 82
*/


			% ALL predicates whose names start with a dollar sign
			%  are made untracable (original state).

invisible :-
     ( current_atom(A), name(A,[36|_]), $current_functor(A,Arity,256,0),
       functor(Pred,A,Arity), $flags(Pred,Flags,Flags\/32), fail  ;  true ).


			% ALL predicates whose names start with a dollar sign
			%  are made tracable again.

visible :-
     ( current_atom(A), name(A,[36|_]), $current_functor(A,Arity,256,0),
       functor(Pred,A,Arity), $flags(Pred,Flags,Flags/\2'10011111), fail  ;  true ).


			% Unlock all the system predicates

unlock :-
     ( current_atom(A), $current_functor(A,Arity,128,128),
       functor(Pred,A,Arity), $flags(Pred,Flags,Flags/\2'01111111),
       asserta(unlocked_system_predicate(Pred)), fail
         ;  true ).


			% Lock the system predicates back up again

lock :-
     ( retract(unlocked_system_predicate(Pred)),
       $flags(Pred,Flags,Flags\/128), fail
         ;  true ).