% KERNEL file
% standard atoms
';'/2   ','/2   'call'/1   'tag'/1
'[]'/0   '.'/2   'error'/1    'user'/0

% atoms identifying system routines (keep 'fail' first and 'true' last)
	'fail'/0  'tag'/1   'call'/1   '!'/0
	'tagcut'/1   'tagfail'/1   'tagexit'/1   'ancestor'/1
	'halt'/1   'status'/0
	'display'/1   'rch'/0   'lastch'/1   'skipbl'/0   'wch'/1
	'echo'/0   'noecho'/0
	'see'/1   'seeing'/1   'seen'/0   'tell'/1   'telling'/1   'told'/0
	'ordchr'/2   'sum'/3   'prod'/4   'less'/2   '@<'/2
	'smalletter'/1   'bigletter'/1   'letter'/1   'digit'/1   'alphanum'/1
	'bracket'/1   'solochar'/1   'symch'/1
	'eqvar'/2   'var'/1
	'atom'/1   'integer'/1   'nonvarint'/1
	'functor'/3   'arg'/3   'pname'/2   'pnamei'/2
	'$proc'/1   '$proclimit'/0   '$procinit'/0
	'clause'/5   'retract'/3   'abolish'/2   'assert'/3   'redefine'/0
	'predefined'/2   'protect'/0
	'nonexistent'/0   'nononexistent'/0
	'debug'/0   'nodebug'/0
	'true'/0

% kernel library
error(:0) : nl . display('+++ System call error: ') . display(:0) .
	nl . fail . []
:ordchr(10, :0) . assert(iseoln(:0), [], 0) .
		  assert(nl, wch(:0).[], 0) . [] #
'='(:0, :0) : []
','(:0, :1) : call(:0) . call(:1) . []
';'(:0, _) : call(:0) . []
';'(_, :0) : call(:0) . []
not(:0) : call(:0) . '!' . fail . []
not(_) : []
check(:0) : not(not(:0)) . []
'side_effects'(:0) : not(not(:0)) . []

once(:0) : call(:0) . '!' . []

'@=<'(:0, :1) : '@<'(:1, :0) . '!' . fail . []
'@=<'(_, _) : []
'@>'(:0, :1) : '@<'(:1, :0) . []
'@>='(:0, :1) : '@=<'(:1, :0) . []

% - - - - - - basic input procedures - - - - - -
rdchsk(:0) : rch . skipbl . lastch(:0) . []
rdch(:0) : rch . lastch(:1) . sch(:1, :0) . []
% convert nonprintable characters to blanks
sch(:0, :0) : '@<'(' ', :0) . '!' . []
sch(:0, ' ') : []

repeat : []
repeat : repeat . []
member(:0, :0.:1) : []
member(:0, _.:1) : member(:0, :1) . []

proc(:0) : '$procinit' . '$pr'(:0) . []
'$pr'(:0) : '$proclimit' . '!' . fail . []
'$pr'(:0) : '$proc'(:0) . []
'$pr'(:0) : '$pr'(:0) . []

%   b a g o f  (preserves order of solutions)
bagof(:0, :1, _) : asserta('BAG'('BAG')) . call(:1) .
      asserta('BAG'(:0)) . fail . []
	    %% 0 Item, 1 Condition,
bagof(_, _, :0) : 'BAG'(:1) . '!' . intobag(:1, [], :0) . []
	    %% 0 Bag, 1 Item,
intobag('BAG', :0, :0) : '!' . retract('BAG', 1, 1) . []
	    %% 0 Final_bag,
intobag(:0, :1, :2) : retract('BAG', 1, 1) . 'BAG'(:3) . '!' .
      intobag(:3, :0.:1, :2) . []
	    %% 0 Item, 1 This_bag, 2 Final_bag, 3 Next_item,

 %        Interpreter of Toy-Prolog - the Prolog part.
% (c) COPYRIGHT 1983 - Feliks Kluzniak, Stanislaw Szpakowicz
%                   Institute of Informatics, Warsaw University
% :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
% - - - - - -          INTERACTIVE DRIVER - TOP LEVEL         - - - - - -
% :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
'ear' :
   'nl' .
   'display'('Toy-Prolog listening:') .
   'nl' .
   'tag'('loop') . []
'ear' :
   'halt'('Toy-Prolog, end of session.') . []
'loop' :
   'repeat' .
   'display'('?- ') .
   'read'(:0, :1) .
   'exec'(:0, :1) .
   'fail' . []
   %% 0 Term, 1 Sym_tab,
'stop' :
   'tagfail'('loop') . []
'exec'('e r r', _) :
   '!' . []
% this covers variables, too
'exec'(':-'(:0), _) :
   '!' .
   'once'(:0) . []
   %% 0 Goals,
'exec'(:0, _) :
   'integer'(:0) .
   '!' .
   'num_clause' . []
   %% 0 N,
'exec'(:0, :1) :
   'call'(:0) .
   'numbervars'(:0, 0, _) .
   'printvars'(:1) .
   'rch' . 
   'enough' .
   '!' . []
   %% 0 Goals, 1 Sym_tab,
'exec'(_, _) :
   'display'('no') .
   'nl' . []
% if call(Goals) fails
'enough' :
   'lastch'(:0) .
   'iseoln'(:0) . []
   %% 0 Ch,
'enough' :
   'skipbl' .
   'lastch'(:0) .
   'rch' .
   'not'('='(:0, ';')) . []
   %% 0 Ch,
'printvars'(:0) :
   'var'(:0) .
   'display'('yes') .
   'nl' .
   '!' . []
   %% 0 Sym_tab,
'printvars'(:0) :
   'prvars'(:0) . []
   %% 0 Sym_tab,
'prvars'(:0) :
   'var'(:0) .
   '!' . []
   %% 0 Sym_tab,
'prvars'('var'(:0, :1).:2) :
   'writetext'(:0) .
   'display'(' = ') .
   'side_effects'('outt'(:1, 'fd'(_, _), 'q')) .
   % this is equivalent to writeq(Instance) but we avoid
   % superfluous calls on numbervars - cf WRITE
   'nl' .
   'prvars'(:2) . []
   %% 0 NameString, 1 Instance, 2 Sym_tab_tail,
'num_clause' :
   'display'('+++ A number can''t be a clause.') .
   'nl' . []
% read a program upto  end.  (the only way to define user procedures);
% consult/reconsult must be issued from the terminal, and it returns
% there ( consult(user) is correct, too )
'consult'(:0) :
   'seeing'(:1) .
   'readprog'(:0) .
   'see'(:1) . []
   %% 0 File, 1 OldF,
'reconsult'(:0) :
   'redefine' .
   'seeing'(:1) .
   'readprog'(:0) .
   'see'(:1) .
   'redefine' . []
   %% 0 File, 1 OldF,
'readprog'('user') :
   '!' .
   'getprog' . []
'readprog'(:0) :
   'see'(:0) .
   'echo' .
   'getprog' .
   'noecho' .
   'seen' . []
   %% 0 File,
% the actual job is done by this procedure
'getprog' :
   'repeat' .
   'read'(:0) .
   'assimilate'(:0) .
   '='(:0, 'end') .
   '!' . []
   %% 0 T,
'assimilate'('e r r') :
   '!' . []
% a variable is erroneous, too
'assimilate'('-->'(:0, :1)) :
   '!' .
   'tag'('transl_rule'(:0, :1, :2)) .
   'assertz'(:2) . []
   %% 0 Left, 1 Right, 2 Clause,
'assimilate'(':-'(:0)) :
   '!' .
   'once'(:0) . []
   %% 0 Goal,
'assimilate'('end') :
   '!' . []
'assimilate'(:0) :
   'integer'(:0) .
   '!' .
   'num_clause' . []
   %% 0 N,
% otherwise - store the clause
'assimilate'(:0) :
   'assertz'(:0) . []
   %% 0 Clause,
% :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
% - - - - - -                  READ A TERM                  - - - - - -
% :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
'read'(:0) :
   'read'(:0, :1) . []
   %% 0 T, 1 Sym_tab,
'read'(:0, :1) :
   'gettr'(:2, :1) .
   '!' .
   'maketerm'(:2, :0) . []
   %% 0 T, 1 Sym_tab, 2 T_internal,
% if gettr fails, then...
'read'('e r r', _) :
   'nl' .
   'display'('+++ Bad term on input. Text skipped: ') .
   'skip' .
   'nl' . []
% skip to the nearest full stop not in quotes or in comment
'skip' :
   'lastch'(:0) .
   'wch'(:0) .
   'skip'(:0) . []
   %% 0 Ch,
'skip'('.') :
   'rch' .
   'lastch'(:0) .
   'e_skip'(:0) .
   '!' . []
   %% 0 Ch,
'skip'('%') :
   'skip_comment' .
   '!' .
   'rch' .
   'skip' . []
'skip'(:0) :
   'isquote'(:0) .
   'skip_s'(:0) .
   '!' .
   'rch' .
   'skip' . []
   %% 0 Q,
'skip'(_) :
   'rch' .
   'skip' . []
% stop on a "layout" character
'e_skip'(:0) :
   '@=<'(:0, ' ') . []
   %% 0 Ch,
'e_skip'(:0) :
   'wch'(:0) .
   'rch' .
   'skip' . []
   %% 0 Ch,
'skip_comment' :
   'repeat' .
   'rch' .
   'lastch'(:0) .
   'wch'(:0) .
   'iseoln'(:0) .
   '!' . []
   %% 0 Ch,
'isquote'('''') : []
'isquote'('"') : []
% skip a string
'skip_s'(:0) :
   'repeat' .
   'rch' .
   'lastch'(:1) .
   'wch'(:1) .
   '='(:1, :0) .
   '!' . []
   %% 0 Quote, 1 Ch,
% :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
% - - - - - -                  P A R S E R                  - - - - - -
% :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
% This is an operator precedence parser for Prolog-10.  g e t t r
% constructs the internal representation of a term. Next,  m a k e t e r m
% constructs the term proper - see  r e a d. Here is an informal
% description of the underlying operator precedence grammar ( each "rule"
% corresponds to one clause of  r e d u c e). Sides are separated by ==>
% and multiple righthand sides - by OR.
%       t  ==>  variable   OR   integer   OR   string
%       t  ==>  identifier
%       t  ==>  identifier ( t )
%       t  ==>  []   OR   {}
%       t  ==>  ( t )   OR   [ t ]   OR   { t }
%       t  ==>  [ t | t ]
%       t  ==>  t postfix_functor
%       t  ==>  t infix_functor t
%       t  ==>  prefix_functor t
% Sequences of terms separated by commas - in rules 3, 5, 6 - will be recognised
% as comma-terms (commas are infix functors, covered by rule 8).
% There are five types of operators: vns(_), id(_), ff(_, _, _),
% br(_, _), bar - see the scanner. The terminal symbol dot never gets onto
% the stack. The terminal symbol bottom is never returned by the scanner;
% it is only used to initiate and terminate the main loop (p a r s e). The
% only nonterminal symbol is t(_).
% There are five types of internal representations (Args denotes the represen-
% tation of arguments - usually a comma-term):
%       tr(Name, Args)    -  for functor-terms,
%       arg0(X)           -  for X a variable, an atom, a number, or a string,
%       bar(X, Y)         -  for a list with front X and tail Y,
%       tr1(Name, X)      -  for prefix and postfix functors,
%       tr2(Name, X, Y)   -  for infix functors.
% A Name in tr may be a bracket type. See  r e d u c e (clauses 5, 6)
% and  m a k e t e r m  for details.
% - - - get the internal representation of a term
'gettr'(:0, :1) :
   'gettoken'(:2, :1) .
   'parse'('bottom'.[], :2, :0, :1) . []
   %% 0 X, 1 Sym_tab, 2 T,
% p a r s e  takes four parameters: the current stack, the current token
% from input, the variable that drifts down and brings the internal repre-
% sentation to the surface, and the symbol table (used by  g e t t o k e n)
'parse'('t'(:0).'bottom'.[], 'dot', :0, _) :
   '!' . []
   %% 0 X,
'parse'(:0, :1, :2, :3) :
   'topterminal'(:0, :4, :5) .
   'establish_precedence'(:4, :1, :5, :6, :7, :8) .
   'exch_top'(:4, :7, :0, :9) .
   'step'(:6, :8, :9, :10, :11, :3) .
   'parse'(:10, :11, :2, :3) . []
   %% 0 Stack, 1 Input, 2 X, 3 Sym_tab, 4 Top, 5 Pos,
   %% 6 Rel, 7 RTop, 8 RInput, 9 RStack, 10 NewStack, 11 NewInput,
% the topmost terminal will be covered by at most one nonterminal
% (the third parameter gives Top's position: 1 on the top, 2 covered)
'topterminal'('t'(_).:0._, :0, 2) :
   '!' . []
   %% 0 Top,
'topterminal'(:0._, :0, 1) : []
   %% 0 Top,
% exchange the topmost terminal (applies only to disambiguated mixed functors)
'exch_top'(:0, :0, :1, :1) :
   '!' . []
   %% 0 Top, 1 Stack,
'exch_top'(_, :0, 't'(:1)._.:2, 't'(:1).:0.:2) :
   '!' . []
   %% 0 RTop, 1 X, 2 S,
'exch_top'(_, :0, _.:1, :0.:1) : []
   %% 0 RTop, 1 S,
% - - - perform one step:  shift (stack the current token) or reduce
'step'('lseq', :0, :1, :0.:1, :2, :3) :
   '!' .
   'gettoken'(:2, :3) . []
   %% 0 RInput, 1 Stack, 2 NewInput, 3 Sym_tab,
'step'('gt', :0, :1, :2, :0, _) :
   'reduce'(:1, :2) .
   '!' . []
   %% 0 RInput, 1 Stack, 2 NewStack,
% fail if reduction impossible (parse and gettr will fail, too -
%     this failure will be intercepted by gettr's caller)
% reduce top segment of the stack according to the underlying grammar
'reduce'('vns'(:0).:1, 't'('arg0'(:0)).:1) : []
   %% 0 X, 1 S,
'reduce'('id'(:0).:1, 't'('arg0'(:0)).:1) : []
   %% 0 I, 1 S,
'reduce'('br'('r', '()').'t'(:0).'br'('l', '()').'id'(:1).:2, 't'('tr'(:1, :0)).
:2) : []
   %% 0 X, 1 I, 2 S,
'reduce'('br'('r', :0).'br'('l', :0).:1, 't'('arg0'(:0)).:1) :
   'not'('='(:0, '()')) . []
   %% 0 Type, 1 S,
% '[]' or '{}', see p, 2nd clause
'reduce'('br'('r', :0).'t'(:1).'br'('l', :0).:2, 't'('tr'(:0, :1)).:2) : []
   %% 0 Type, 1 X, 2 S,
'reduce'('br'('r', '[]').'t'(:0).'bar'.'t'(:1).'br'('l', '[]').:2, 't'('bar'(:1,
 :0)).:2) : []
   %% 0 Y, 1 X, 2 S,
'reduce'('ff'(:0, :1, _).'t'(:2).:3, 't'('tr1'(:0, :2)).:3) :
   'ismpostf'(:1) . []
   %% 0 I, 1 Type, 2 X, 3 S,
'reduce'('t'(:0).'ff'(:1, :2, _).'t'(:3).:4, 't'('tr2'(:1, :3, :0)).:4) :
   'isminf'(:2) . []
   %% 0 Y, 1 I, 2 Type, 3 X, 4 S,
'reduce'('t'(:0).'ff'(:1, :2, _).:3, 't'('tr1'(:1, :0)).:3) :
   'ismpref'(:2) . []
   %% 0 X, 1 I, 2 Type, 3 S,
% otherwise fail (cf  s t e p)
% - - - auxiliary tests for the parser
'ispref'('fy') : []
'ispref'('fx') : []
'ispostf'('yf') : []
'ispostf'('xf') : []
'ismpref'(:0.[]) :
   'ispref'(:0) . []
   %% 0 TUn,
'ismpref'(_.:0.[]) :
   'ispref'(:0) . []
   %% 0 TUn,
'isminf'(:0.[]) :
   'member'(:0, 'xfy'.'yfx'.'xfx'.[]) . []
   %% 0 TBin,
'isminf'(_._.[]) : []
'ismpostf'(:0.[]) :
   'ispostf'(:0) . []
   %% 0 TUn,
'ismpostf'(_.:0.[]) :
   'ispostf'(:0) . []
   %% 0 TUn,
% - - - establish precedence relation between the topmost
% terminal on the stack and the current input terminal
'establish_precedence'(:0, :1, :2, :3, :4, :5) :
   'p'(:0, :1, :2, :6) .
   'finalize'(:6, :0, :1, :3, :4, :5) .
   '!' . []
   %% 0 Top, 1 Input, 2 Pos, 3 Rel, 4 RTop, 5 RInput,
   %% 6 Rel0,
'finalize'('lseq', :0, :1, 'lseq', :0, :1) : []
   %% 0 Top, 1 Input,
'finalize'('gt', :0, :1, 'gt', :0, :1) : []
   %% 0 Top, 1 Input,
'finalize'('lseq'(:0, :1), _, _, 'lseq', :0, :1) : []
   %% 0 RTop, 1 RInput,
'finalize'('gt'(:0, :1), _, _, 'gt', :0, :1) : []
   %% 0 RTop, 1 RInput,
'p'('id'(_), 'br'('l', '()'), 1, 'lseq') : []
'p'('br'('l', :0), 'br'('r', :0), _, 'lseq') : []
   %% 0 Type,
'p'('br'('l', []), 'bar', 2, 'lseq') : []
'p'('bar', 'br'('r', []), 2, 'lseq') : []
'p'(:0, :1, 1, 'gt') :
   'vns_id_br'(:0, 'r') .
   'br_bar'(:1, 'r') . []
   %% 0 Top, 1 Input,
'p'(:0, 'ff'(:1, :2, :3), 1, 'gt'(:0, 'ff'(:1, :4, :3))) :
   'vns_id_br'(:0, 'r') .
   'restrict'(:2, 'fx'.'fy'.[], :4) . []
   %% 0 Top, 1 N, 2 Types, 3 P, 4 RTypes,
'p'(:0, :1, 1, 'lseq') :
   'br_bar'(:0, 'l') .
   'vns_id_br'(:1, 'l') . []
   %% 0 Top, 1 Input,
'p'(:0, 'ff'(:1, :2, :3), :4, 'lseq'(:0, 'ff'(:1, :5, :3))) :
   'br_bar'(:0, 'l') .
   'pre_inpost'(:4, :2, :5) . []
   %% 0 Top, 1 N, 2 Types, 3 P, 4 Pos, 5 RTypes,
'p'('ff'(:0, :1, :2), :3, :4, 'gt'('ff'(:0, :5, :2), :3)) :
   'br_bar'(:3, 'r') .
   'post_inpre'(:4, :1, :5) . []
   %% 0 N, 1 Types, 2 P, 3 Input, 4 Pos, 5 RTypes,
'p'('ff'(:0, :1, :2), :3, 1, 'lseq'('ff'(:0, :4, :2), :3)) :
   'vns_id_br'(:3, 'l') .
   'restrict'(:1, 'xf'.'yf'.[], :4) . []
   %% 0 N, 1 Types, 2 P, 3 Input, 4 RTypes,
% functors with equal priorities
'p'('ff'(:0, :1, :2), 'ff'(:3, :4, :2), :5, :6) :
   'res_confl'(:1, :4, :5, :7, :8, :9) .
   '!' .
   'do_rel'(:9, 'ff'(:0, :7, :2), 'ff'(:3, :8, :2), :6) . []
   %% 0 NTop, 1 TsTop, 2 P, 3 NInp, 4 TsInp, 5 Pos,
   %% 6 Rel, 7 RTsTop, 8 RTsInp, 9 Rel0,
% different priorities
'p'('ff'(:0, :1, :2), 'ff'(:3, :4, :5), :6, 'gt'('ff'(:0, :7, :2), 'ff'(:3, :8, 
:5))) :
   'stronger'(:2, :5) .
   '!' .
   'restrict'(:4, 'fx'.'fy'.[], :8) .
   'post_inpre'(:6, :1, :7) . []
   %% 0 NTop, 1 TsTop, 2 PTop, 3 NInp, 4 TsInp, 5 PInp,
   %% 6 Pos, 7 RTsTop, 8 RTsInp,
'p'('ff'(:0, :1, :2), 'ff'(:3, :4, :5), :6, 'lseq'('ff'(:0, :7, :2), 'ff'(:3, :8
, :5))) :
   'stronger'(:5, :2) .
   '!' .
   'restrict'(:1, 'xf'.'yf'.[], :7) .
   'pre_inpost'(:6, :4, :8) . []
   %% 0 NTop, 1 TsTop, 2 PTop, 3 NInp, 4 TsInp, 5 PInp,
   %% 6 Pos, 7 RTsTop, 8 RTsInp,
'p'(_, 'dot', _, 'gt') : []
'p'('bottom', _, _, 'lseq') : []
% otherwise fail (p a r s e  fails, too)
'vns_id_br'('vns'(_), _) : []
'vns_id_br'('id'(_), _) : []
'vns_id_br'('br'(:0, _), :0) : []
   %% 0 LeftRight,
'br_bar'('br'(:0, _), :0) : []
   %% 0 LeftRight,
'br_bar'('bar', _) : []
'stronger'(:0, :1) :
   'less'(:0, :1) . []
   %% 0 Prior1, 1 Prior2,
'pre_inpost'(1, :0, :1) :
   % the functor must be prefix
   'restrict'(:0, 'xf'.'yf'.[], :2) .
   'restrict'(:2, 'xfy'.'yfx'.'xfx'.[], :1) . []
   %% 0 Types, 1 RTypes, 2 A,
'pre_inpost'(2, :0, :1) :
   % the functor must not be prefix
   'restrict'(:0, 'fx'.'fy'.[], :1) . []
   %% 0 Types, 1 RTypes,
'post_inpre'(1, :0, :1) :
   % the functor must be postfix
   'restrict'(:0, 'fx'.'fy'.[], :2) .
   'restrict'(:2, 'xfy'.'yfx'.'xfx'.[], :1) . []
   %% 0 Types, 1 RTypes, 2 A,
'post_inpre'(2, :0, :1) :
   % the functor must not be postfix
   'restrict'(:0, 'xf'.'yf'.[], :1) . []
   %% 0 Types, 1 RTypes,
% leave only those types that do not belong to RSet,
% fail if this would leave no types at all (RSet
% contains only binary types, or only unary types)
'restrict'(:0.[], :1, :0.[]) :
   '!' .
   'not'('member'(:0, :1)) . []
   %% 0 T, 1 RSet,
'restrict'(:0.:1.[], :2, :0.[]) :
   'member'(:1, :2) .
   '!' . []
   %% 0 TBin, 1 TUn, 2 RSet,
'restrict'(:0.:1.[], :2, :1.[]) :
   'member'(:0, :2) .
   '!' . []
   %% 0 TBin, 1 TUn, 2 RSet,
'restrict'(:0, _, :0) : []
   %% 0 Types,
% compute relation for two functors with equal priorities; four cases:
%    both normal, Top mixed, Input mixed, both mixed
'res_confl'(:0.[], :1.[], :2, :0.[], :1.[], :3) :
   '!' .
   'ff_p'(:0, :1, :2, :3) . []
   %% 0 TTop, 1 TInp, 2 Pos, 3 Rel0,
'res_confl'(:0.:1.[], :2.[], :3, :4, :2.[], :5) :
   '!' .
   'ff_p'(:0, :2, :3, :6) .
   'ff_p'(:1, :2, :3, :7) .
   'match_rels'(:6, :7, :5, :0, :1, :4) . []
   %% 0 TTopBin, 1 TTopUn, 2 TInp, 3 Pos, 4 RTsTop, 5 Rel0,
   %% 6 RelB, 7 RelU,
'res_confl'(:0.[], :1.:2.[], :3, :0.[], :4, :5) :
   '!' .
   'ff_p'(:0, :1, :3, :6) .
   'ff_p'(:0, :2, :3, :7) .
   'match_rels'(:6, :7, :5, :1, :2, :4) . []
   %% 0 TTop, 1 TInpBin, 2 TInpUn, 3 Pos, 4 RTsInp, 5 Rel0,
   %% 6 RelB, 7 RelU,
'res_confl'(:0.:1.[], :2.:3.[], :4, :5, :6, :7) :
   'ff_p'(:0, :2, :4, :8) .
   'ff_p'(:0, :3, :4, :9) .
   'ff_p'(:1, :2, :4, :10) .
   'ff_p'(:1, :3, :4, :11) .
   'res_mixed'(:8, :9, :10, :11, :7, :0, :1, :2, :3, :5, :6) .
   '!' . []
   %% 0 TTopBin, 1 TTopUn, 2 TInpBin, 3 TInpUn, 4 Pos, 5 RTsTop,
   %% 6 RTsInp, 7 Rel0, 8 RelBB, 9 RelBU, 10 RelUB, 11 RelUU,
'do_rel'('lseq', :0, :1, 'lseq'(:0, :1)) : []
   %% 0 TopF, 1 InpF,
'do_rel'('gt', :0, :1, 'gt'(:0, :1)) : []
   %% 0 TopF, 1 InpF,
% fail if Rel0 = err
'match_rels'(:0, :0, :0, :1, :2, :1.:2.[]) :
   '!' . []
   %% 0 Rel, 1 TBin, 2 TUn,
% err included
'match_rels'('err', :0, :0, _, :1, :1.[]) :
   '!' . []
   %% 0 Rel, 1 TUn,
'match_rels'(:0, 'err', :0, :1, _, :1.[]) :
   '!' . []
   %% 0 Rel, 1 TBin,
'match_rels'(_, _, 'err', :0, :1, :0.:1.[]) : []
   %% 0 TBin, 1 TUn,
'res_mixed'(:0, :0, :0, :0, :0, :1, :2, :3, :4, :1.:2.[], :3.:4.[]) : []
   %% 0 Rel0, 1 TTopBin, 2 TTopUn, 3 TInpBin, 4 TInpUn,
'res_mixed'('err', 'err', :0, :1, :2, _, :3, :4, :5, :3.[], :6) :
   'match_rels'(:0, :1, :2, :4, :5, :6) . []
   %% 0 RelUB, 1 RelUU, 2 Rel0, 3 TTopUn, 4 TInpBin, 5 TInpUn,
   %% 6 RTsInp,
'res_mixed'(:0, :1, 'err', 'err', :2, :3, _, :4, :5, :3.[], :6) :
   'match_rels'(:0, :1, :2, :4, :5, :6) . []
   %% 0 RelBB, 1 RelBU, 2 Rel0, 3 TTopBin, 4 TInpBin, 5 TInpUn,
   %% 6 RTsInp,
'res_mixed'('err', :0, 'err', :1, :2, :3, :4, _, :5, :6, :5.[]) :
   'match_rels'(:0, :1, :2, :3, :4, :6) . []
   %% 0 RelBU, 1 RelUU, 2 Rel0, 3 TTopBin, 4 TTopUn, 5 TInpUn,
   %% 6 RTsTop,
'res_mixed'(:0, 'err', :1, 'err', :2, :3, :4, :5, _, :6, :5.[]) :
   'match_rels'(:0, :1, :2, :3, :4, :6) . []
   %% 0 RelBB, 1 RelUB, 2 Rel0, 3 TTopBin, 4 TTopUn, 5 TInpBin,
   %% 6 RTsTop,
'res_mixed'(_, _, _, _, 'err', _, _, _, _, _, _) : []
% establish precedence relation for two (basic) types
'ff_p'(:0, :1, :2, 'lseq') :
   'member'(:0, 'xfy'.'fy'.[]) .
   % right_associative
   'ff_p_aux1'(:2, :1) .
   '!' . []
   %% 0 TTop, 1 TInp, 2 Pos,
'ff_p'(:0, :1, :2, 'gt') :
   'member'(:1, 'yfx'.'yf'.[]) .
   % left_associative
   'ff_p_aux2'(:2, :0) .
   '!' . []
   %% 0 TTop, 1 TInp, 2 Pos,
'ff_p'(_, _, _, 'err') : []
'ff_p_aux1'(1, :0) :
   'ispref'(:0) . []
   %% 0 TInp,
'ff_p_aux1'(2, :0) :
   'member'(:0, 'xfy'.'xf'.'xfx'.[]) . []
   %% 0 TInp,
'ff_p_aux2'(1, :0) :
   'ispostf'(:0) . []
   %% 0 TTop,
'ff_p_aux2'(2, :0) :
   'member'(:0, 'yfx'.'fx'.'xfx'.[]) . []
   %% 0 TTop,
% :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
% - - - - - -     internal representation ---> term     - - - - - -
% :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
'maketerm'('arg0'(:0), :0) :
   '!' . []
   %% 0 X,
% variable, atom, number, string
'maketerm'('tr'('()', :0), :1) :
   '!' .
   'maketerm'(:0, :1) . []
   %% 0 RawTerm, 1 T,
'maketerm'('bar'(:0, :1), :2) :
   '!' .
   'maketerm'(:1, :3) .
   'makelist'(:0, :3, :2) . []
   %% 0 RawList, 1 RawTail, 2 T, 3 Tail,
'maketerm'('tr'('[]', :0), :1) :
   '!' .
   'makelist'(:0, '[]', :1) . []
   %% 0 RawList, 1 T,
'maketerm'('tr'('{}', :0), '{}'(:1)) :
   '!' .
   'maketerm'(:0, :1) . []
   %% 0 RawArg, 1 Arg,
'maketerm'('tr'(:0, :1), :2) :
   '!' .
   'makelist'(:1, '[]', :3) .
   '=..'(:2, :0.:3) . []
   %% 0 Name, 1 RawArgs, 2 T, 3 Args,
'maketerm'('tr2'(:0, :1, :2), :3) :
   '!' .
   'maketerm'(:1, :4) .
   'maketerm'(:2, :5) .
   '=..'(:3, :0.:4.:5.[]) . []
   %% 0 Name, 1 RawArg1, 2 RawArg2, 3 T, 4 Arg1, 5 Arg2,
'maketerm'('tr1'(:0, :1), :2) :
   'maketerm'(:1, :3) .
   '=..'(:2, :0.:3.[]) . []
   %% 0 Name, 1 RawArg, 2 T, 3 Arg,
% comma-term to dot-list-with-Tail
'makelist'('tr2'(',', :0, :1), :2, :3.:4) :
   '!' .
   'maketerm'(:0, :3) .
   'makelist'(:1, :2, :4) . []
   %% 0 RawArg, 1 RawArgs, 2 Tail, 3 Arg, 4 Args,
'makelist'(:0, :1, :2.:1) :
   'maketerm'(:0, :2) . []
   %% 0 RawArg, 1 Tail, 2 Arg,
% :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
% - - - - - -                  S C A N N E R                  - - - - - -
% :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
% this scanner returns six kinds of tokens:
%       vns(_)                  variables, numbers, strings
%       id(Name)                atoms
%       ff(Name, Types, Prior)  "fix" functors
%       br(Which, Type)         brackets (left/right, '()' / '[]' / '{}')
%       bar                     |  (in lists)
%       dot                     . followed by a layout character
% - - - read a token and construct its internal form
% the input is supposed to be positioned
% over the first character of a token (or preceding "white space")
'gettoken'(:0, :1) :
   'skipbl' .
   'lastch'(:2) .
   'absorbtoken'(:2, :3) .
   '!' .
   'maketoken'(:3, :0, :1) .
   '!' . []
   %% 0 Token, 1 Sym_tab, 2 Startch, 3 Rawtoken,
% - - - read in a suitable sequence of characters
% a word, ie a regular alphanumeric identifier
'absorbtoken'(:0, 'id'(:0.:1)) :
   'wordstart'(:0) .
   'getword'(:1) . []
   %% 0 Ch, 1 Wordtail,
% a variable
'absorbtoken'(:0, 'var'(:0.:1)) :
   'varstart'(:0) .
   'getword'(:1) . []
   %% 0 Ch, 1 Tail,
% a solo character is a comma, a semicolon or an exclamation mark
'absorbtoken'(:0, 'id'(:0.[])) :
   'solochar'(:0) .
   'rch' . []
   %% 0 Ch,
% a bracket, ie ( ) [ ] { }
'absorbtoken'(:0, 'br'(:1, :2)) :
   'bracket'(:0) .
   'bracket'(:0, :1, :2) .
   'rch' . []
   %% 0 Ch, 1 Wh, 2 Type,
'absorbtoken'('|', 'bar') :
   'rch' . []
% a string in quotes or in double quotes
'absorbtoken'('''', 'qid'(:0)) :
   'rdch'(:1) .
   'getstring'('''', :1, :0) . []
   %% 0 Qname, 1 Nextch,
'absorbtoken'('"', 'str'(:0)) :
   'rdch'(:1) .
   'getstring'('"', :1, :0) . []
   %% 0 String, 1 Nextch,
% a positive number
'absorbtoken'(:0, 'num'(:0.:1)) :
   'digit'(:0) .
   'getdigits'(:1) . []
   %% 0 Ch, 1 Digits,
% a negative number or a dash (possibly starting a symbol, see below)
'absorbtoken'('-', :0) :
   'rdch'(:1) .
   'num_or_sym'(:1, :0) . []
   %% 0 Rawtoken, 1 Ch,
'absorbtoken'('.', :0) :
   'rdch'(:1) .
   'dot_or_sym'(:1, :0) . []
   %% 0 Rawtoken, 1 Ch,
% a symbol, built of . : - < = > + / * ? & $ @ # ^ _ ~ `
'absorbtoken'(:0, 'id'(:0.:1)) :
   'symch'(:0) .
   'getsym'(:1) . []
   %% 0 Ch, 1 Symbs,
% an embedded comment
'absorbtoken'('%', :0) :
   'skipcomment' .
   'lastch'(:1) .
   'absorbtoken'(:1, :0) . []
   %% 0 Rawtoken, 1 Ch,
% this shouldn't happen:
'absorbtoken'(:0, _) :
   'display'('errinscan'(:0)) .
   'nl' .
   'fail' . []
   %% 0 Ch,
'num_or_sym'(:0, 'num'('-'.:0.:1)) :
   'digit'(:0) .
   'getdigits'(:1) . []
   %% 0 Ch, 1 Digits,
'num_or_sym'(:0, 'id'('-'.:0.:1)) :
   'symch'(:0) .
   'getsym'(:1) . []
   %% 0 Ch, 1 Symbs,
'num_or_sym'(_, 'id'('-'.[])) : []
% layout characters precede ' ' in ASCII
'dot_or_sym'(:0, 'dot') :
   '@=<'(:0, ' ') . []
   %% 0 Ch,
% no advance
'dot_or_sym'(:0, 'id'('.'.:0.:1)) :
   'symch'(:0) .
   'getsym'(:1) . []
   %% 0 Ch, 1 Symbs,
'dot_or_sym'(_, 'id'('.'.[])) : []
'skipcomment' :
   'lastch'(:0) .
   'iseoln'(:0) .
   'skipbl' .
   '!' . []
   %% 0 Ch,
'skipcomment' :
   'rch' .
   'skipcomment' . []
% - - - auxiliary input procedures
% read an alphanumeric identifier
'getword'(:0.:1) :
   'rdch'(:0) .
   'alphanum'(:0) .
   '!' .
   'getword'(:1) . []
   %% 0 Ch, 1 Word,
'getword'([]) : []
% read a sequence of digits
'getdigits'(:0.:1) :
   'rdch'(:0) .
   'digit'(:0) .
   '!' .
   'getdigits'(:1) . []
   %% 0 Ch, 1 Digits,
'getdigits'([]) : []
% read a symbol
'getsym'(:0.:1) :
   'rdch'(:0) .
   'symch'(:0) .
   '!' .
   'getsym'(:1) . []
   %% 0 Ch, 1 Symbs,
'getsym'([]) : []
% read a quoted id or string (Delim is either ' or ")
'getstring'(:0, :0, :1) :
   '!' .
   'rdch'(:2) .
   'twodelims'(:0, :2, :1) . []
   %% 0 Delim, 1 Str, 2 Nextch,
'getstring'(:0, :1, :1.:2) :
   'rdch'(:3) .
   'getstring'(:0, :3, :2) . []
   %% 0 Delim, 1 Ch, 2 Str, 3 Nextch,
'twodelims'(:0, :0, :0.:1) :
   '!' .
   'rdch'(:2) .
   'getstring'(:0, :2, :1) . []
   %% 0 Delim, 1 Str, 2 Nextch,
'twodelims'(_, _, []) : []
%close the list
% - - - auxiliary tests
'wordstart'(:0) :
   'smalletter'(:0) . []
   %% 0 Ch,
'varstart'(:0) :
   'bigletter'(:0) . []
   %% 0 Ch,
'varstart'('_') : []
'bracket'('(', 'l', '()') : []
'bracket'(')', 'r', '()') : []
'bracket'('[', 'l', '[]') : []
'bracket'(']', 'r', '[]') : []
'bracket'('{', 'l', '{}') : []
'bracket'('}', 'r', '{}') : []
% - - - transform a raw token into its final form
'maketoken'('var'(:0), 'vns'(:1), :2) :
   'makeptr'(:0, :1, :2) . []
   %% 0 Namestring, 1 Ptr, 2 Sym_tab,
'maketoken'('id'(:0), :1, _) :
   'pname'(:2, :0) .
   'make_ff_or_id'(:2, :1) . []
   %% 0 Namestring, 1 Token, 2 Name,
'maketoken'('qid'(:0), 'id'(:1), _) :
   'pname'(:1, :0) . []
   %% 0 Namestring, 1 Name,
'maketoken'('num'('-'.:0), 'vns'(:1), _) :
   'pnamei'(:2, :0) .
   'sum'(:1, :2, 0) . []
   %% 0 Digits, 1 N, 2 N1,
'maketoken'('num'(:0), 'vns'(:1), _) :
   'pnamei'(:1, :0) . []
   %% 0 Digits, 1 N,
'maketoken'('str'(:0), 'vns'(:0), _) : []
   %% 0 Chars,
'maketoken'(:0, :0, _) : []
   %% 0 Token,
% br(_,_) and bar and dot
% variables are kept in a symbol table (an open list)
'makeptr'('_'.[], _, _) : []
%no search - an anonymous variable
'makeptr'(:0, :1, :2) :
   'look_var'('var'(:0, :1), :2) . []
   %% 0 Nmstr, 1 Ptr, 2 Sym_tab,
% look-up
'look_var'(:0, :0.:1) : []
   %% 0 Item, 1 Sym_tab,
'look_var'(:0, _.:1) :
   'look_var'(:0, :1) . []
   %% 0 Item, 1 Sym_tab,
'make_ff_or_id'(:0, 'ff'(:0, :1, :2)) :
   'FF'(:0, :1, :2) .
   '!' . []
   %% 0 Name, 1 Types, 2 Prior,
'make_ff_or_id'(:0, 'id'(:0)) : []
   %% 0 Name,
% :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
% - - - - - -         GRAMMAR RULE PREPROCESSOR         - - - - - -
% :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
'transl_rule'(:0, :1, :2) :
   'two_ok'(:0, :1) .
   'isolate_lhs_t'(:0, :3, :4) .
   'connect'(:4, :5, :6) .
   'expand'(:3, :7, :5, :8) .
   'makebody'(:1, :7, :6, :9, :10) .
   'do_clause'(:9, :8, :2) . []
   %% 0 Left, 1 Right, 2 Clause, 3 Nont, 4 Lhs_t, 5 Outpar,
   %% 6 Finalvar, 7 Initvar, 8 Head, 9 Body, 10 Alt_flag,
'do_clause'('true', :0, :0) :
   '!' . []
   %% 0 Head,
'do_clause'(:0, :1, ':-'(:1, :0)) : []
   %% 0 Body, 1 Head,
% Lhs_t is a list (possibly empty) of lefthand side terminals
'isolate_lhs_t'(','(:0, :1), :0, :1) :
   ';'('nonvarint'(:0), 'rulerror'('varint')) .
   ';'('isclosedlist'(:1), 'rulerror'('ter')) .
   '!' . []
   %% 0 Nont, 1 Lhs_t,
'isolate_lhs_t'(:0, :0, []) : []
   %% 0 Nont,
% fail if not a closed list
'isclosedlist'(:0) :
   'check'('iscll'(:0)) . []
   %% 0 L,
'iscll'(:0) :
   'var'(:0) .
   '!' .
   'fail' . []
   %% 0 L,
'iscll'([]) : []
'iscll'(_.:0) :
   'iscll'(:0) . []
   %% 0 L,
% connect terminals to the nearest nonterminal's input parameter
% (actually, "open" a closed list)
'connect'([], :0, :0) :
   '!' . []
   %% 0 Nextvar,
'connect'(:0.:1, :0.:2, :3) :
   'connect'(:1, :2, :3) . []
   %% 0 Tsym, 1 Tsyms, 2 Outpar, 3 Nextvar,
% - - - translate the righthand side (loop over alternatives)
% in alternatives, each righthand side is preceded by a dummy
% nonterminal, as defined by   ' dummy' --> [].   (since terminals
% are appended to input parameters, the input parameter of a common
% lefthand side must be a variable)
'makebody'(';'(:0, :1), :2, :3, ';'(','(' dummy'(:2, :4), :5), :6), _) :
   '!' .
   'two_ok'(:0, :1) .
   'makeright'(:0, :4, :3, :5) .
   'makebody'(:1, :2, :3, :6, 'alt') . []
   %% 0 Alt, 1 Alts, 2 Initvar, 3 Finalvar, 4 Nextvar, 5 Alt_b,
   %% 6 Alt_bs,
'makebody'(:0, :1, :2, :3, :4) :
   'var'(:4) .
   '!' .
   % only one alternative
   'makeright'(:0, :1, :2, :3) . []
   %% 0 Right, 1 Initvar, 2 Finalvar, 3 Body, 4 Alt_flag,
'makebody'(:0, :1, :2, ','(' dummy'(:1, :3), :4), 'alt') :
   'makeright'(:0, :3, :2, :4) . []
   %% 0 Right, 1 Initvar, 2 Finalvar, 3 Nextvar, 4 Body,
% - - - translate one alternative
'makeright'(','(:0, :1), :2, :3, :4) :
   '!' .
   'two_ok'(:0, :1) .
   'transl_item'(:0, :2, :5, :6) .
   'makeright'(:1, :5, :3, :7) .
   'combine'(:6, :7, :4) . []
   %% 0 Item, 1 Items, 2 Thispar, 3 Finalvar, 4 T_item_items, 5 Nextvar,
   %% 6 T_item, 7 T_items,
'makeright'(:0, :1, :2, :3) :
   'transl_item'(:0, :1, :2, :3) . []
   %% 0 Item, 1 Thispar, 2 Finalvar, 3 T_item,
'combine'('true', :0, :0) :
   '!' . []
   %% 0 T_items,
'combine'(:0, 'true', :0) :
   '!' . []
   %% 0 T_item,
'combine'(:0, :1, ','(:0, :1)) : []
   %% 0 T_item, 1 T_items,
% - - - translate one item (sure to be a functor-term)
'transl_item'(:0, :1, :2, 'true') :
   'isclosedlist'(:0) .
   '!' .
   'connect'(:0, :1, :2) . []
   %% 0 Terminals, 1 Thispar, 2 Nextvar,
% conditions (the cut and others)
'transl_item'('!', :0, :0, '!') :
   '!' . []
   %% 0 Thispar,
'transl_item'('{}'(:0), :1, :1, 'call'(:0)) :
   '!' . []
   %% 0 Cond, 1 Thispar,
% bad list of terminals (missed the first clause)
'transl_item'(_._, _, _, _) :
   'rulerror'('ter') . []
% a nested alternative
'transl_item'(';'(:0, :1), :2, :3, :4) :
   '!' .
   'makebody'(';'(:0, :1), :2, :3, :4, _) . []
   %% 0 X, 1 Y, 2 Thispar, 3 Nextvar, 4 Transl,
% finally, a regular nonterminal
'transl_item'(:0, :1, :2, :3) :
   'expand'(:0, :1, :2, :3) . []
   %% 0 Nont, 1 Thispar, 2 Nextvar, 3 Transl,
% add input parameter and output parameter
'expand'(:0, :1, :2, :3) :
   '=..'(:0, :4.:5) .
   '=..'(:3, :4.:1.:2.:5) . []
   %% 0 Nont, 1 In_par, 2 Out_par, 3 Call, 4 Fun, 5 Args,
% - - - error handling
'two_ok'(:0, :1) :
   'nonvarint'(:0) .
   'nonvarint'(:1) .
   '!' . []
   %% 0 X, 1 Y,
'two_ok'(_, _) :
   'rulerror'('varint') . []
'rulerror'(:0) :
   'nl' .
   'display'('+++ Error in this rule: ') .
   'mes'(:0) .
   'nl' .
   'tagfail'('transl_rule'(_, _, _)) . []
   %% 0 Message,
% diagnostics are only very brief (and not too informative ...)
'mes'('varint') :
   'display'('variable or integer item.') . []
'mes'('ter') :
   'display'('terminals not on a closed list.') . []
% - - - initiate grammar processing
'phrase'(:0, :1) :
   'nonvarint'(:0) .
   '!' .
   'expand'(:0, :1, [], :2) .
   'call'(:2) . []
   %% 0 Nont, 1 Terminals, 2 Init_call,
'phrase'(:0, :1) :
   'error'('phrase'(:0, :1)) . []
   %% 0 N, 1 T,
' dummy'(:0, :0) : []
   %% 0 X,
% *********************************
% *********************************
% ***    L  I  B  R  A  R  Y    ***
% *********************************
% *********************************
% :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
% - - - - - -           =..  (read as "univ")           - - - - - -
% :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
'=..'(:0, :1) :
   'var'(:0) .
   'var'(:1) .
   '!' .
   'error'('=..'(:0, :1)) . []
   %% 0 X, 1 Y,
'=..'(:0, :0.[]) :
   'integer'(:0) .
   '!' . []
   %% 0 Num,
'=..'(:0, :1.:2) :
   'setarity'(:0, :2, :3) .
   'functor'(:0, :1, :3) .
   % this works both ways
   'not'('integer'(:1)) .
   % we don't want eg  17(X)
   'setargs'(:0, :2, 0, :3) . []
   %% 0 Term, 1 Fun, 2 Args, 3 N,
% this works both ways, too
'setarity'(:0, :1, :2) :
   'var'(:0) .
   '!' .
   'length'(:1, :2) . []
   %% 0 Term, 1 Args, 2 N,
% notice that bad Args give an error in  l e n g t h
'setarity'(_, _, _) : []
% Arity will be set by  f u n c t o r  in =..
% both numeric parameters are given,
% the loop stops when the third reaches the fourth
% (works both ways because  a r g  does)
'setargs'(_, [], :0, :0) :
   '!' . []
   %% 0 N,
'setargs'(:0, :1.:2, :3, :4) :
   'sum'(:3, 1, :5) .
   'arg'(:5, :0, :1) .
   'setargs'(:0, :2, :5, :4) . []
   %% 0 Term, 1 Arg, 2 Args, 3 K, 4 N, 5 K1,
% find the length of a closed list; error if not closed
'length'(:0, :1) :
   'length'(:0, 0, :1) . []
   %% 0 List, 1 N,
% this is a tail-recursive formulation of length
'length'(:0, _, _) :
   'var'(:0) .
   '!' .
   'error'('length'(:0, _)) . []
   %% 0 L,
'length'([], :0, :0) :
   '!' . []
   %% 0 N,
'length'(_.:0, :1, :2) :
   '!' .
   'sum'(:1, 1, :3) .
   'length'(:0, :3, :2) . []
   %% 0 List, 1 K, 2 N, 3 K1,
'length'(:0, _, _) :
   'error'('length'(:0, _)) . []
   %% 0 Bizarre,
% bind every variable to a distinct 'V'(N)
'numbervars'('V'(:0), :0, :1) :
   '!' .
   'sum'(:0, 1, :1) . []
   %% 0 N, 1 NextN,
'numbervars'('V'(_), :0, :0) :
   '!' . []
   %% 0 N,
'numbervars'(:0, :1, :1) :
   'integer'(:0) .
   '!' . []
   %% 0 X, 1 N,
'numbervars'(:0, :1, :2) :
   'numbervars'(:0, 1, :1, :2) . []
   %% 0 X, 1 N, 2 NextN,
'numbervars'(:0, :1, :2, :3) :
   'arg'(:1, :0, :4) .
   '!' .
   'numbervars'(:4, :2, :5) .
   'sum'(:1, 1, :6) .
   'numbervars'(:0, :6, :5, :3) . []
   %% 0 X, 1 K, 2 N, 3 NextN, 4 A, 5 MidN,
   %% 6 K1,
'numbervars'(_, _, :0, :0) : []
   %% 0 N,
% ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
% - - - - - -       PREDEFINED "FIX" FUNCTORS AND  O P       - - - - - -
% ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
% (ordered according to probable frequency)
'FF'(',', 'xfy'.[], 1000) : []
'FF'(':-', 'xfx'.'fx'.[], 1200) : []
'FF'(';', 'xfy'.[], 1100) : []
'FF'('not', 'fy'.[], 900) : []
'FF'('=', 'xfx'.[], 700) : []
'FF'('is', 'xfx'.[], 700) : []
'FF'('-->', 'xfx'.[], 1200) : []
'FF'('+', 'yfx'.'fx'.[], 500) : []
'FF'('-', 'yfx'.'fx'.[], 500) : []
'FF'('*', 'yfx'.[], 400) : []
'FF'('/', 'yfx'.[], 400) : []
'FF'('mod', 'xfx'.[], 300) : []
'FF'('<', 'xfx'.[], 700) : []
'FF'('=<', 'xfx'.[], 700) : []
'FF'('>', 'xfx'.[], 700) : []
'FF'('>=', 'xfx'.[], 700) : []
'FF'('=:=', 'xfx'.[], 700) : []
'FF'('=\=', 'xfx'.[], 700) : []
'FF'('@<', 'xfx'.[], 700) : []
'FF'('@=<', 'xfx'.[], 700) : []
'FF'('@>', 'xfx'.[], 700) : []
'FF'('@>=', 'xfx'.[], 700) : []
'FF'('=..', 'xfx'.[], 700) : []
'FF'('==', 'xfx'.[], 700) : []
'FF'('\==', 'xfx'.[], 700) : []
% this implementation of  op  takes care of redefinitions
% and of mixed functors
'op'(:0, :1, :2) :
   'atom'(:2) .
   'pname'(:2, :3) .
   'noq'(:3) .
   % noq - see WRITE
   'integer'(:0) .
   'less'(0, :0) .
   'less'(:0, 1201) .
   'set_kind'(:1, :4) .
   '!' .
   'do_op'(:0, :1, :2, :4) . []
   %% 0 Prior, 1 Type, 2 Name, 3 String, 4 Kind,
% if not all parameters are OK -
'op'(:0, :1, :2) :
   'error'('op'(:0, :1, :2)) . []
   %% 0 P, 1 T, 2 N,
% set Kind to bin or un
'set_kind'(:0, 'bin') :
   'binary'(:0, _) .
   '!' . []
   %% 0 Type,
'set_kind'(:0, 'un') :
   'unary'(:0, _, _) .
   '!' . []
   %% 0 Type,
% test for binary and instantiate Assoc
'binary'('xfy', 'a'('r')) : []
% right associative
'binary'('yfx', 'a'('l')) : []
%  left associative
'binary'('xfx', 'na'(_)) : []
%   non-associative
% test for unary, instantiate Kind and Assoc
'unary'('fy', 'pre', 'a'('r')) : []
% right associative
'unary'('fx', 'pre', 'na'('r')) : []
% right non-associative
'unary'('yf', 'post', 'a'('l')) : []
%  left associative
'unary'('xf', 'post', 'na'('l')) : []
%  left non-associative
'do_op'(:0, :1, :2, :3) :
   'FF'(:2, :4, :5) .
   '!' .
   'addff'(:4, :5, :0, :1, :2, :3) . []
   %% 0 P, 1 T, 2 N, 3 Kind, 4 Oldtypes, 5 Oldprior,
'do_op'(:0, :1, :2, _) :
   'assertz'('FF'(:2, :1.[], :0)) . []
   %% 0 P, 1 T, 2 N,
% add or redefine a functor
% for mixed functors, keep the binary type before the unary
% the same priority: redefine or make mixed
'addff'(:0.[], :1, :1, :2, :3, :4) :
   '!' .
   'set_kind'(:0, :5) .
   'addff1'(:5, :4, :0, :2, :3, :1) . []
   %% 0 Oldtype, 1 P, 2 T, 3 N, 4 Kind, 5 Oldkind,
'addff'(:0.:1.[], :2, :2, :3, :4, :5) :
   '!' .
   'addff2'(:5, :0, :1, :3, :2, :4) . []
   %% 0 Oldtype1, 1 Oldtype2, 2 P, 3 T, 4 N, 5 Kind,
% otherwise the priorities were different: redefine
'addff'(_, _, :0, :1, :2, _) :
   'redeff'(:2, :1.[], :0) . []
   %% 0 P, 1 T, 2 N,
% make a mixed functor or change type
'addff1'('bin', 'un', :0, :1, :2, :3) :
   'mk_mixed'(:2, :0.:1.[], :3) . []
   %% 0 Oldtype, 1 T, 2 N, 3 P,
'addff1'('un', 'bin', :0, :1, :2, :3) :
   'mk_mixed'(:2, :1.:0.[], :3) . []
   %% 0 Oldtype, 1 T, 2 N, 3 P,
'addff1'(:0, :0, _, :1, :2, :3) :
   'redeff'(:2, :1.[], :3) . []
   %% 0 Kind, 1 T, 2 N, 3 P,
% adjust a mixed functor by changing one of its types
'addff2'('bin', _, :0, :1, :2, :3) :
   'mk_mixed'(:3, :1.:0.[], :2) . []
   %% 0 Oldtype2, 1 T, 2 P, 3 N,
'addff2'('un', :0, _, :1, :2, :3) :
   'mk_mixed'(:3, :0.:1.[], :2) . []
   %% 0 Oldtype1, 1 T, 2 P, 3 N,
'mk_mixed'(:0, :1, :2) :
   'retract'('FF'(:0, _, _)) .
   '!' .
   'assertz'('FF'(:0, :1, :2)) . []
   %% 0 N, 1 Types, 2 P,
% redefine and issue a warning
'redeff'(:0, :1, :2) :
   'nl' .
   'display'('functor "') .
   'display'(:0) .
   'display'('" redefined') .
   'nl' .
   'retract'('FF'(:0, _, _)) .
   '!' .
   'asserta'('FF'(:0, :1, :2)) . []
   %% 0 N, 1 T, 2 P,
% remove a declaration
'delop'(:0) :
   'atom'(:0) .
   'retract'('FF'(:0, _, _)) .
   '!' . []
   %% 0 Name,
'delop'(:0) :
   'error'('delop'(:0)) . []
   %% 0 Name,
% :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
% - - - - - -       EVALUATE AN ARITHMETIC EXPRESSION       - - - - - -
% :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
'is'(:0, :0) :
   'integer'(:0) .
   '!' . []
   %% 0 N,
'is'(:0, '+'(:1, :2)) :
   '!' .
   'is'(:3, :1) .
   'is'(:4, :2) .
   'sum'(:3, :4, :0) . []
   %% 0 Val, 1 A, 2 B, 3 Av, 4 Bv,
'is'(:0, '-'(:1, :2)) :
   '!' .
   'is'(:3, :1) .
   'is'(:4, :2) .
   'sum'(:4, :0, :3) . []
   %% 0 Val, 1 A, 2 B, 3 Av, 4 Bv,
'is'(:0, '*'(:1, :2)) :
   '!' .
   'is'(:3, :1) .
   'is'(:4, :2) .
   'prod'(:3, :4, 0, :0) . []
   %% 0 Val, 1 A, 2 B, 3 Av, 4 Bv,
'is'(:0, '/'(:1, :2)) :
   '!' .
   'is'(:3, :1) .
   'is'(:4, :2) .
   'prod'(:4, :0, _, :3) . []
   %% 0 Val, 1 A, 2 B, 3 Av, 4 Bv,
'is'(:0, 'mod'(:1, :2)) :
   '!' .
   'is'(:3, :1) .
   'is'(:4, :2) .
   'prod'(:4, _, :0, :3) . []
   %% 0 Val, 1 A, 2 B, 3 Av, 4 Bv,
'is'(:0, '+'(:1)) :
   '!' .
   'is'(:0, :1) . []
   %% 0 Val, 1 A,
'is'(:0, '-'(:1)) :
   '!' .
   'is'(:2, :1) .
   'sum'(:0, :2, 0) . []
   %% 0 Val, 1 A, 2 Av,
'is'(:0, :0.[]) :
   'integer'(:0) . []
   %% 0 N,
% otherwise  f a i l
% - - - - - - EVALUATE AN ARITHMETIC RELATION - - - - - -
'=:='(:0, :1) :
   'is'(:2, :0) .
   'is'(:2, :1) . []
   %% 0 X, 1 Y, 2 XV,
'<'(:0, :1) :
   'is'(:2, :0) .
   'is'(:3, :1) .
   'less'(:2, :3) . []
   %% 0 X, 1 Y, 2 XV, 3 YV,
'=<'(:0, :1) :
   'is'(:2, :0) .
   'is'(:3, :1) .
   'not'('less'(:3, :2)) . []
   %% 0 X, 1 Y, 2 XV, 3 YV,
'>'(:0, :1) :
   'is'(:2, :0) .
   'is'(:3, :1) .
   'less'(:3, :2) . []
   %% 0 X, 1 Y, 2 XV, 3 YV,
'>='(:0, :1) :
   'is'(:2, :0) .
   'is'(:3, :1) .
   'not'('less'(:2, :3)) . []
   %% 0 X, 1 Y, 2 XV, 3 YV,
'=\='(:0, :1) :
   'not'('=:='(:0, :1)) . []
   %% 0 X, 1 Y,
% :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
% - - - - - -         PERFECT EQUALITY OF TERMS         - - - - - -
% :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
'=='(:0, :1) :
   'var'(:0) .
   'var'(:1) .
   '!' .
   'eqvar'(:0, :1) . []
   %% 0 T1, 1 T2,
'=='(:0, :1) :
   'check'('==?'(:0, :1)) . []
   %% 0 T1, 1 T2,
'\=='(:0, :1) :
   'not'('==?'(:0, :1)) . []
   %% 0 T1, 1 T2,
'==?'(:0, :1) :
   'integer'(:0) .
   'integer'(:1) .
   '!' .
   '='(:0, :1) . []
   %% 0 T1, 1 T2
'==?'(:0, :1) :
   'nonvarint'(:0) .
   'nonvarint'(:1) .
   'functor'(:0, :2, :3) .
   'functor'(:1, :2, :3) .
   'equalargs'(:0, :1, 1) . []
   %% 0 T1, 1 T2, 2 Fun, 3 Arity,
'equalargs'(:0, :1, :2) :
   'arg'(:2, :0, :3) .
   'arg'(:2, :1, :4) .
   % arg fails given too large a number
   '!' .
   '=='(:3, :4) .
   'sum'(:2, 1, :5) .
   'equalargs'(:0, :1, :5) . []
   %% 0 T1, 1 T2, 2 Argnumber, 3 Arg1, 4 Arg2, 5 Nextnumber,
'equalargs'(_, _, _) : []
% :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
% - - - - - -   assert, asserta, assertz, retract, clause   - - - - - -
% :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
% - - - add a clause (using built-in assert(_, _, _))
'assert'(:0) :
   'asserta'(:0) . []
   %% 0 Cl,
'asserta'(:0) :
   'nonvarint'(:0) .
   'convert'(:0, :1, :2) .
   '!' .
   'assert'(:1, :2, 0) . []
   %% 0 Cl, 1 Head, 2 Body,
'asserta'(:0) :
   'error'('asserta'(:0)) . []
   %% 0 Cl,
'assertz'(:0) :
   'nonvarint'(:0) .
   'convert'(:0, :1, :2) .
   '!' .
   'assert'(:1, :2, 32767) . []
   %% 0 Cl, 1 Head, 2 Body,
% ie  2 to 15th minus 1
'assertz'(:0) :
   'error'('assertz'(:0)) . []
   %% 0 Cl,
% convert the external form of a Body into a dotted list
'convert'(':-'(:0, :1), :0, :2) :
   'conv_body'(:1, :2) . []
   %% 0 Head, 1 B, 2 Body,
'convert'(:0, :0, []) : []
   %% 0 Unit_cl,
% this procedure works both ways
'conv_body'(:0, 'call'(:0).[]) :
   'var'(:0) .
   '!' . []
   %% 0 B,
'conv_body'('true', []) : []
'conv_body'(:0, :1) :
   'conv_b'(:0, :1) . []
   %% 0 B, 1 Body,
'conv_b'(:0, :1.[]) :
   'var'(:0) .
   '!' .
   'conv_call'(:0, :1) . []
   %% 0 B, 1 Body,
'conv_b'(','(:0, :1), :2.:3) :
   '!' .
   'conv_call'(:0, :2) .
   'conv_b'(:1, :3) . []
   %% 0 C, 1 B, 2 Call, 3 Body,
'conv_b'(:0, :0.[]) : []
   %% 0 Call,
% not a variable
% interpreter can process variable calls only within  c a l l
'conv_call'(:0, 'call'(:0)) :
   'var'(:0) .
   '!' . []
   %% 0 C,
'conv_call'(:0, :0) : []
   %% 0 C,
% - - - remove a clause (this procedure is backtrackable)
'retract'(:0) :
   'nonvarint'(:0) .
   'convert'(:0, :1, :2) .
   '!' .
   'functor'(:1, :3, :4) .
   'remcls'(:3, :4, 1, :1, :2) . []
   %% 0 Cl, 1 Head, 2 Body, 3 Fun, 4 Arity,
'retract'(:0) :
   'error'('retract'(:0)) . []
   %% 0 Cl,
% ultimate failure if N too big (retract/3 fails)
'remcls'(:0, :1, :2, :3, :4) :
   'clause'(:0, :1, :2, :5, :6) .
   'remcls'(:0, :1, :2, :5, :3, :6, :4) . []
   %% 0 Fun, 1 Arity, 2 N, 3 Head, 4 Body, 5 N_head,
   %% 6 N_body,
'remcls'(:0, :1, :2, :3, :3, :4, :4) :
   'retract'(:0, :1, :2) . []
   %% 0 Fun, 1 Arity, 2 N, 3 Head, 4 Body,
% user's backtracking resumes  r e t r a c t  here
% (after removing the Nth clause the next becomes Nth)
'remcls'(:0, :1, :2, :3, :4, :5, :6) :
   'check'('='(:3, :4)) .
   'check'('='(:5, :6)) .
   '!' .
   'remcls'(:0, :1, :2, :4, :6) . []
   %% 0 Fun, 1 Arity, 2 N, 3 N_head, 4 Head, 5 N_body,
   %% 6 Body,
'remcls'(:0, :1, :2, _, :3, _, :4) :
   'sum'(:2, 1, :5) .
   'remcls'(:0, :1, :5, :3, :4) . []
   %% 0 Fun, 1 Arity, 2 N, 3 Head, 4 Body, 5 N1,
% - - - generate nondeterministically all clauses whose head
%       and body match the parameters of  c l a u s e
'clause'(:0, :1) :
   'nonvarint'(:0) .
   '!' .
   'functor'(:0, :2, :3) .
   'gencls'(:2, :3, 1, :0, :1) . []
   %% 0 Head, 1 Body, 2 Fun, 3 Arity,
'clause'(:0, :1) :
   'error'('clause'(:0, :1)) . []
   %% 0 Head, 1 Body,
% generate; ultimate failure if N too big (clause/5 fails)
'gencls'(:0, :1, :2, :3, :4) :
   'clause'(:0, :1, :2, :5, :6) .
   'gencls'(:0, :1, :2, :5, :3, :6, :4) . []
   %% 0 Fun, 1 Arity, 2 N, 3 Head, 4 Body, 5 N_head,
   %% 6 N_body,
% fail if N_head does not match Head,
%       or if N_body converted does not match Body
'gencls'(_, _, _, :0, :0, :1, :2) :
   'conv_body'(:2, :1) . []
   %% 0 N_head, 1 N_body, 2 Body,
% user's backtracking resumes  c l a u s e  here
'gencls'(:0, :1, :2, _, :3, _, :4) :
   'sum'(:2, 1, :5) .
   'gencls'(:0, :1, :5, :3, :4) . []
   %% 0 Fun, 1 Arity, 2 N, 3 Head, 4 Body, 5 N1,
% :::::::::::::::::::::::::::::::::::::::::::::::::::::::
% - - - - - -             LISTING             - - - - - -
% :::::::::::::::::::::::::::::::::::::::::::::::::::::::
% list procedures determined by the parameter ( listing(_) )
%       or all user's procedures ( listing )
'listing' :
   'proc'(:0) .
   'listproc'(:0) .
   'nl' .
   'fail' . []
   %% 0 Head,
'listing' : []
% catch the final fail from  p r o c
'listing'(:0) :
   'atom'(:0) .
   '!' .
   'listbyname'(:0) . []
   %% 0 Fun,
'listing'('/'(:0, :1)) :
   'atom'(:0) .
   'integer'(:1) .
   '=<'(0, :1) .
   '!' .
   'functor'(:2, :0, :1) .
   'listproc'(:2) . []
   %% 0 Fun, 1 Arity, 2 Head,
'listing'(:0) :
   'isclosedlist'(:0) .
   'listseveral'(:0) .
   '!' . []
   %% 0 L,
'listing'(:0) :
   'error'('listing'(:0)) . []
   %% 0 X,
% isclosedlist - cf grammar rule preprocessor
'listseveral'([]) : []
'listseveral'(:0.:1) :
   'listing'(:0) .
   'listseveral'(:1) . []
   %% 0 Item, 1 Items,
% all procedures with this name
'listbyname'(:0) :
   'proc'(:1) .
   'functor'(:1, :0, _) .
   'listproc'(:1) .
   'nl' .
   'fail' . []
   %% 0 Fun, 1 Head,
'listbyname'(_) : []
% succeed
% one procedure
'listproc'(:0) :
   'clause'(:0, :1) .
   'writeclause'(:0, :1) .
   'wch'('.') .
   'nl' .
   'fail' . []
   %% 0 Head, 1 Body,
'listproc'(_) : []
% succeed
'writeclause'(:0, :1) :
   'not'('var'(:1)) .
   '='(:1, 'true') .
   '!' .
   'writeq'(:0) . []
   %% 0 Head, 1 Body,
'writeclause'(:0, :1) :
   'writeq'(':-'(:0, :1)) . []
   %% 0 Head, 1 Body,
% :::::::::::::::::::::::::::::::::::::::::::::::::::::::::
% - - - - - -             W R I T E             - - - - - -
% :::::::::::::::::::::::::::::::::::::::::::::::::::::::::
'write'(:0) :
   'side_effects'('outterm'(:0, 'noq')) . []
   %% 0 Term,
% writeq encloses in quotes all identifiers except words,
% symbols and solochars (not coinciding with "fix" functors)
'writeq'(:0) :
   'side_effects'('outterm'(:0, 'q')) . []
   %% 0 Term,
'writetext'(:0.:1) :
   '!' .
   'wch'(:0) .
   'writetext'(:1) . []
   %% 0 Ch, 1 Chs,
'writetext'([]) : []
'outterm'(:0, :1) :
   'numbervars'(:0, 1, _) .
   'outt'(:0, 'fd'(_, _), :1) . []
   %% 0 T, 1 Q,
% the real job is done here
'outt'('V'(:0), _, _) :
   'integer'(:0) .
   '!' .
   'wch'('X') .
   'display'(:0) . []
   %% 0 N,
% C A U T I O N :  outt is unable to write 'V'(Integer)
'outt'(:0, _, _) :
   'integer'(:0) .
   'display'(:0) .
   '!' . []
   %% 0 Term,
% the second parameter specifies a context for "fix" functors:
% the nearest external functor and Term's position
% (to the left or to the right of the external functor)
'outt'(:0, :1, :2) :
   '=..'(:0, :3.:4) .
   'outfun'(:3, :4, :1, :2) . []
   %% 0 Term, 1 Context, 2 Q, 3 Name, 4 Args,
% - - - output a functor-term
%   -  as a "fix" term
'outfun'(:0, :1, :2, :3) :
   'isfix'(:0, :1, :4, :5) .
   '!' .
   'outff'(:5, :4, :0.:1, :2, :3) . []
   %% 0 Name, 1 Args, 2 Context, 3 Q, 4 This_ff, 5 Kind,
%   -  as a list
'outfun'('.', :0.:1.[], _, :2) :
   '!' .
   'outlist'(:0.:1, :2) . []
   %% 0 Larg, 1 Rarg, 2 Q,
%   -  as a normal functor-term
'outfun'(:0, :1, _, :2) :
   'outname'(:0, :2) .
   'outargs'(:1, :2) . []
   %% 0 Name, 1 Args, 2 Q,
% isfix constructs a pair  ff(Prior, Associativity) , and
% 'in' or 'pre' or 'post' (fails if not a "fix" functor)
'isfix'(:0, _._.[], 'ff'(:1, :2), 'in') :
   'FF'(:0, :3, :1) .
   'mk_bin'(:3, :2) . []
   %% 0 Name, 1 Prior, 2 Assoc, 3 Types,
'isfix'(:0, _.[], 'ff'(:1, :2), :3) :
   'FF'(:0, :4, :1) .
   'mk_un'(:4, :3, :2) . []
   %% 0 Name, 1 Prior, 2 Assoc, 3 Kind, 4 Types,
% Bintype (if any) is before Untype (if any)
'mk_bin'(:0._, :1) :
   'binary'(:0, :1) . []
   %% 0 Bintype, 1 Assoc,
'mk_un'(:0.[], :1, :2) :
   'unary'(:0, :1, :2) . []
   %% 0 Untype, 1 Kind, 2 Assoc,
'mk_un'(_.:0.[], :1, :2) :
   'unary'(:0, :1, :2) . []
   %% 0 Untype, 1 Kind, 2 Assoc,
% tests - see  o p
% - - - output a "fix" term (this outff has 5 parameters)
'outff'(:0, :1, :2, :3, :4) :
   'agree'(:1, :3) .
   '!' .
   'outff'(:0, :1, :2, :4) . []
   %% 0 Kind, 1 This_ff, 2 NameArgs, 3 Context, 4 Q,
'outff'(:0, :1, :2, _, :3) :
   'wch'('(') .
   'outff'(:0, :1, :2, :3) .
   'wch'(')') . []
   %% 0 Kind, 1 This_ff, 2 NameArgs, 3 Q,
% agree helps avoid (some) unnecessary brackets around the term
'agree'(_, 'fd'(:0, _)) :
   'var'(:0) . []
   %% 0 Ext_ff,
'agree'('ff'(:0, _), 'fd'('ff'(:1, _), _)) :
   'stronger'(:0, :1) . []
   %% 0 Prior1, 1 Prior2,
% cf the parser
'agree'('ff'(:0, 'a'(:1)), 'fd'('ff'(:0, 'a'(:1)), :1)) : []
   %% 0 Prior, 1 Dir,
% output the functor and the arguments (this outff has 4 parameters)
'outff'('in', :0, :1.:2.:3.[], :4) :
   'outt'(:2, 'fd'(:0, 'l'), :4) .
   'outfn'(:1, ' ') .
   'outt'(:3, 'fd'(:0, 'r'), :4) . []
   %% 0 This_ff, 1 Name, 2 Larg, 3 Rarg, 4 Q,
'outff'('pre', :0, :1.:2.[], :3) :
   'outfn'(:1, ' ') .
   'outt'(:2, 'fd'(:0, 'r'), :3) . []
   %% 0 This_ff, 1 Name, 2 Arg, 3 Q,
'outff'('post', :0, :1.:2.[], :3) :
   'outt'(:2, 'fd'(:0, 'l'), :3) .
   'outfn'(:1, ' ') . []
   %% 0 This_ff, 1 Name, 2 Arg, 3 Q,
% output functor's name enclosed in Encl
'outfn'(:0, :1) :
   'wch'(:1) .
   'display'(:0) .
   'wch'(:1) . []
   %% 0 Name, 1 Encl,
% - - - print a name (in quotes, if necessary)
'outname'(:0, 'noq') :
   '!' .
   'display'(:0) . []
   %% 0 Name,
'outname'(:0, 'q') :
   'FF'(:0, _, _) .
   '!' .
   'outfn'(:0, '''') . []
   %% 0 Name,
'outname'(:0, 'q') :
   'pname'(:0, :1) .
   'check'('noq'(:1)) .
   '!' .
   'display'(:0) . []
   %% 0 Name, 1 Namestring,
'outname'(:0, 'q') :
   'outfn'(:0, '''') . []
   %% 0 Name,
'noq'(:0.:1) :
   'wordstart'(:0) .
   'isword'(:1) . []
   %% 0 Ch, 1 String,
'noq'(:0.[]) :
   'solochar'(:0) . []
   %% 0 Ch,
'noq'('['.']'.[]) : []
'noq'(:0.:1) :
   'symch'(:0) .
   'issym'(:1) . []
   %% 0 Ch, 1 String,
'isword'([]) : []
'isword'(:0.:1) :
   'alphanum'(:0) .
   'isword'(:1) . []
   %% 0 Ch, 1 String,
'issym'([]) : []
'issym'(:0.:1) :
   'symch'(:0) .
   'issym'(:1) . []
   %% 0 Ch, 1 String,
% - - - output a list of arguments (cf outfun)
'outargs'([], _) :
   '!' . []
'outargs'(:0, :1) :
   'fake'(:2) .
   'wch'('(') .
   'outargs'(:0, :2, :1) .
   'wch'(')') . []
   %% 0 Args, 1 Q, 2 Context,
'outargs'(:0.[], :1, :2) :
   '!' .
   'outt'(:0, :1, :2) . []
   %% 0 Last, 1 Context, 2 Q,
'outargs'(:0.:1, :2, :3) :
   'outt'(:0, :2, :3) .
   'display'(', ') .
   'outargs'(:1, :2, :3) . []
   %% 0 Arg, 1 Args, 2 Context, 3 Q,
% commas are used to delimit list items, so we must bracket commas
%   w i t h i n  items (it's a trick: we depend on ',' having
%   the priority 1000 and being associative)
'fake'('fd'('ff'(1000, 'na'(_)), _)) : []
% - - - output a list in square brackets (cf outfun - the main
%       functor is the dot, and the list cannot be empty)
'outlist'(:0.:1, :2) :
   'fake'(:3) .
   'wch'('[') .
   'outt'(:0, :3, :2) .
   'outlist'(:1, :3, :2) .
   'wch'(']') . []
   %% 0 First, 1 Tail, 2 Q, 3 Context,
'outlist'([], _, _) :
   '!' . []
'outlist'(:0.:1, :2, :3) :
   '!' .
   'display'(', ') .
   'outt'(:0, :2, :3) .
   'outlist'(:1, :2, :3) . []
   %% 0 Item, 1 Items, 2 Context, 3 Q,
% the bar and the closing item (still bracketed if it contains commas)
'outlist'(:0, :1, :2) :
   'display'(' | ') .
   'outt'(:0, :1, :2) . []
   %% 0 Closing, 1 Context, 2 Q,
% *********************************
% *********************************
% ***    T R A N S L A T O R    ***
% *********************************
% *********************************
% read a program upto  end.  and translate it into "kernel" form
'translate'(:0, :1) :
   'see'(:0) .
   'tell'(:1) .
   'nl' .
   'repeat' .
   'read'(:2) .
   'put'(:2) .
   'nl' .
   '='(:2, 'end') .
   '!' .
   'seen' .
   'told' .
   'see'('user') .
   'tell'('user') . []
   %% 0 Infile, 1 Outfile, 2 Clause,
% - - - produce and output the translation of one clause
'put'(':-'(:0, :1)) :
   '!' .
   'puthead'(:0, :2) .
   'putbody'(:1, :2) . []
   %% 0 Head, 1 Body, 2 Sym_tab,
'put'('-->'(:0, :1)) :
   '!' .
   'tag'('transl_rule'(:0, :1, ':-'(:2, :3))) .
   'puthead'(:2, :4) .
   'putbody'(:3, :4) . []
   %% 0 Left, 1 Right, 2 Head, 3 Body, 4 Sym_tab,
'put'(':-'(:0)) :
   '!' .
   'putbody'(:0, :1) .
   'wch'('#') .
   'nl' .
   'once'(:0) . []
   %% 0 Goal, 1 Sym_tab,
% a failure here wouldn't matter (cf translate)
'put'('end') :
   '!' . []
'put'('e r r') :
   '!' . []
'put'(:0) :
   'puthead'(:0, :1) .
   'putbody'('true', _) . []
   %% 0 Unitclause, 1 Sym_tab,
% - - - put a head call (it must be a functor-term)
'puthead'(:0, :1) :
   'nonvarint'(:0) .
   '!' .
   'putterm'(:0, :1) . []
   %% 0 Head, 1 Sym_tab,
'puthead'(:0, _) :
   'transl_err'(:0) . []
   %% 0 Head,
% - - - put a list of calls and [] at the end
'putbody'(:0, :1) :
   'punct'(':') .
   'conv_body'(:0, :2) .
   '!' .
   'putbody_c'(:2, :1) . []
   %% 0 Body, 1 Sym_tab, 2 B,
% see assert etc for  c o n v _ b o d y
'putbody_c'([], _) :
   '!' .
   'display'([]) . []
'putbody_c'(:0.:1, :2) :
   'not'('integer'(:0)) .
   '!' .
   'putterm'(:0, :2) .
   'punct'('.') .
   'putbody_c'(:1, :2) . []
   %% 0 Term, 1 Terms, 2 Sym_tab,
'putbody_c'(:0._, _) :
   'transl_err'(:0) . []
   %% 0 Term,
'punct'(:0) :
   'wch'(' ') .
   'wch'(:0) .
   'nl' .
   'display'('   ') . []
   %% 0 Ch,
% - - - put a term (with infix dots, and canonical otherwise)
'putterm'(:0, :1) :
   'var'(:0) .
   '!' .
   'lookup'(:0, :1, -1, :2) .
   'wch'(':') .
   'display'(:2) . []
   %% 0 Term, 1 Sym_tab, 2 N,
'putterm'(:0, _) :
   'integer'(:0) .
   '!' .
   'display'(:0) . []
   %% 0 Term,
'putterm'(:0.:1, :2) :
   '!' .
   'putterm_inlist'(:0, :2) .
   'display'(' . ') .
   'putterm'(:1, :2) . []
   %% 0 Head, 1 Tail, 2 Sym_tab,
'putterm'(:0, :1) :
   '=..'(:0, :2.:3) .
   'outfn'(:2, '''') .
   % cf WRITE
   'putargs'(:3, :1) . []
   %% 0 Term, 1 Sym_tab, 2 Name, 3 Args,
% Sym_tab is an open list of pairs  vn(Variable, Number)
% (this formulation helps avoid too many additions)
'lookup'(:0, :1, :2, :3) :
   'var'(:1) .
   '!' .
   'sum'(:2, 1, :3) .
   '='(:1, 'vn'(:0, :3).:4) . []
   %% 0 V, 1 S_t_end, 2 PreviousN, 3 N, 4 New_s_t_end,
'lookup'(:0, 'vn'(:1, :2)._, _, :2) :
   'eqvar'(:0, :1) .
   '!' . []
   %% 0 V, 1 CurrV, 2 CurrN,
'lookup'(:0, 'vn'(_, :1).:2, _, :3) :
   'lookup'(:0, :2, :1, :3) . []
   %% 0 V, 1 CurrN, 2 S_t_tail, 3 N,
% arguments - nothing, or a list of terms in parentheses
'putargs'([], _) :
   '!' . []
'putargs'(:0, :1) :
   'wch'('(') .
   'putarglist'(:0, :1) .
   'wch'(')') . []
   %% 0 Args, 1 Sym_tab,
'putarglist'(:0.[], :1) :
   '!' .
   'putterm'(:0, :1) . []
   %% 0 Arg, 1 Sym_tab,
'putarglist'(:0.:1, :2) :
   'putterm'(:0, :2) .
   'display'(', ') .
   'putarglist'(:1, :2) . []
   %% 0 Arg, 1 Args, 2 Sym_tab,
% - - - a list within a list must be enclosed in parentheses
'putterm_inlist'(:0, :1) :
   'nonvarint'(:0) .
   '='(:0, _._) .
   '!' .
   'wch'('(') .
   'putterm'(:0, :1) .
   'wch'(')') . []
   %% 0 Term, 1 Sym_tab,
'putterm_inlist'(:0, :1) :
   'putterm'(:0, :1) . []
   %% 0 Term, 1 Sym_tab,
% - - - error handling (only one error is discovered by translate)
'transl_err'(:0) :
   'nl' .
   'display'('+++ Bad head or call: ') .
   'display'(:0) .
   'nl' .
   'fail' . []
   %% 0 X,

: see(user) . ear . [] #
