% KERNEL file - character class encodings
ooooooooooooooooooooooooooooooooogjhhkhiefhmgmlhcccccccccchghhhh
haaaaaaaaaaaaaaaaaaaaaaaaaaehfhdhbbbbbbbbbbbbbbbbbbbbbbbbbbenfhp
%  opop table entries
AAAAEEA
DDCCBBC
DDCCBBC
AAAAEEA
AAAAEEA
AAAAFFA
AAAAFFA
% eqpr table entries
0002
0005
0060
1300
0000
0400
 
% standard atoms
';'/2   ','/2   '{}'/1   'call'/1   'tag'/1
'[]'/0   '.'/2   'error'/1    '#'/0   'user'/0
 
% op declaration pattern atoms
'fx'/0   'fy'/0   'xfy'/0   'xfx'/0   'yfx'/0   'yf'/0   'xf'/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
        'op'/3   'delop'/1
        'write'/1   'writeq'/1   'read'/1
        '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 - the first part
[ #, ordchr(10, Eoln), assert(iseoln(Eoln), [], 0),
                  assert(nl, [wch(Eoln)], 0)].
[ #, write('Just a minute...'), nl ].
 
% standard functors
[ #,
op( 1200, xfx, ':-'  ),
op( 1200,  fx, ':-'  ),
op( 1200, xfx, '-->' ),
op( 1100, xfy, ';'   ),
op(  900,  fy, 'not' ),
op(  700, xfx, '='   ),
op(  700, xfx, 'is'  ),
op(  700, xfx, '=:=' ),
op(  700, xfx, '=\=' ),
op(  700, xfx, '<'   ),
op(  700, xfx, '=<'  ),
op(  700, xfx, '>'   ),
op(  700, xfx, '>='  ),
op(  700, xfx, '@<' ),
op(  700, xfx, '@=<' ),
op(  700, xfx, '@>' ),
op(  700, xfx, '@>=' ),
op(  700, xfx, '=='  ),
op(  700, xfx, '\==' ),
op(  700, xfx, '=..' ),
op(  500, yfx, '+'   ),
op(  500,  fx, '+'   ),
op(  500, yfx, '-'   ),
op(  500,  fx, '-'   ),
op(  400, yfx, '*'   ),
op(  400, yfx, '/'   ),
op(  300, xfx, 'mod' )
].
 
% kernel library - continued
[ X = X ].
[ (X , Y),   call(X),  call(Y) ].
[ (X ; _),   call(X) ].
[ (_ ; Y),   call(Y) ].
 
[ not X,   call(X),  !,  fail ].
[ not _ ].
[ check(X),   not not X ].
[ side_effects(X),   not not X ].
 
[ once(X),   call(X),  ! ].
 
[ A @=< B,   not B @< A ].
[ A @> B,   B @< A ].
[ A @>= B,   not A @< B ].
 
% - - - - - - basic input procedures - - - - - -
[ rdchsk(Ch),   rch,  skipbl,  lastch(Ch) ].
[ rdch(Ch),   rch,  lastch(LCh),  sch(LCh, Ch) ].
% convert nonprintable characters to blanks
[ sch(Ch, Ch),   ' ' @< Ch,  '!' ].
[ sch(_, ' ') ].
 
[ writetext([Ch | Chs]),   !,  wch(Ch),  writetext(Chs) ].
[ writetext([]) ].
 
[ member(X, [X | L]) ].
[ member(X, [_ | L]),   member(X, L) ].
 
[ repeat ].
[ repeat, repeat ].
 
[ proc(X),   '$procinit',  '$pr'(X) ].
[ '$pr'(_),   '$proclimit',  !,  fail ].
[ '$pr'(X),   '$proc'(X) ].
[ '$pr'(X),   '$pr'(X) ].
 
%   b a g o f  (preserves order of solutions)
[ bagof(Item, Condition, _),   asserta('BAG'('BAG')),  call(Condition),
      asserta('BAG'(Item)),  fail ].
[ bagof(_, _, Bag),   'BAG'(Item),  intobag(Item, [], Bag) ].
[ intobag('BAG', Final_bag, Final_bag),   '!',  retract('BAG', 1, 1) ].
[ intobag(Item, This_bag, Final_bag),   retract('BAG', 1, 1),
        'BAG'(Next_item),  intobag(Next_item, [Item | This_bag], Final_bag) ].
 
[ setof(Item, Cond, Set),   bagof(Item, Cond, Bag),  unique(Bag, Set) ].
[ unique([], []),   ! ].
[ unique([E | Es], Set),   present(E, Es),  !,  unique(Es, Set) ].
[ unique([E | Es], [E | Set]),   unique(Es, Set) ].
[ present(E, [E1 | _]),   E == E1,  ! ].
[ present(E, [_ | Es]),   present(E, Es) ].
 
                % *********************************
                % *********************************
                % ***    L  I  B  R  A  R  Y    ***
                % *********************************
                % *********************************
% :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
% - - - - - -           =..  (read as "univ")           - - - - - -
% :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
[ X =.. Y,   var(X),  var(Y),  !,  error(X =.. Y) ].
[ Num =.. [Num],   integer(Num),  ! ].
[ Term =.. [Fun | Args],
        setarity(Term, Args, N),
        functor(Term, Fun, N),          % this works both ways
        not integer(Fun),               % we don't want eg  17(X)
        setargs(Term, Args, 0, N) ].      % this works both ways, too
 
[ setarity(Term, Args, N),   var(Term),  !,  length(Args, 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(_, [], N, N),   ! ].
[ setargs(Term, [Arg | Args], K, N),
        sum(K, 1, K1), arg(K1, Term, Arg),
        setargs(Term, Args, K1, N) ].
 
% find the length of a closed list; error if not closed
[ length(List, N),  length(List, 0, N) ].
 
% This is a tail-recursive formulation of length
[ length(L, _, _),   var(L),  !,  error(length(L, _)) ].
[ length([], N, N),   ! ].
[ length([_ | List], K, N),
        !,  sum(K, 1, K1),  length(List, K1, N) ].
[ length(Bizarre, _, _),   error(length(Bizarre, _)) ].
 
% bind every variable to a distinct 'V'(N)
[ numbervars('V'(N), N, NextN),   !,  sum(N, 1, NextN) ].
[ numbervars('V'(_), N, N),   ! ].
[ numbervars(X, N, N),   integer(X),  ! ].
[ numbervars(X, N, NextN),   numbervars(X, 1, N, NextN) ].
 
[ numbervars(X, K, N, NextN),
        arg(K, X, A),  !,  numbervars(A, N, MidN),
        sum(K, 1, K1),  numbervars(X, K1, MidN, NextN) ].
[ numbervars(_, _, N, N) ].
 
 
% :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
% - - - - - -       EVALUATE AN ARITHMETIC EXPRESSION       - - - - - -
% :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
[ N is N,   integer(N),  ! ].
[ Val is A+B,
        !,  Av is A,  Bv is B,  sum(Av, Bv, Val) ].
[ Val is A-B,
        !,  Av is A,  Bv is B,  sum(Bv, Val, Av) ].
[ Val is A*B,
        !,  Av is A,  Bv is B,  prod(Av, Bv, 0, Val) ].
[ Val is A/B,
        !,  Av is A,  Bv is B,  is_err(Bv, Val is A/B),
        prod(Bv, Val, _, Av) ].
[ Val is A mod B,
        !,  Av is A,  Bv is B,  is_err(Bv, Val is A mod B),
        prod(Bv, _, Val, Av) ].
[ Val is +A,   !,  Val is A ].
[ Val is -A,   !,  Av is A,  sum(Val, Av, 0) ].
[ N is [N],   integer(N) ].
% otherwise  f a i l
 
[ is_err(0, Call),   !,  error(Call) ].
[ is_err(_, _) ].
 
% - - - - - - EVALUATE AN ARITHMETIC RELATION - - - - - -
[ X =:= Y,   XV is X,  XV is Y ].
[ X <  Y,    XV is X,  YV is Y,  less(XV, YV) ].
[ X =< Y,    XV is X,  YV is Y,  not less(YV, XV) ].
[ X >  Y,    XV is X,  YV is Y,  less(YV, XV) ].
[ X >= Y,    XV is X,  YV is Y,  not less(XV, YV) ].
[ X =\= Y,   not X =:= Y ].
 
% :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
% - - - - - -         PERFECT EQUALITY OF TERMS         - - - - - -
% :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
[ T1 == T2,    var(T1),  var(T2),  !,  eqvar(T1, T2) ].
[ T1 == T2,    check(==?(T1, T2)) ].
 
[ T1 \== T2,   not ==?(T1, T2) ].
 
[ ==?(T1, T2),
        integer(T1),  integer(T2),  !,  T1 = T2 ].
[ ==?(T1, T2),
        nonvarint(T1),  nonvarint(T2),
        functor(T1, Fun, Arity),  functor(T2, Fun, Arity),
        equalargs(T1, T2, 1) ].
 
[ equalargs(T1, T2, Argnumber),
        arg(Argnumber, T1, Arg1),  arg(Argnumber, T2, Arg2),
                % arg fails given too large a number
        !,  Arg1 == Arg2,  sum(Argnumber, 1, Nextnumber),
        equalargs(T1, T2, Nextnumber) ].
[ equalargs(_, _, _) ].
 
% :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
% - - - - - -   assert, asserta, assertz, retract, clause   - - - - - -
% :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
% - - - add a clause (using built-in assert(_, _, _))
[ assert(Cl),   asserta(Cl) ].
[ asserta(Cl),
        nonvarint(Cl),  convert(Cl, Head, Body),  !,
        assert(Head, Body, 0) ].
[ asserta(Cl),    error(asserta(Cl)) ].
 
[ assertz(Cl),
        nonvarint(Cl),  convert(Cl, Head, Body),  !,
        assert(Head, Body, 32767) ].      % ie  2 to 15th minus 1
[ assertz(Cl),   error(assertz(Cl)) ].
 
% convert the external form of a Body into a dotted list
[ convert((Head :- B), Head, Body),  !,  conv_body(B, Body) ].
[ convert(Unit_cl, Unit_cl, []) ].
 
% this procedure works both ways
[ conv_body(B, [call(B)]),  var(B),  ! ].
[ conv_body(true, []),  ! ].
[ conv_body(B, Body),  conv_b(B, Body) ].
 
[ conv_b(B, [Body]),  var(B),  !,  conv_call(B, Body) ].
[ conv_b((C, B), [Call | Body]),
        !,  conv_call(C, Call),  conv_b(B, Body) ].
[ conv_b(Call, [Call]) ].   % not a variable
 
% interpreter can process variable calls only within  c a l l
[ conv_call(C, call(C)),  var(C),  ! ].
[ conv_call(C, C) ].
 
% - - - remove a clause (this procedure is backtrackable)
[ retract(Cl),
        nonvarint(Cl),  convert(Cl, Head, Body),  !,
        functor(Head, Fun, Arity),  remcls(Fun, Arity, 1, Head, Body) ].
[ retract(Cl),  error(retract(Cl)) ].
 
% ultimate failure if N too big (retract/3 fails)
[ remcls(Fun, Arity, N, Head, Body),
        clause(Fun, Arity, N, N_head, N_body),
        remcls(Fun, Arity, N, N_head, Head, N_body, Body) ].
 
[ remcls(Fun, Arity, N, Head, Head, Body, Body),
        retract(Fun, Arity, N) ].
% user's backtracking resumes  r e t r a c t  here
% (after removing the Nth clause the next becomes Nth)
[ remcls(Fun, Arity, N, N_head, Head, N_body, Body),
        check(N_head = Head),  check(N_body = Body),
        !,  remcls(Fun, Arity, N, Head, Body) ].
[ remcls(Fun, Arity, N, _, Head, _, Body),
        sum(N, 1, N1),  remcls(Fun, Arity, N1, Head, Body) ].
 
% - - - generate nondeterministically all clauses whose head
%       and body match the parameters of  c l a u s e
[ clause(Head, Body),
        nonvarint(Head),  !,  functor(Head, Fun, Arity),
        gencls(Fun, Arity, 1, Head, Body) ].
[ clause(Head, Body),   error(clause(Head, Body)) ].
 
% generate; ultimate failure if N too big (clause/5 fails)
[ gencls(Fun, Arity, N, Head, Body),
        clause(Fun, Arity, N, N_head, N_body),
        gencls(Fun, Arity, N, N_head, Head, N_body, Body) ].
 
% fail if N_head does not match Head,
%       or if N_body converted does not match Body
[ gencls(_, _, _, N_head, N_head, N_body, Body),
        conv_body(Body, N_body) ].
% user's backtracking resumes  c l a u s e  here
[ gencls(Fun, Arity, N, _, Head, _, Body),
        sum(N, 1, N1),  gencls(Fun, Arity, N1, Head, Body) ].
 
% :::::::::::::::::::::::::::::::::::::::::::::::::::::::
% - - - - - -             LISTING             - - - - - -
% :::::::::::::::::::::::::::::::::::::::::::::::::::::::
% list procedures determined by the parameter ( listing(_) )
%       or all user's procedures ( listing )
[ listing,
        proc(Head),  listproc(Head),  nl,  fail ].
[ listing ].        % catch the final fail from  p r o c
 
[ listing(Fun),   atom(Fun),  !,  listbyname(Fun) ].
[ listing(Fun/Arity),
        atom(Fun),  integer(Arity),  less(-1, Arity),  !,
        functor(Head, Fun, Arity),  listproc(Head) ].
[ listing(L),
        isclosedlist(L),  listseveral(L),  ! ].
[ listing(X),   error(listing(X)) ].
                % isclosedlist - cf grammar rule preprocessor
 
[ listseveral([]) ].
[ listseveral([ Item | Items]),
        listing(Item),  listseveral(Items) ].
 
% all procedures with this name
[ listbyname(Fun),
        proc(Head),  functor(Head, Fun, _),
        listproc(Head),  nl,  fail ].
[ listbyname(_) ].          % succeed
 
% one procedure
[ listproc(Head),
        clause(Head, Body),
        writeclause(Head, Body),  wch(.),  nl,  fail ].
[ listproc(_) ].            % succeed
 
[ writeclause(Head, Body),
        not var(Body),  Body = true,  !,  writeq(Head) ].
[ writeclause(Head, Body),    writeq((Head :- Body)) ].
 
% :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
% - - - - - -         GRAMMAR RULE PREPROCESSOR         - - - - - -
% :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
[ transl_rule(Left, Right, Clause),
        two_ok(Left, Right),
        isolate_lhs_t(Left, Nont, Lhs_t),
        connect(Lhs_t, Outpar, Finalvar),
        expand(Nont, Initvar, Outpar, Head),
        makebody(Right, Initvar, Finalvar, Body, Alt_flag),
        do_clause( Body, Head, Clause) ].
 
[ do_clause(true, Head, Head),   ! ].
[ do_clause(Body, Head, (Head :- Body)) ].
 
% Lhs_t is a list (possibly empty) of lefthand side terminals
[ isolate_lhs_t((Nont, Lhs_t), Nont, Lhs_t),
        (nonvarint(Nont); rulerror(varint)),
        (isclosedlist(Lhs_t); rulerror(ter)),  ! ].
[ isolate_lhs_t(Nont, Nont, []) ].
 
% fail if not a closed list
[ isclosedlist(L),   check(iscll(L)) ].
[ iscll(L),   var(L),  !,  fail ].
[ iscll([]) ].
[ iscll([_ | L]),   iscll(L) ].
 
% connect terminals to the nearest nonterminal's input parameter
% (actually, "open" a closed list)
[ connect([], Nextvar, Nextvar),   ! ].
[ connect([Tsym | Tsyms], [Tsym | Outpar], Nextvar),
        connect(Tsyms, Outpar, 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((Alt; Alts), Initvar, Finalvar,
         ((' dummy'(Initvar, Nextvar), Alt_b); Alt_bs), _),
        !,  two_ok(Alt, Alts),
        makeright(Alt, Nextvar, Finalvar, Alt_b),
        makebody(Alts, Initvar, Finalvar, Alt_bs, alt) ].
[ makebody(Right, Initvar, Finalvar, Body, Alt_flag),
        var(Alt_flag),  !,            % only one alternative
        makeright(Right, Initvar, Finalvar, Body) ].
[ makebody(Right, Initvar, Finalvar,
         (' dummy'(Initvar, Nextvar), Body), alt),
        makeright(Right, Nextvar, Finalvar, Body) ].
 
% - - - translate one alternative
[ makeright((Item, Items), Thispar, Finalvar, T_item_items),
        !,  two_ok(Item, Items),
        transl_item(Item, Thispar, Nextvar, T_item),
        makeright(Items, Nextvar, Finalvar, T_items),
        combine(T_item, T_items, T_item_items) ].
[ makeright(Item, Thispar, Finalvar, T_item),
        transl_item(Item, Thispar, Finalvar, T_item) ].
 
[ combine(true, T_items, T_items),   ! ].
[ combine(T_item, true, T_item),   ! ].
[ combine(T_item, T_items, (T_item, T_items)) ].
 
% - - - translate one item (sure to be a functor-term)
[ transl_item(Terminals, Thispar, Nextvar, true),
        isclosedlist(Terminals),
        !,  connect(Terminals, Thispar, Nextvar) ].
% conditions (the cut and others)
[ transl_item(!, Thispar, Thispar, !),   ! ].
[ transl_item('{}'(Cond), Thispar, Thispar, call(Cond)),   ! ].
% bad list of terminals (missed the first clause)
[ transl_item([_ | _], _, _, _),   rulerror(ter) ].
% a nested alternative
[ transl_item(';'(X, Y), Thispar, Nextvar, Transl),
        !,  makebody(';'(X, Y), Thispar, Nextvar, Transl, _) ].
% finally, a regular nonterminal
[ transl_item(Nont, Thispar, Nextvar, Transl),
        expand(Nont, Thispar, Nextvar, Transl) ].
 
% add input parameter and output parameter
[ expand(Nont, In_par, Out_par, Call),
        Nont =.. [Fun | Args],
        Call =.. [Fun, In_par, Out_par | Args] ].
 
% - - - error handling
[ two_ok(X, Y),   nonvarint(X),  nonvarint(Y),  ! ].
[ two_ok(_, _),   rulerror(varint) ].
 
[ rulerror(Message),
        nl,  display('+++ Error in this rule: '),  mes(Message),  nl,
        tagfail(transl_rule(_, _, _)) ].
% 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(Nont, Terminals),
        nonvarint(Nont),  !,
        expand(Nont, Terminals, [], Init_call),
        call(Init_call) ].
[ phrase(N, T),   error(phrase(N, T)) ].
 
[ ' dummy'(X, X) ].
 
% :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
% - - - - - -          INTERACTIVE DRIVER - TOP LEVEL         - - - - - -
% :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
[ ear,   nl,  display('Toy-Prolog listening:'),  nl,  tag(loop) ].
[ ear,   halt('Toy-Prolog, end of session.') ].
 
[ loop,   repeat,  tag(step),  fail ].
 
[ step,   display('?- '),  read(Term),  exec(Term) ].
 
[ stop,   tagfail(loop) ].
 
[ abort,   tagfail(step) ].
 
[ exec('e r r'),    ! ].                % this covers variables, too
[ exec(:-Goals),    !,  once(Goals) ].
[ exec(N),    integer(N),  !,  num_clause ].
[ exec(Goals),   
	extract_vars(Goals, [], Vars),
	call(Goals),  numbervars(Goals, 0, _),
	printvars(Vars),  rch,  enough,  ! ].
[ exec(_),    display(no),  nl ].        % if call(Goals) fails

[ enough,   lastch(Ch),  iseoln(Ch)  ].
[ enough,   skipbl,  lastch(Ch),  rch,  not Ch = ';' ].

[ extract_vars(Var, Vars, Vars_final),
	var(Var),  !,  add_var(Var, Vars, Vars_final) ].
[ extract_vars(Term, Vars, Vars_final),
	nonvarint(Term),  not atom(Term),  !,
	Term =.. [_ | Args],
	extr_vars_list(Args, Vars, Vars_final) ].
[ extract_vars(_, Vars, Vars) ].

[ extr_vars_list([Arg | Args], Vars, Vars_final),
	!,  extract_vars(Arg, Vars, NextVars),
	extr_vars_list(Args, NextVars, Vars_final) ].
[ extr_vars_list([], Vars, Vars) ].

[ add_var(Var, [], [Var]),  ! ].
[ add_var(Var, [FirstVar | Vars], [FirstVar | Vars]),
	Var == FirstVar,  ! ].
[ add_var(Var, [FirstVar | Vars], [FirstVar | Vars_plus]),
	add_var(Var, Vars, Vars_plus) ].

[ printvars([]),    display(yes),  ! ].
[ printvars(Vars),    prvars(Vars) ].

[ prvars([Var | Vars]),   
	!,  nl,  display(':: '),  writeq(Var),
	prvars(Vars) ].
[ prvars([]) ].
 
[ 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 terminal, and it returns
% there ( consult(user) is correct, too ).
[ consult(File),   readprog(File) ].
[ reconsult(File),   redefine,  readprog(File),  redefine ].
[ readprog(File),
      see(File),  getprog,  seen,  see(user) ].
 
% the actual job is done by this procedure
[ getprog,   repeat,  read(Term),  assimilate(Term),  Term = end,  ! ].
 
[ assimilate('e r r'),   ! ].
[ assimilate( (Left --> Right) ),
        !,  tag(transl_rule(Left, Right, Clause)),  assertz(Clause) ].
[ assimilate( (:-Goal) ),   !,  exc(Goal) ].
[ assimilate(end),   ! ].
[ assimilate(N),   integer(N),  !,  num_clause ].
% otherwise - store the clause
[ assimilate(Clause),   assertz(Clause) ].
 
[ exc('e r r'),    ! ].                % this covers variables, too
[ exc(N),    integer(N),  !,  num_clause ].
[ exc(Goal),    once(Goal) ].

% p(reprocessor of) g(rammar) r(ules)
[ pgr( InFile, OutFile ),
            see( InFile ),  tell( OutFile ),
        repeat,
            read( T ),        % comments will be lost...
            nonvarint( T ),   % ignore variables and integers
            transl( T, Cl ),
            writeq( Cl ),  wch( '.' ),  nl,
            Cl = end,  !,
            see( user ),  tell( user ) ].
[ transl( ( L --> R ), Cl ),
            !,  tag( transl_rule( L, R, Cl ) ) ].
[ transl( (:- Goals), (:- Goals) ),
            !,  once( Goals ) ].
[ transl( Cl, Cl ) ].
% % % % % % % % % % % % % % % % % % % % % % %
 
[ #, protect ].
[ error(Call), nl, display('+++ System call error: '), writeq(Call),
        nl, fail].
 
% YAZDA!!!
[ #, see(user), tell(user), ear ].
