!<arch>
READ-ME         453460337   10    0     100644  1261      `
The files in this directory are mostly Prolog sources for parts of
C-Prolog.  Here is what they all mean.

	all		- list of all the files actually used by C-Prolog
			- consulting [all] builds C-Prolog.
	arith		- preprocessor for arithmetic expressions.
			- saves global stack space at the price of time.
	debug		- a Prolog-in-Prolog debugger.
	error		- print error messages
	flag		- NOT YET USED
	grammar		- DCG translator (see also lib(dcsgs)).
	ground		- numbervars/3 and ground/1
	init		- the initialisation file, sine qua non
	interp		- A tracer written in Prolog, it is going to be
			- turned into a Dec-10-like debugger.
	lib		- lib/1, lib/2, note_lib/1, for getting at the library
	listing		- print/1, listing/0, listing/1, portray_clause/1
	ops		- current_op/3 and is_op/5
	protect		- locks up all the predicates users shouldn't get at
	samsort		- NOT USED, a new sorting method (see sort)
	setof		- findall/3, findall/4, setof/3, bagof/3
	sort		- sort/2, keysort/2, msort/2, merge/3, length/2
	tracing		- setting spypoints and so on
	tty		- tty{get,get0,skip,put,nl,tab}/1
	unify		- unify/2, occurs_check/2
	visible		- NOT FOR GENERAL USE, this is for debugging the system
			- (it hasn't been needed in a long while)
	vmsall		- VMS version of 'all'

all             453411804   10    0     100644  698       `
%   File   : pl/all
%   Author : Fernando Pereira
%   Updated: 20 February 1984
%   Purpose: Load all the current bits of the standard Prolog system.

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

:- [
	'pl/protect'			%  Lock things up
].

arith           455049010   10    0     100644  3349      `
%   File   : pl/arith
%   Author : Fernando Pereira
%   Updated: 2 June 84
%   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.
	!,
	$expand_expr(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),
	$expand_expr(E, P, U),
	$expand_expr(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_expr(V, true, V) :-
	var(V), !.
$expand_expr([T], P, V) :- !,
	$expand_expr(T, P, V).
$expand_expr(A, true, A) :-
	atomic(A), !.
$expand_expr(T, P, V) :-
	$unaryop(T, O, A), !,
	$expand_expr(A, Q, X),
	$expand_expr(V, O, X, Q, P).
$expand_expr(T, P, V) :-
	$binaryop(T, O, A, B), !,
	$expand_expr(A, Q, X),
	$expand_expr(B, R, Y),
	$expand_expr(V, O, X, Y, Q, S),
	$and(R, S, P).

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

$expand_expr(Z, O, X, Y, Q, Q) :-
	number(X), number(Y), !,
	is(Z, O, X, Y).
$expand_expr(Z, O, X, Y, Q, P) :-
	$and(Q, is(Z,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).


debug           453413331   10    0     100644  8791      `
%   File   : pl/debug
%   Author : R.A.O'Keefe.
%   Updated: Friday March 9th, 1984, 0:40:51 am
%   Purpose: A Dec-10-like Prolog debugger in C-Prolog.

/*  Note:
    The '$SET$' primitive is for this program and this program ALONE!
    The 'f', 'r', and ';' commands are not understood yet.
    This is a space hog.  Expect a factor of 20!
    This file uses C-Prolog's own spypoint and leashing flags.
*/
/*  The debugger has to maintain a list of goals, for the sake of
	Print <n> goals
	Write <n> goals
	Display <n> goals
	Goals <n>
    It also has to keep track of the invocation number, which could
    be passed as an argument, but might as well be in the goal stack
    (this will simplify retry goal <n> and fail goal <n> and redo
    goal <n> when they are implemented).  If we are going to do that,
    we might as well keep the depth in the goal stack as well.  And
    we shall need some flags.  So the goal stack is a list of
	goal(Goal,InvokNo,Depth,Flags)
    records (we shall smash the flags with $SET$).  The invocation
    counter is a global counter maintained by
	invocount(NewValue)
    or	invocount(Next)
    This is hopelessly procedural, but so what.
    db_mode is another global variable with 5 values:
	0 : we are creeping
	1 : we are leaping
	2 : we are skipping
	3 : we are quasi-skipping
	4 : we are doing 'X'
    calling db_mode(X) with X bound sets the variable to X, with
    X unbound it returns the current value.
*/

db_mode(Value) :-
	(   nonvar(Value) ; Old = Value   ), !,
	'$SET$'(1, db_mode(0), Old, Value).


invocount(Value) :-
	Counter = invocount(0),
	(   nonvar(Value), '$SET$'(1, Counter, _, Value)
	;   '$SET$'(1, Counter, Value, Value+1)
	),  !.


debug(Goal) :-
	invocount(2),
	F = 0,					% beware of $SET$ !!
	db_goal(goal(Goal,1,1,F), []).


db_goal(goal(call(Goal),I,D,F), Goals) :- !,
	nonvar(Goal),
	db_body(Goal, D, Goals).
db_goal(goal(\+(Goal),I,D,F), Goals) :-
	nonvar(Goal),
	db_body(Goal, D, Goals),
	!, fail.
db_goal(goal(\+(Goal),I,D,F), Goals) :- !.
db_goal(Goal, Goals) :-
	(   db_port(1, Goal, Goals)		% Call
	;   db_call(Goal, Goals),
	    (   db_port(2, Goal, Goals)		% Exit
	    ;   true
	    ;   db_port(3, Goal, Goals)		% Redo
	    )
	;   db_port(4, Goal, Goals)		% Fail
	).


db_port(Port, Goal, Goals) :-
	db_mode(Mode),
	Goal = goal(G,I,D,F),		%  NB: Goal is already bound
	(   spying(G), C1 = 42		%  spypoint => "**" or "*>"
	;   C1 = 32			% ~spypoint => "  " or " >"
	),
	(   F = 1, C2 = 62		%  skipped  => "*>" or " >"
	;   F = 0, C2 = C1		% ~skipped  => "**" or "  "
	),
	!,
	(   F = 1, '$SET$'(4, Goal, 1, 0), Stop = yes
	;   Mode = 2, !, fail		%  skipping
	;   C1 = 42, Stop = yes		%  spypoint
	;   Mode = 4,			%  X (display is wrong, alas)
	    (   Port > 2, Stop = no	%  show Fail,Redo but don't stop
	    ;   db_mode(0), Stop = yes	%  stop at Call,Exit & resume creeping
	    )
	;   Mode > 0, !, fail		%  not creeping
	;   '$leash'(Leash, Leash), Leash/\(1<<(4-Port)) =\= 0, Stop = yes
	;   Stop = no			%  creeping but not leashed
	),
	arg(Port, goal(' Call: ',' Exit: ',' Redo: ',' Fail: '), Name),
	!,
	repeat,
	    put(C1), put(C2), write(' ('), write(I),
	    write(') '), write(D), write(Name), print(G),
	    (   Stop = no, nl, !, fail
	    ;   write(' ? '), ttyflush,
		get_eol(C, N),
		db_port(C, N, [Goal|Goals], Port)
	    ),
	!, fail.


db_call(goal(Goal,I,D,F), Goals) :-
	system(Goal),
	!,
	call(Goal).
db_call(goal(Goal,I,D,F), Goals) :-
	Goals2 = [goal(Goal,I,D,F)|Goals],
	succ(D, E),
	clause(Goal, Body),
	db_body(Body, E, Goals2, AfterCut, HadCut),
	(   HadCut = yes,
		!,
		db_body(AfterCut, E, Goals2)
	;   HadCut = no
	).


db_body(Body, Depth, Goals) :-
	db_body(Body, Depth, Goals, AfterCut, HadCut),
	(   HadCut = yes,
		!,
		db_body(AfterCut, Depth, Goals)
	;   HadCut = no
	).


db_body((Conj1,Conj2), Depth, Goals, AfterCut, HadCut) :- !,
	db_body(Conj1, Conj2, Depth, Goals, AfterCut, HadCut).
db_body(!, _, _, true, yes) :- !.
db_body((Disj1;Disj2), Depth, Goals, AfterCut, HadCut) :-
	db_body(Disj1, Depth, Goals, AfterCut, HadCut).
db_body((Disj1;Disj2), Depth, Goals, AfterCut, HadCut) :- !,
	db_body(Disj2, Depth, Goals, AfterCut, HadCut).
db_body(true, _, _, true, no) :- !.
db_body(Goal, Depth, Goals, true, no) :-
	db_goal(Goal, Depth, Goals).

db_body(!, AfterCut, _, _, AfterCut, yes) :- !.
db_body((A,B), Conj, Depth, Goals, AfterCut, HadCut) :- !,
	db_body(A, (B,Conj), Depth, Goals, AfterCut, HadCut).
db_body((A;B), Conj, Depth, Goals, AfterCut, HadCut) :-
	db_body(A, Conj, Depth, Goals, AfterCut, HadCut).
db_body((A;B), Conj, Depth, Goals, AfterCut, HadCut) :- !,
	db_body(B, Conj, Depth, Goals, AfterCut, HadCut).
db_body(true, Body, Depth, Goals, AfterCut, HadCut) :- !,
	db_body(Body, Depth, Goals, AfterCut, HadCut).
db_body(Goal, Body, Depth, Goals, AfterCut, HadCut) :-
	db_goal(Goal, Depth, Goals),
	db_body(Body, Depth, Goals, AfterCut, HadCut).

db_goal(Goal, Depth, Goals) :-
	invocount(I),
	F = 0,					% beware of $SET$ !!
	db_goal(goal(Goal,I,Depth,F), Goals).

/*  get_eol(C, N)
    reads a line from the terminal.
    The first non-blank character (other than a digit) is bound to C.
    If there is no such character, C is bound to 10.
    N is bound to a numeric value.
*/    

get_eol(C, N) :-
	get0(Ch),
	get_eol(Ch, 0, M, C),
	( M = 0 ; N = M ), !.


get_eol(10, N, N, 10) :- !.
get_eol(10, N, N, C) :- !.
get_eol(Ch, L, N, C) :-
	Ch >= 48, Ch =< 57,
	M is L*10 + (Ch-48),
	get0(Dh),
	!,
	get_eol(Dh, M, N, C).
get_eol(Ch, M, N, C) :-
	var(C),
	C is Ch\/32,
	get0(Dh),
	!,
	get_eol(Dh, M, N, C).
get_eol(_, M, N, C) :-
	get0(Dh),
	get_eol(Dh, M, N, C).


default(N, _) :-
	integer(N), !.
default(N, N) :-
	integer(N), !.
default(N, L) :-
	length(L, N).


spying(Goal) :-
	'$flags'(Goal, P, P),
	P/\2'00010000 =\= 0.


db_port( 10, _, _, _) :- !,				%  CR is creep
	db_mode(0).
db_port( 99, _, _, _) :- !,				%  Creep
	db_mode(0).
db_port(108, _, _, _) :- !,				%  Leap
	db_mode(1).
db_port(115, _, [Goal|S], Port) :-			%  Skip
	arg(Port, db_port(yes,no,yes,no), yes), !,	%  (at Call or Redo)
	db_mode(2),
	'$SET$'(4, Goal, _, 1).
db_port(115, _, _, _) :-				%  Skip
	write('Wrong port for that.'), nl,
	!, fail.
db_port(113, _, [Goal|_], Port) :-			%  Quasi-Skip
	arg(Port, db_port(yes,no,yes,no), yes), !,	%  (at Call or Redo)
	db_mode(3),
	'$SET$'(4, Goal, _, 1).
db_port(113, _, _, _) :-				%  Quasi-Skip
	write('Wrong port for that.'), nl,
	!, fail.
db_port(120, _, _, Port) :-				%  X (real choice)
	arg(Port, db_port(no,no,yes,yes), yes), !,	%  (at Fail or Redo)
	db_mode(4).
db_port(120, _, _, _) :-				%  X (real choice)
	write('Wrong port for that.'), nl,
	!, fail.
db_port(112, N, Goals, _) :- !,				%  Print goals
	default(N, 1),
	show_goals(Goals, N, print).
db_port(119, N, Goals, _) :- !,				%  Write goals
	default(N, 1),
	show_goals(Goals, N, write).
db_port(100, N, Goals, _) :- !,				%  Display goals
	default(N, 1),
	show_goals(Goals, N, display).
db_port(103, N, Goals, _) :- !,				%  Goal stack
	default(N, Goals),
	show_goals(Goals, N, print).
db_port( 97, N, Goals, _) :- !,				%  Abort
	abort.
db_port(101, N, Goals, _) :- !,				%  Exit
	halt.
db_port( 96, N, Goals, _) :- !,				%  @ (+32)
	prompt(Old, '| :- '),
	read(Command),
	prompt(_, Old),
	(   call(Command) ; write(?), nl   ),
	!, fail.
db_port(123, N, Goals, _) :- !,				%  [ consult user
	consult(user),
	fail.
db_port(125, N, Goals, _) :- !,				%  ] reconsult user
	reconsult(user),
	fail.
db_port( 37, N, Goals, _) :- !,				%  % call the shell
	sh,
	fail.
db_port( 98, N, Goals, _) :- !,				%  Break
	invocount(Count),				%  save it
	break,						%  break can do debug
	invocount(Count-1),				%  restore count
	fail.
db_port( 43, _, [goal(G,_,_,_)|_], _) :-		%  + (set spypoint)
	(   spying(G), write(already)
	;   '$flags'(G, F, F\/2'00010000), write(now)
	),
	write(' spying'), nl,
	!, fail.
db_port( 45, _, [goal(G,_,_,_)|_], _) :-		%  - (remove spypoint)
	(   spying(G), '$flags'(G, F, F/\2'11101111), write('no longer')
	;   write('was not')
	),
	write(' spying'), nl,
	!, fail.
db_port(109, N, [goal(G,I,D,F)|_], _) :-		%  Matching clauses	
	system(G),
	write('Built in'), nl,
	!, fail.
db_port(109, N, [goal(G,I,D,F)|_], _) :- !,		%  Matching clauses
	'$list_clauses'(G).  /*fails*/
db_port(_, N, Goals, _) :-
	write(
'Abort		Break		Creep		Display
Exit		GoalStack	Help		Leap
Matching	Print		Quasiskip	Skip
Write		X=real choicept	[=consult	]=reconsult
%shell		@command	+add spypoint	-remove spypoint
The Fail, Retry, and ; commands are not yet implemented.
'),	fail.


show_goals([], _, _) :- !,
	fail.
show_goals([goal(Goal,I,D,F)|Goals], N, Method) :-
	succ(M, N),
	(   spying(Goal), write('**') ; write('  ')   ),
	write(' ('), write(I), write(') '), write(D), put(32),
	Call =.. [Method,Goal],
	call(Call), nl,
	!,
	show_goals(Goals, M, Method).


error           453410616   10    0     100644  1016      `
/*  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('
! culprit: '),
	write(Culprit),
	nl,
	tell(Old),
	!, fail.


$message(Message, Culprit) :-
	telling(Old, user),
	nl, write(Message),
	write(Culprit),
	nl,
	tell(Old),
	!.
	
flag            453407173   10    0     100644  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         453469158   10    0     100644  1493      `
/*  File   : pl/grammar
    Author : Fernando Pereira
    Updated: Wednesday February 1st, 1984, 8:38:15 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).


phrase(PhraseDef, WordList) :-
	$t_body(PhraseDef, WordList, [], Goal), !,
	call(Goal).


ground          453461365   10    0     100644  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            455047337   10    0     100644  14532     `
/*  File   : pl/init
    Author : Fernando Pereira + R.A.O'Keefe
    Updated: 1 June 84
    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(1150, fx,[(public),(mode),(type),(pred)]).	% declarations
:- 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,[*, /, div, //, <<, >>]).
:- op( 300,xfx,mod).
:- op( 200,xfy,'^').

%   The Dec-10 Prolog compiler uses two declarations:
%   :- public Stuff.	and	:- mode Stuff.
%   The type checker adds two more:
%   :- type Stuff.		and	:- pred Stuff.
%   So that we don't have to delete these useful declarations
%   in order to run programs under C-Prolog, we ignore them.

public X.		 % Exported predicates
mode X.			 % How predicates are called
type X.			 % Declaring types per se
pred X.			 % Argument types of predicates.

                         % 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) :- $user_call(If), !, $user_call(Then).

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

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

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

/*  The following "cases" control structure is based on a feature
    of LM-Prolog.  It will be described in the manual shortly.
*/

:- op(1120, fx, ('cases')).

cases(Form) :-
	X = 0,
	cases(Form, cases(X)).

cases((Test->Then;_), Flag) :-
	$user_call(Test),
	$SET$(1, Flag, _, 1),
	$user_call(Then).
cases(_, cases(1)) :- !,
	fail.
cases((_->_;Else), Flag) :- !,
	cases(Else, Flag).
cases((This;_), _) :-
	$user_call(This).
cases((_;That), Flag) :- !,
	cases(That, Flag).
cases((Test->Then), _) :- !,
	$user_call(Test),
	$user_call(Then).
cases(FinalElse, _) :-
	$user_call(FinalElse).


/*  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 div B,	10).
:- $sysflgs(A//B,	10).	% About to die.
:- $sysflgs(A^B,	11).
:- $sysflgs(atan(A,B),	12).

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.
lseq(X,Y) :-	       122.
$SET$(N,T,O,E) :-      121.		% Just for an experimental debugger

/*----------------------------------------------------------------------+
|									|
|			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.
abolish(P) :-
	functor(P, F, N),
	abolish(F, N).


$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)).


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


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) :-
	nonvar(P), !,
	functor(P, A, N),
	atom(A),
        $current_functor(A, N, 2'100000000, 2'11100000).
current_predicate(A, P) :-
        current_atom(A),
        $current_functor(A, N, 2'100000000, 2'11100000),
        functor(P, A, N).


system(P) :-
	primitive(P), !, fail.
system(P) :- 
        nonvar(P), !,
        $flags(P, F, F),
        F /\ 2'10000000 =\= 0.
system(P) :- 
        current_atom(A),
        $current_functor(A, N, 2'110000000, 2'10000000),
        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.
shell(S) :-		95.
save(F,N) :-		96.
save(F) :- save(F,_).
expand_file_name(O,N) :-123.

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.


/*----------------------------------------------------------------------+
|									|
|			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(' = '), print(Variable), !,
	$repply(Variables, yes).


%  consult and reconsult

consult([]) :- !.
consult([File|Files]) :- !,
	consult(File),
	consult(Files).
consult(-File) :- !,
	$break($csult(1, File)).
consult(File) :-
	$break($csult(0, File)).


reconsult(File) :-
	consult(-File).


[File|Files] :-
	consult([File|Files]).


$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).


unknown(X, Y) :-
	$unknown(X0, X0),
	$flag_code(X0, X),
	nonvar(Y),
	$flag_code(Y0, Y),
	$unknown(_, 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...

interp          454261122   10    0     100644  3348      `
%   File   : INTERP
%   Author : R.A.O'Keefe
%   Updated: 2 March 84
%   Purpose: Meta-circular interpreter for Prolog

/*  This is a genuinely meta-circular interpreter for a subset of Prolog
    containing cuts.  It relies on the fact that disjunction is transparent
    to cut just like conjunction.  If it doesn't work in your Prolog, and
    if you paid more than $100 for it, take your Prolog back to the shop
    and insist that they fix it, there are at least four different ways of
    implementing disjunction so that it works.
*/

do_goal(Goal) :-
	system(Goal),
	!,
	call(Goal).
do_goal(Goal) :-
	clause(Goal, Body),
	do_body(Body, AfterCut, HadCut),
	(   HadCut = yes,
		!,
		do_body(AfterCut)
	;   HadCut = no
	).


do_body(Body) :-
	do_body(Body, AfterCut, HadCut),
	(   HadCut = yes,
		!,
		do_body(AfterCut)
	;   HadCut = no
	).


do_body((!,AfterCut), AfterCut, yes) :- !.
do_body((Goal,Body), AfterCut, HadCut) :- !,
	do_goal(Goal),
	do_body(Body, AfterCut, HadCut).
do_body(!, true, yes).
do_body((Disj1;Disj2), AfterCut, HadCut) :-
	do_body(Disj1, AfterCut, HadCut).
do_body((Disj1;Disj2), AfterCut, HadCut) :- !,
	do_body(Disj2, AfterCut, HadCut).
do_body(Goal, true, no) :-
	do_goal(Goal).



trace(Goal) :-
	tr_goal(Goal, 0).


tr_goal(call(Goal), Depth) :- !,
	nonvar(Goal),
	tr_body(Goal, Depth).
tr_goal(\+(Goal), Depth) :-
	tr_body(Goal, Depth),
	!, fail.
tr_goal(\+(Goal), Depth) :- !.
tr_goal(Goal, Depth) :-
	(   tab(Depth), write('Call: '), write(Goal), nl, fail
	;   succ(Depth, Depth1),
	    tr_call(Goal, Depth1),
	    (   tab(Depth), write('Exit: '), write(Goal), nl, fail
	    ;	true
	    ;   tab(Depth), write('Redo: '), write(Goal), nl, fail
	    )
	;   tab(Depth), write('Fail: '), write(Goal), nl, fail
	).


tr_call(bagof(X,Y,Z), Depth) :- !,		% include these 4 lines if you
	bagof(X, tr_body(Y,Depth), Z).		% really want them, but they do
tr_call(setof(X,Y,Z), Depth) :- !,		% slow things down a bit.
	setof(X, tr_body(Y,Depth), Z).
tr_call(Goal, Depth) :-
	system(Goal),
	!,
	call(Goal).
tr_call(Goal, Depth) :-
	clause(Goal, Body),
	tr_body(Body, Depth, AfterCut, HadCut),
	(   HadCut = yes,
		!,
		tab(Depth), write('CUT'), nl,
		tr_body(AfterCut, Depth)
	;   HadCut = no
	).


tr_body(Body, Depth) :-
	tr_body(Body, Depth, AfterCut, HadCut),
	(   HadCut = yes,
		!,
		tab(Depth), write('CUT'), nl,
		tr_body(AfterCut, Depth)
	;   HadCut = no
	).


tr_body((Conj1,Conj2), Depth, AfterCut, HadCut) :- !,
	tr_body(Conj1, Conj2, Depth, AfterCut, HadCut).
tr_body(!, _, true, yes) :- !.
tr_body((Disj1;Disj2), Depth, AfterCut, HadCut) :-
	tr_body(Disj1, Depth, AfterCut, HadCut).
tr_body((Disj1;Disj2), Depth, AfterCut, HadCut) :- !,
	tr_body(Disj2, Depth, AfterCut, HadCut).
tr_body(true, _, true, no) :- !.
tr_body(Goal, Depth, true, no) :-
	tr_goal(Goal, Depth).

tr_body(!, AfterCut, _, AfterCut, yes) :- !.
tr_body((A,B), Conj, Depth, AfterCut, HadCut) :- !,
	tr_body(A, (B,Conj), Depth, AfterCut, HadCut).
tr_body((A;B), Conj, Depth, AfterCut, HadCut) :-
	tr_body(A, Conj, Depth, AfterCut, HadCut).
tr_body((A;B), Conj, Depth, AfterCut, HadCut) :- !,
	tr_body(B, Conj, Depth, AfterCut, HadCut).
tr_body(true, Body, Depth, AfterCut, HadCut) :- !,
	tr_body(Body, Depth, AfterCut, HadCut).
tr_body(Goal, Body, Depth, AfterCut, HadCut) :-
	tr_goal(Goal, Depth),
	tr_body(Body, Depth, AfterCut, HadCut).

lib             453469823   10    0     100644  3376      `
%   File   : pl/lib
%   Author : R.A.O'Keefe
%   Updated: 20 February 1984
%   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.
*/

:- public
	lib/1,			%  load a file
	lib/2,			%  find a file
	note_lib/1.		%  note public predicates of file


%   lib(File)
%   looks in all the likely places for File, and when it has found it,
%   it reconsults the file.  Reconsult is used so that repeated lib(F)
%   commands for the same F will have no ill effect.
%   lib(Pred/Arity) uses the clauses left behind by note_lib to load
%   file defining that predicate.

lib(Symbol/Arity) :- !,
	functor(Head, Symbol, Arity),
	(   clause(Head, (Load,Head)), !, call(Load)
	;   true	% it is already defined
	).
lib([File|Files]) :- !,
	lib(File),
	lib(Files).
lib([]) :- !.
lib(File) :-
	lib(File, FileFound),
	reconsult(FileFound).


%   lib(File, Found)
%   looks in all the likely places for File, and when it has
%   found it, it returns the name of the file it Found.  The
%   current directory is the last place checked.  If you want
%   the current directory checked first, add libdirectory(.)
%   at the front of the table.

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


$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, [47|F]).		%   47 is "/"


libdirectory('/usr/lib/prolog').
libdirectory('/usr/lib/prolog/teach').


%   note_lib(File)
%   reads the first clause in the File, which should be a public declaration.
%   If it is, it notes for each predicate mentioned in that declaration that
%   the predicate may be defined by reconsulting the file.  Because note_lib
%   calls lib/2, it will find /usr/lib/prolog/foo before it looks for ./foo.
%   If you want note_lib to look at a file in the current directory, you'd
%   better call note_lib('./foo'), or, since cd(.) exists, you'd better give
%   the full path-name every time.

note_lib(File) :-
	lib(File, FileFound),
	see(FileFound),
	read(FirstClause),
	seen,
	FirstClause = (:- public Exports),
	!,
	note_lib(Exports, FileFound).
note_lib(File) :-
	write('! note_lib: '), write(File),
	write(' is missing or lacks a :- public declaration.'),
	nl.

note_lib((A,B), File) :- !,
	note_lib(A, File),
	note_lib(B, File).
note_lib(Symbol/Arity, File) :-
	functor(Head, Symbol, Arity),
	(   clause(Head, _)		%  it's already defined
	;   assert((Head :- reconsult(File), Head))
	),  !.

listing         453460341   10    0     100644  7183      `
/*  File   : $Prolog/pl/listing
    Author : Richard A. O'Keefe
    Updated: 23 April 1984
    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.
%   The first clause was added on 23-Apr-84 because f((:-)) was being
%   print-ed as f(:-), which cannot be read back.

$print(Atom, Priority) :-
	atom(Atom),			%  Check for operators
	(   $is_op(Atom, 0, P, _, _), P > Priority
	|   $is_op(Atom, 1, P, _, _), P > Priority
	|   $is_op(Atom, 2, P, _, _), P > Priority
	),
	!,
	put(40), writeq(Atom), put(41).	%  (Atom)
$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(_).


listing(F, N) :-
	functor(P, F, N),
	listing(P).

$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             453408113   10    0     100644  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         453407102   10    0     100644  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)
)).


setof           453469810   10    0     100644  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            453469104   10    0     100644  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         453411821   10    0     100644  4192      `
/*  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, 2'100000000, 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             453469749   10    0     100644  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           453461323   10    0     100644  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         453406924   10    0     100644  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 ).


vmsall          453410605   10    0     100644  797       `
%   File   : [.pl]/vmsall
%   Author : Fernando Pereira
%   Updated: 20 February 1984
%   Purpose: Load all the current bits of the standard Prolog system.
%   Caveat : This is the VMS version, not tested for 1.4d.edai.

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

:- [
	'[.pl]protect'			%  Lock things up
].