%   read_tokens(TokenList, Dictionary)
%   returns a list of tokens.  It is needed to "prime" read_tokens/2
%   with the initial blank, and to check for end of file.  The
%   Dictionary is a list of AtomName=Variable pairs in no particular order.
%   The dictionary is not used if Dictionary is initialised to 0.
%   The way end of file is handled is that everything else FAILS when it
%   hits character "26".
%  Strings are read as lists of characters, NOT as Prolog-X strings.

read_tokens(TokenList, Dictionary) :-
 read_tokens(32, Dict, ListOfTokens),
 append(Dict, [], Dict), !, %  fill in the "hole" at the end
 Dictionary = Dict,  %  unify explicitly so we'll read and
 TokenList = ListOfTokens. %  then check even with filled in arguments
read_tokens([atom(end_of_file)], []). %  End Of File is all that can go wrong



/*
read_tokens(26, _, _) :- !,   %  26 is the end-of-file character
 fail.     %  in every standard Prolog
*/
read_tokens(26,_,[atom(end_of_file)]) :- !.
read_tokens(Ch, Dict, Tokens) :-
 Ch =< 32,    %  ignore layout.  CR, LF, and the
 !,     %  Dec-10 newline character (31)
 tokenread(Ch,_,NextCh),   %  are all skipped here.
 read_tokens(NextCh, Dict, Tokens).
read_tokens(37, Dict, Tokens) :- !,  %  %comment
        tokenread(37,_,NextCh),
 read_tokens(NextCh, Dict, Tokens).
read_tokens(47, Dict, Tokens) :- !,  %  /*comment?
 tokenread(47,Item,NextCh),
 after_sl(Item,NextCh,Dict,Tokens).
read_tokens(33, Dict, [atom(!)|Tokens]) :- !, %  This is a special case so
 get0(NextCh),    %  that !. reads as two tokens.
 read_after_atom(NextCh, Dict, Tokens). %  It could be cleverer.
read_tokens(40, Dict, [' ('|Tokens]) :- !, %  NB!!!
 get0(NextCh),
 read_tokens(NextCh, Dict, Tokens).
read_tokens(41, Dict, [')'|Tokens]) :- !,
 get0(NextCh),
 read_tokens(NextCh, Dict, Tokens).
read_tokens(44, Dict, [','|Tokens]) :- !,
 get0(NextCh),
 read_tokens(NextCh, Dict, Tokens).
read_tokens(59, Dict, [atom((;))|Tokens]) :- !, %   ; is nearly a punctuation
 get0(NextCh),    %   mark but not quite (e.g.
 read_tokens(NextCh, Dict, Tokens). %   you can :-op declare it).
read_tokens(91, Dict, ['['|Tokens]) :- !,
 get0(NextCh),
 read_tokens(NextCh, Dict, Tokens).
read_tokens(93, Dict, [']'|Tokens]) :- !,
 get0(NextCh),
 read_tokens(NextCh, Dict, Tokens).
read_tokens(123, Dict, ['{'|Tokens]) :- !,
 get0(NextCh),
 read_tokens(NextCh, Dict, Tokens).
read_tokens(124, Dict, ['|'|Tokens]) :- !,
 get0(NextCh),
 read_tokens(NextCh, Dict, Tokens).
read_tokens(125, Dict, ['}'|Tokens]) :- !,
 get0(NextCh),
 read_tokens(NextCh, Dict, Tokens).
read_tokens(46, Dict, Tokens) :- !,  %  full stop
 tokenread(46, Item, NextCh),
 after_fs(Item,NextCh,Dict,Tokens).
read_tokens(34, Dict, [string(S)|Tokens]) :- !, %  "string"
 read_string(S,34,NextCh),
 read_tokens(NextCh, Dict, Tokens).
read_tokens(39, Dict, [atom(A)|Tokens]) :- !, %  'atom'
 tokenread(39,A,NextCh),
 read_after_atom(NextCh, Dict, Tokens).
read_tokens(Ch, Dict, [var(Var,Name)|Tokens]) :-
        char_class(Ch,Cl),
        2 =< Cl, Cl =< 3,
        !,
 tokenread(Ch, Name, NextCh),
        read_lookup(Dict,Name=Var),
        !,
 read_tokens(NextCh, Dict, Tokens).
read_tokens(Ch, Dict, [integer(I)|Tokens]) :-
        48 =< Ch, Ch =< 57,
 !,
 tokenread(Ch, I, NextCh),
 read_tokens(NextCh, Dict, Tokens).
read_tokens(Ch, Dict, [atom(A)|Tokens]) :-
 Ch >= 97, Ch =< 122,   %  a..z
 !,
 tokenread(Ch, A, NextCh),
 read_after_atom(NextCh, Dict, Tokens).
read_tokens(Ch, Dict, [atom(A)|Tokens]) :- % THIS MUST BE THE LAST CLAUSE
 tokenread(Ch, A, NextCh), % might read 0 chars
 read_after_atom(NextCh, Dict, Tokens).


/* similar to read_tokens, but understands ' (' and '('. */

read_after_atom(40, Dict, ['('|Tokens]) :- !,
 get0(NextCh),
 read_tokens(NextCh, Dict, Tokens).
read_after_atom(Ch, Dict, Tokens) :-
 read_tokens(Ch, Dict, Tokens).


/*  read_string: does not translate into Prolog-X strings. */

read_string(C,Q,N) :- get0(Ch), read_string(Ch,C,Q,N).

read_string(26,[],_,26) :- !.
read_string(Q,C,Q,N) :- get0(Ch), more_string(Ch,Q,C,N).
read_string(C,[C|Cs],Q,N) :- read_string(Cs,Q,N).

more_string(Q,Q,[Q|Cs],N) :- !, read_string(Cs,Q,N).
more_string(N,_,[],N).


/*
  What to do after having read something beginning with '/'.
  case 1 (comment): tokenread returns dummy item (an INT) and NextChar.
  case 2 (sign): tokenread returns the atom and NextChar.
*/

after_sl(I,Char,Dict,Tokens) :- integer(I), !, read_tokens(Char,Dict,Tokens).
after_sl(Atom,Char,Dict,[atom(Atom)|Tokens]) :-
 read_after_atom(Char,Dict,Tokens).



/*
  What to do after a full stop.  tokenread returns an item and NextChar.
  case 1 (eof):  NextChar is a 26.  Warning.
  case 2 (normal): NextChar is a blank.  End of recursion.
  case 3 (sign):  Item is an atom beginning with '.'.  Carry on with NextChar.
*/

after_fs(_,26,_,[]) :- !.
after_fs(_,Ch,_,[]) :- Ch =< 32, !.
after_fs(Item,C,Dict,[atom(Item)|Tokens]) :- read_after_atom(C,Dict,Tokens).


/*  lookup/construct variable dictionary entry (but not for '_'s). */

read_lookup(_,'_'=_) :- !.
read_lookup([X|_], X) :- !.
read_lookup([_|T], X) :- read_lookup(T,X).
/*
  READ.  Original by David Warren, modified by Alan Mycroft, Richard O'Keefe,
  and W F Clocksin.
*/


read(X) :- read(X,_).

read(Answer, Variables) :-
 repeat,
 read_tokens(Tokens,Variables),
 read_catch(Tokens,Term),
 !,
 Answer = Term.

read_catch(Tokens,Term) :-
 read(Tokens,1200,Term,Leftover),
 all_read(Leftover).
read_catch(Tokens,_) :- syntax_error(Tokens).


%   checks that there are no unparsed tokens left over.

all_read([]) :- !.
all_read(S) :-
 % operator expected after expression
 syntax_error(1,no_culprit,S).


%   expect(Token, TokensIn, TokensOut)
%   reads the next token, checking that it is the one expected, and
%   giving an error message if it is not.  It is used to look for
%   right brackets of various sorts, as they're all we can be sure of.

expect(Token, [Token|Rest], Rest) :- !.
expect(Token, S0, _) :-
        % Token or operator expected
 syntax_error(2,Token,S0).


%   read(+TokenList, +Precedence, -Term, -LeftOver)
%   parses a Token List in a context of given Precedence,
%   returning a Term and the unread Left Over tokens.

read([Token|RestTokens], Precedence, Term, LeftOver) :-
 read(Token, RestTokens, Precedence, Term, LeftOver).
read([], _, _, _) :-
        % expression expected
 syntax_error(3,no_culprit,[]).


%   read(+Token, +RestTokens, +Precedence, -Term, -LeftOver)

/*
read(var(Variable,_), ['('|S1], Precedence, Answer, S) :- !,
 read(S1, 999, Arg1, S2),
 read_args(S2, RestArgs, S3), !,
 exprtl0(S3, apply(Variable,[Arg1|RestArgs]), Precedence, Answer, S).
*/

read(var(Variable,_), S0, Precedence, Answer, S) :- !,
 exprtl0(S0, Variable, Precedence, Answer, S).

read(atom(-), [integer(Integer)|S1], Precedence, Answer, S) :-
 Negative is -Integer, !,
 exprtl0(S1, Negative, Precedence, Answer, S).

read(atom(Functor), ['('|S1], Precedence, Answer, S) :- !,
 read(S1, 999, Arg1, S2),
 read_args(S2, RestArgs, S3, 1, Arity),
 functor(Term,Functor,Arity),
 arg(1,Term,Arg1),
 fillrest(RestArgs,2,Term),
 !,
 exprtl0(S3, Term, Precedence, Answer, S).

read(atom(Functor), S0, Precedence, Answer, S) :-
 current_op(Functor,Right,Prec,_,_,prefix), !,
 after_prefix_op(Functor, Prec, Right, S0, Precedence, Answer, S).

read(atom(Atom), S0, Precedence, Answer, S) :- !,
 exprtl0(S0, Atom, Precedence, Answer, S).

read(integer(Integer), S0, Precedence, Answer, S) :- !,
 exprtl0(S0, Integer, Precedence, Answer, S).

read('[', [']'|S1], Precedence, Answer, S) :- !,
 exprtl0(S1, [], Precedence, Answer, S).

read('[', S1, Precedence, Answer, S) :- !,
 read(S1, 999, Arg1, S2),
 read_list(S2, RestArgs, S3), !,
 exprtl0(S3, [Arg1|RestArgs], Precedence, Answer, S).

read('(', S1, Precedence, Answer, S) :- !,
 read(S1, 1200, Term, S2),
 expect(')', S2, S3), !,
 exprtl0(S3, Term, Precedence, Answer, S).

read(' (', S1, Precedence, Answer, S) :- !,
 read(S1, 1200, Term, S2),
 expect(')', S2, S3), !,
 exprtl0(S3, Term, Precedence, Answer, S).

read('{', ['}'|S1], Precedence, Answer, S) :- !,
 exprtl0(S1, '{}', Precedence, Answer, S).

read('{', S1, Precedence, Answer, S) :- !,
 read(S1, 1200, Term, S2),
 expect('}', S2, S3), !,
 exprtl0(S3, '{}'(Term), Precedence, Answer, S).

read(string(List), S0, Precedence, Answer, S) :- !,
 exprtl0(S0, List, Precedence, Answer, S).

read(Token, S0, _, _, _) :-
        % Token cannot start an expression
 syntax_error(4,Token,S0).


fillrest([],_,_).
fillrest([A|L],N,T) :- arg(N,T,A), succ(N,N1), fillrest(L,N1,T).


%   read_args(+Tokens, -TermList, -LeftOver)
%   parses {',' expr(999)} ')' and returns a list of terms.

read_args([','|S1], [Term|Rest], S, N, N1) :- !,
 read(S1, 999, Term, S2), !,
 succ(N,Ns),
 read_args(S2, Rest, S, Ns, N1).
read_args([')'|S], [], S, N, N) :- !.
read_args(S, _, _, _, _) :-
        % , or ) expected in arguments
 syntax_error(5,no_culprit,S).


%   read_list(+Tokens, -TermList, -LeftOver)
%   parses {',' expr(999)} ['|' expr(999)] ']' and returns a list of terms.

read_list([','|S1], [Term|Rest], S) :- !,
 read(S1, 999, Term, S2), !,
 read_list(S2, Rest, S).
read_list(['|'|S1], Rest, S) :- !,
 read(S1, 999, Rest, S2), !,
 expect(']', S2, S).
read_list([']'|S], [], S) :- !.
read_list(S, _, _) :-
        % , or | or ] expected in list
 syntax_error(6,no_culprit,S).


%   after_prefix_op(+Op, +Prec, +ArgPrec, +Rest, +Precedence, -Ans, -LeftOver)

after_prefix_op(Op, Oprec, Aprec, S0, Precedence, _, _) :-
 Precedence < Oprec, !,
        % prefix operator Op in context with precedence Precedence
 syntax_error(7,(Op,Precedence),S0).

after_prefix_op(Op, Oprec, Aprec, S0, Precedence, Answer, S) :-
 peepop(S0, S1),
 prefix_is_atom(S1, Oprec), % can't cut but would like to
 exprtl(S1, Oprec, Op, Precedence, Answer, S).

after_prefix_op(Op, Oprec, Aprec, S1, Precedence, Answer, S) :-
 read(S1, Aprec, Arg, S2),
 functor(Term,Op,1), arg(1,Term,Arg), !,
 exprtl(S2, Oprec, Term, Precedence, Answer, S).


%   The next clause fixes a bug concerning "mop dop(1,2)" where
%   mop is monadic and dop dyadic with higher Prolog priority.

peepop([atom(F),'('|S1], [atom(F),'('|S1]) :- !.
peepop([atom(F)|S1], [infixop(F,L,P,R)|S1]) :- current_op(F,L,P,R,_,infix).
peepop([atom(F)|S1], [postfixop(F,L,P)|S1]) :- current_op(F,L,P,_,_,postfix).
peepop(S0, S0).


%   prefix_is_atom(+TokenList, +Precedence)
%   is true when the right context TokenList of a prefix operator
%   of result precedence Precedence forces it to be treated as an
%   atom, e.g. (- = X), p(-), [+], and so on.

prefix_is_atom([Token|_], Precedence) :-
 prefix_is_atom(Token, Precedence).

prefix_is_atom(infixop(_,L,_,_), P) :- L >= P.
prefix_is_atom(postfixop(_,L,_), P) :- L >= P.
prefix_is_atom(')', _).
prefix_is_atom(']', _).
prefix_is_atom('}', _).
prefix_is_atom('|', P) :- 1100 >= P.
prefix_is_atom(',', P) :- 1000 >= P.
prefix_is_atom([],  _).


%   exprtl0(+Tokens, +Term, +Prec, -Answer, -LeftOver)
%   is called by read/4 after it has read a primary (the Term).
%   It checks for following postfix or infix operators.

exprtl0([atom(F)|S1], Term, Precedence, Answer, S) :-
 current_op(F,L2,O2,_,_,postfix),
 current_op(F,L1,O1,R1,_,infix),
 !,
 (   exprtl([infixop(F,L1,O1,R1)|S1], 0, Term, Precedence, Answer, S)
 ;   exprtl([postfixop(F,L2,O2) |S1], 0, Term, Precedence, Answer, S)
 ).
exprtl0([atom(F)|S1], Term, Precedence, Answer, S) :-
 current_op(F,L1,O1,R1,_,infix), !,
 exprtl([infixop(F,L1,O1,R1)|S1], 0, Term, Precedence, Answer, S).
exprtl0([atom(F)|S1], Term, Precedence, Answer, S) :-
 current_op(F,L2,O2,_,_,postfix), !,
 exprtl([postfixop(F,L2,O2) |S1], 0, Term, Precedence, Answer, S).

exprtl0([','|S1], Term, Precedence, Answer, S) :-
 Precedence >= 1000, !,
 read(S1, 1000, Next, S2), !,
 exprtl(S2, 1000, (Term,Next), Precedence, Answer, S).

exprtl0(['|'|S1], Term, Precedence, Answer, S) :-
 Precedence >= 1100, !,
 read(S1, 1100, Next, S2), !,
 exprtl(S2, 1100, (Term;Next), Precedence, Answer, S).

exprtl0([Thing|S1], _, _, _, _) :-
 cant_follow_expr(Thing, Culprit), !,
        % Culprit follows expression
 syntax_error(8,Culprit,[Thing|S1]).

exprtl0(S, Term, _, Term, S).


cant_follow_expr(atom(_), atom).
cant_follow_expr(var(_,_), variable).
cant_follow_expr(integer(_), integer).
cant_follow_expr(string(_), string).
cant_follow_expr(' (',  bracket).
cant_follow_expr('(',  bracket).
cant_follow_expr('[',  bracket).
cant_follow_expr('{',  bracket).



exprtl([infixop(F,L,O,R)|S1], C, Term, Precedence, Answer, S) :-
 Precedence >= O, C =< L, !,
 read(S1, R, Other, S2),
 functor(Expr,F,2), arg(1,Expr,Term), arg(2,Expr,Other),
 exprtl(S2, O, Expr, Precedence, Answer, S).

exprtl([postfixop(F,L,O)|S1], C, Term, Precedence, Answer, S) :-
 Precedence >= O, C =< L, !,
 functor(Expr,F,1), arg(1,Expr,Term),
 peepop(S1, S2),
 exprtl(S2, O, Expr, Precedence, Answer, S).

exprtl([','|S1], C, Term, Precedence, Answer, S) :-
 Precedence >= 1000, C < 1000, !,
 read(S1, 1000, Next, S2), /*!,*/
 exprtl(S2, 1000, (Term,Next), Precedence, Answer, S).

exprtl(['|'|S1], C, Term, Precedence, Answer, S) :-
 Precedence >= 1100, C < 1100, !,
 read(S1, 1100, Next, S2), /*!,*/
 exprtl(S2, 1100, (Term;Next), Precedence, Answer, S).

exprtl(S, _, Term, _, Term, S).


/* Syntax errors.  Tricky.  Uses some of the Warning code in pip.pro */

syntax_error(N,Culprit,Context) :-
 tokenput('Syntax Error:  '),
 error_message(N,M),
 tokenput(M),
 nl,
 show_culprit(Culprit),
 length(Context,Length),
 recordz(syntax_error,length(Length),_),
 !, fail.

show_culprit(no_culprit) :- !.
show_culprit(C) :- tokenput('Culprit:  '), display_token(C), nl.

syntax_error(List) :-
 recorded(syntax_error,length(AfterError),Ref),
 erase(Ref),
 length(List,Length),
 BeforeError is Length - AfterError,
 tokenput('Context:  '),
 display_list(List,BeforeError),
 get_file_status(1,F,L,C,_,_),
 read_info(F,L,C),
 nl,
 !,
 fail.

display_list(X,0) :-
 tokenput('<<here>>'),
 !,
 display_list(X,9999).
display_list([H|T],B) :-
 display_token(H),
 primput(32),
 succ(L,B),
 display_list(T,L).
display_list([],_) :- nl.

display_token(atom(X)) :- !, tokenput(X).
display_token(var(_,X)) :- !, tokenput(X).
display_token(integer(X)) :- !, tokenput(X).
display_token(string(X)) :- !, write(X).
display_token(X) :- !, display(X).
/*
  Routines for writing terms in various styles, and writing clauses
  in a standard form.
*/

display(Term) :-
 write_out(Term, display, 1200, punct, _).

print(Term) :-
 write_out(Term, print, 1200, punct, _).

write(Term) :-
 write_out(Term, write, 1200, punct, _).

writeq(Term) :-
 write_out(Term, writeq, 1200, punct, _).

%   maybe_paren(P, Prio, Char, Ci, Co)
%   writes a parenthesis if the context demands it.

maybe_paren(P, Prio, Char, _, punct) :-
 P > Prio,
 !,
 put(Char).
maybe_paren(_, _, _, C, C).



%   maybe_space(LeftContext, TypeOfToken)
%   generates spaces as needed to ensure that two successive
%   tokens won't run into each other.

maybe_space(punct, _) :- !.
maybe_space(X, X) :- !,
 put(32).
maybe_space(quote, alpha) :- !,
 put(32).
maybe_space(_, _).


%   write_out(Term, Style, Priority, Ci, Co)
%   writes out a Term in a given Style (display,write,writeq,print)
%   in a context of priority Priority (that is, operators with
%   greater priority have to be quoted), where the last token to be
%   written was of type Ci, and reports that the last token it wrote
%   was of type Co.

write_out(Term, _, _, Ci, alpha) :-
 var(Term),
 !,
 maybe_space(Ci, alpha),
 tokenput(Term).
write_out(N, _, _, Ci, alpha) :-
 integer(N),
 signed_space(N,Ci), !,
 tokenput(N).
write_out('%varname%'(A),_,_,Ci,alpha) :- maybe_space(Ci,alpha), tokenput(A).
write_out(Term, print, _, Ci, alpha) :-
 portray(Term),
 !.
write_out(Atom, Style, Prio, _, punct) :-
 atom(Atom),
 current_op(Atom,_,P,_,_,_),
 P > Prio,
 !,
 put(40),
 (   Style = writeq, write_atom(Atom, Style, punct, _)
 ;   tokenput(Atom)
 ),  !,
 put(41).
write_out(Atom, Style, _, Ci, Co) :-
 atom(Atom),
 !,
 write_atom(Atom, Style, Ci, Co).
write_out(Term, display, _, Ci, punct) :- !,
 functor(Term, Fsymbol, Arity),
 write_atom(Fsymbol, display, Ci, _),
 write_args(0, Arity, Term, 40, display).
write_out({Term}, Style, _, _, punct) :- !,
 put(123),
 write_out(Term, Style, 1200, punct, _),
 put(125).
write_out([Head|Tail], Style, _, _, punct) :- !,
 put(91),
 write_out(Head, Style, 999, punct, _),
 write_tail(Tail, Style).
write_out((A,B), Style, Prio, Ci, Co) :- !,
 %  This clause stops writeq quoting commas.
 maybe_paren(1000, Prio, 40, Ci, C1),
 write_out(A, Style, 999, C1, _),
 put(44),
 write_out(B, Style, 1000, punct, C2),
 maybe_paren(1000, Prio, 41, C2, Co).
write_out(Term, Style, Prio, Ci, Co) :-
 functor(Term, F, N),
 write_out(N, F, Term, Style, Prio, Ci, Co).


signed_space(N,C) :- N < 0, maybe_space(Ci,other).
signed_space(_,C) :- maybe_space(Ci,alpha).

write_out(1, F, Term, Style, Prio, Ci, Co) :-
 current_op(F,P,O,_,_,prefix), !,
 maybe_paren(O, Prio, 40, Ci, C1),
 write_atom(F, Style, C1, C2),
 arg(1, Term, A),
 write_out(A, Style, P, C2, C3),
 maybe_paren(O, Prio, 41, C3, Co).
write_out(1, F, Term, Style, Prio, Ci, Co) :-
 current_op(F,P,O,_,_,postfix), !,
 maybe_paren(O, Prio, 40, Ci, C1),
 arg(1, Term, A),
 write_out(A, Style, P, C1, C2),
 write_atom(F, Style, C2, C3),
 maybe_paren(O, Prio, 41, C3, Co).
write_out(2, F, Term, Style, Prio, Ci, Co) :-
 current_op(F,P,O,Q,_,infix), !,
 maybe_paren(O, Prio, 40, Ci, C1),
 arg(1, Term, A),
 write_out(A, Style, P, C1, C2),
 write_atom(F, Style, C2, C3),
 arg(2, Term, B),
 write_out(B, Style, Q, C3, C4),
 maybe_paren(O, Prio, 41, C4, Co).
write_out(N, F, Term, Style, Prio, Ci, punct) :-
 write_atom(F, Style, Ci, _),
 write_args(0, N, Term, 40, Style).



write_atom(('!'), _, _, punct) :- !,
 put(33).
write_atom((';'), _, _, punct) :- !,
 put(59).
write_atom([], _, _, punct) :- !,
 put(91), put(93).
write_atom('{}', _, _, punct) :- !,
 put(123), put(125).
write_atom(Atom, Style, Ci, Co) :-
 classify(Atom,Co),
 maybe_space(Ci,Co),
 tokenput(Atom), !.
write_atom(Atom,writeq,Ci,quote) :- maybe_space(Ci,quote), tokenquote(Atom), !.
write_atom(Atom,Style,Ci,alpha) :- tokenput(Atom).

classify(Atom,alpha) :- tokenalpha(Atom), !.
classify(Atom,other) :- tokenother(Atom), !.

%   write_args(DoneSoFar, Arity, Term, Separator, Style)
%   writes the remaining arguments of a Term with Arity arguments
%   all told in Style, given that DoneSoFar have already been written.
%   Separator is 0'( initially and later 0', .

write_args(N, N, _, _, _) :- !,
 put(41).
write_args(I, N, Term, C, Style) :-
 put(C),
 succ(I,J),
 arg(J, Term, A),
 write_out(A, Style, 999, punct, _),
 write_args(J, N, Term, 44, Style).



%   write_tail(Tail, Style)
%   writes the tail of a list of a given style.

write_tail(Var, _) :-   %  |var]
 var(Var),
 !,
 put(124),
 tokenput(Var),
 put(93).
write_tail([], _) :- !,   %  ]
 put(93).
write_tail([Head|Tail], Style) :- !, %  ,Head tail
 put(44),
 write_out(Head, Style, 999, punct, _),
 write_tail(Tail, Style).
write_tail(Other, Style) :-  %  |junk]
 put(124),
 write_out(Other, Style, 999, punct, _),
 put(93).


/*  Writing clauses */

writecl(U,true) :- writeq(U), put("."), nl, !.
writecl(H,B) :- writeq(H), primput(32), tokenput((':-')), writebod(B,3,','), put
("."), nl, !.

writebod(X,I,T) :- var(X), !, beforelit(T,I), writeq(X).
writebod((P,Q),IO,T) :-
 !,
 writebod(P,IO,T),
 put(","),
 aftercomma(T,IO,I),
 writebod(Q,I,',').
writebod((P;Q),I,T) :-
 !,
 nl, tab(I-2), put("("),
 writebod(P,I,'('),
 put(";"),
 writebod(Q,I,';'),
 primput(32), put(")").
writebod(X,I,T) :- beforelit(T,I), writeq(X).

aftercomma(',',I,I) :- !.
aftercomma(_,IO,I) :- I is IO + 3.

beforelit('(',_) :- !, primput(32).
beforelit(_,I) :- nl, tab(I).