rtsi.com/2014.01.www.rtsi.com.tar/www.rtsi.com/OS9/OSK/EFFO/pd3.lzh/SBPROLOG2.2/MODLIB/MODLIB_SRC/$read.P

Text File | 1991-08-10 | 35KB | 1,004 lines

/*
    File   : READ.PL
    Author : D.H.D.Warren + Richard O'Keefe
    Updated: 5 July 1984
    Purpose: Read Prolog terms in Dec-10 syntax.
*/
/*
    Modified by Alan Mycroft to regularise the functor modes.
    This is both easier to understand (there are no more '?'s),
    and also fixes bugs concerning the curious interaction of cut with
    the state of parameter instantiation.

    Since this file doesn't provide "metaread", it is considerably
    simplified.  The token list format has been changed somewhat, see
    the comments in the RDTOK file.

    I have added the rule X(...) -> apply(X,[...]) for Alan Mycroft.
*/

/*
    Modified by Saumya Debray, SUNY @ Stony Brook, to cut away DEC-10 syntax
    that isn't used by C-Prolog 1.5 : "public" and "mode" declarations have
    been deleted, and the builtins ttynl/0 and ttyput/1 replaced by nl/0
    and put/1.    (April 2, 1985)
*/

$read_export([$read/1,$read/2]).

/* $read_use($bmeta,[$atom/1,$atomic/1,$integer/1,$number/1,$structure/1,
    $functor0/2,$bldstr/3,$arg/3,$arity/2,$real/1,$floor/2]).
   $read_use($meta,[$functor/3,$univ/2,$length/2]).
   $read_use($bio,[$writename/1,$writeqname/1,$put/1,$nl/0,$tab/1,
    $tell/1,_,$telling/1,$told/0,$get/1,$get0/1,$see/1,$seeing/1,
    $seen/0]).
   $read_use($io,[$write/1,$writeq/1,$display/1,$print/1]).
   $read_use($blist,[$append/3,$member/2,$memberchk/2]).
   $read_use($retr,[$retract/1,_,_]).
   $read_use($name,[$name/2,$name0/2]).
*/

/*
   $read(?Answer).
*/

$read(Answer) :- $read(Answer,_).

/*
    $read(?Answer, ?Variables)
    reads a term from the current input stream and unifies it with
    Answer.  Variables is bound to a list of [Atom=Variable] pairs.
*/

$read(Answer, Variables) :-
        repeat,
            $read_tokens(Tokens, Variables),
            (   $read(Tokens, 1200, Term, LeftOver), $read_all(LeftOver) ;
            $read_syntax_error(Tokens)
            ),
        !,
        Answer = Term.

/*
    $read_all(+Tokens)
    checks that there are no unparsed tokens left over.
*/

$read_all([]) :- !.
$read_all(S) :-
        $read_syntax_error(['operator expected after expression'], S).

/*
    $read_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.
*/

$read_expect(Token, [Token|Rest], Rest) :- !.
$read_expect(Token, S0, _) :-
        $read_syntax_error([Token,'or operator expected'], S0).

/*
    I want to experiment with having the operator information held as
    ordinary Prolog facts.  For the moment the following predicates
    remain as interfaces to curr_op.
    $read_prefixop(O -> Self, Rarg)
    $read_postfixop(O -> Larg, Self)
    $read_infixop(O -> Larg, Self, Rarg)
*/

$read_prefixop(Op, Prec, Prec) :-
        $read_curr_op(Prec, fy, Op), !.
$read_prefixop(Op, Prec, Less) :-
        $read_curr_op(Prec, fx, Op), !,
        Less is Prec-1.


$read_postfixop(Op, Prec, Prec) :-
        $read_curr_op(Prec, yf, Op), !.
$read_postfixop(Op, Less, Prec) :-
        $read_curr_op(Prec, xf, Op), !, Less is Prec-1.


$read_infixop(Op, Less, Prec, Less) :-
        $read_curr_op(Prec, xfx, Op), !, Less is Prec-1.
$read_infixop(Op, Less, Prec, Prec) :-
        $read_curr_op(Prec, xfy, Op), !, Less is Prec-1.
$read_infixop(Op, Prec, Prec, Less) :-
        $read_curr_op(Prec, yfx, Op), !, Less is Prec-1.


$read_ambigop(F, L1, O1, R1, L2, O2) :-
        $read_postfixop(F, L2, O2),
        $read_infixop(F, L1, O1, R1), !.

/*
    $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([], _, _, _) :-
        $read_syntax_error(['expression expected'], []).

/*
    $read(+Token, +RestTokens, +Precedence, -Term, -LeftOver)
*/

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

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

$read(atom(-), [number(Num)|S1], Precedence, Answer, S) :-
        Negative is -Num, !,
        $read_exprtl0(S1, Negative, Precedence, Answer, S).

$read(atom(Functor), ['('|S1], Precedence, Answer, S) :- !,
        $read(S1, 999, Arg1, S2),
        $read_args(S2, RestArgs, S3),
        $univ(Term,[Functor,Arg1|RestArgs]), !,
        $read_exprtl0(S3, Term, Precedence, Answer, S).

$read(atom(Functor), S0, Precedence, Answer, S) :-
        $read_prefixop(Functor, Prec, Right), !,
        $read_aft_pref_op(Functor, Prec, Right, S0, Precedence, Answer, S).

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

$read(number(Num), S0, Precedence, Answer, S) :- !,
        $read_exprtl0(S0, Num, Precedence, Answer, S).

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

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

$read('(', S1, Precedence, Answer, S) :- !,
        $read(S1, 1200, Term, S2),
        $read_expect(')', S2, S3), !,
        $read_exprtl0(S3, Term, Precedence, Answer, S).

$read(' (', S1, Precedence, Answer, S) :- !,
        $read(S1, 1200, Term, S2),
        $read_expect(')', S2, S3), !,
        $read_exprtl0(S3, Term, Precedence, Answer, S).

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

$read('{', S1, Precedence, Answer, S) :- !,
        $read(S1, 1200, Term, S2),
        $read_expect('}', S2, S3), !,
        $read_exprtl0(S3, '{}'(Term), Precedence, Answer, S).

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

$read(Token, S0, _, _, _) :-
        $read_syntax_error([Token,'cannot start an expression'], S0).

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

$read_args([Tok|S1], Term, S) :-
    '_$savecp'(CP),
    $read_args1(Tok,Term,S,S1,CP), '_$cutto'(CP).
$read_args(S, _, _) :-
        $read_syntax_error([', or ) expected in arguments'], S).


$read_args1(',',[Term|Rest],S,S1,CP) :-
        $read(S1, 999, Term, S2), '_$cutto'(CP),
        $read_args(S2, Rest, S).
$read_args1(')',[],S,S,_).


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

$read_list([Tok|S1],Term,S) :-
    '_$savecp'(CP),
    $read_list1(Tok,Term,S,S1,CP),
    '_$cutto'(CP).
$read_list(S, _, _) :-
        $read_syntax_error([', | or ] expected in list'], S).


$read_list1(',',[Term|Rest],S,S1,CP) :-
        $read(S1, 999, Term, S2), '_$cutto'(CP),
        $read_list(S2, Rest, S).
$read_list1('|',Rest,S,S1,CP) :-
        $read(S1, 999, Rest, S2), '_$cutto'(CP),
        $read_expect(']', S2, S).
$read_list1(']',[],S,S,_).

/*
    $read_aft_pref_op(+Op, +Prec, +ArgPrec, +Rest, +Precedence, -Ans, -LeftOver)
*/

$read_aft_pref_op(Op, Oprec, Aprec, S0, Precedence, _, _) :-
        Precedence < Oprec, !,
        $read_syntax_error(['prefix operator',Op,'in context with precedence '
            ,Precedence], S0).

$read_aft_pref_op(Op, Oprec, Aprec, S0, Precedence, Answer, S) :-
        $read_peepop(S0, S1),
        $read_prefix_is_atom(S1, Oprec), /* can't cut but would like to */
        $read_exprtl(S1, Oprec, Op, Precedence, Answer, S).

$read_aft_pref_op(Op, Oprec, Aprec, S1, Precedence, Answer, S) :-
        $read(S1, Aprec, Arg, S2),
        $univ(Term,[Op,Arg]), !,
        $read_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.
*/

$read_peepop([atom(F),'('|S1], [atom(F),'('|S1]) :- !.
$read_peepop([atom(F)|S1], [infixop(F,L,P,R)|S1]) :-
    $read_infixop(F, L, P, R).
$read_peepop([atom(F)|S1], [postfixop(F,L,P)|S1]) :-
    $read_postfixop(F, L, P).
$read_peepop(S0, S0).

/*
    $read_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.
*/

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

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

/*
    $read_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.
*/

$read_exprtl0([Tok|S1], Term, Precedence, Answer, S) :-
    '_$savecp'(CP),
    $read_exprtl01(Tok,Term,Precedence,Answer,S,S1,CP),
    '_$cutto'(CP).
$read_exprtl0(S, Term, _, Term, S).


$read_exprtl01(atom(F), Term, Precedence, Answer,S,S1,CP) :-
        $read_ambigop(F, L1, O1, R1, L2, O2), '_$cutto'(CP),
        ( $read_exprtl([infixop(F,L1,O1,R1)|S1],0,Term,Precedence,Answer,S)
        ; $read_exprtl([postfixop(F,L2,O2) |S1],0,Term,Precedence,Answer,S)
        ).
$read_exprtl01(atom(F), Term, Precedence, Answer, S,S1,CP) :-
        $read_infixop(F, L1, O1, R1), '_$cutto'(CP),
        $read_exprtl([infixop(F,L1,O1,R1)|S1],0,Term,Precedence,Answer,S).
$read_exprtl01(atom(F),Term,Precedence,Answer,S,S1,CP) :-
        $read_postfixop(F, L2, O2), '_$cutto'(CP),
        $read_exprtl([postfixop(F,L2,O2) |S1],0,Term,Precedence,Answer,S).
$read_exprtl01(',', Term, Precedence, Answer, S,S1,CP) :-
        Precedence >= 1000, '_$cutto'(CP),
        $read(S1, 1000, Next, S2), '_$cutto'(CP),
        $read_exprtl(S2, 1000, (Term,Next), Precedence, Answer, S).
$read_exprtl01('|', Term, Precedence, Answer, S,S1,CP) :-
        Precedence >= 1100, '_$cutto'(CP),
        $read(S1, 1100, Next, S2), '_$cutto'(CP),
        $read_exprtl(S2, 1100, (Term;Next), Precedence, Answer, S).
$read_exprtl01(Thing, _, _, _, _,S1,CP) :-
        $read_cfexpr(Thing, Culprit), '_$cutto'(CP),
        $read_syntax_error([Culprit,'follows expression'], [Thing|S1]).


$read_cfexpr(atom(_),       atom).
$read_cfexpr(var(_,_),      variable).
$read_cfexpr(number(_),     number).
$read_cfexpr(string(_),     string).
$read_cfexpr(' (',          bracket).
$read_cfexpr('(',           bracket).
$read_cfexpr('[',           bracket).
$read_cfexpr('{',           bracket).



$read_exprtl([Tok|S1], C, Term, Precedence, Answer, S) :-
    '_$savecp'(CP),
    $read_exprtl1(Tok,C,Term,Precedence,Answer,S,S1,CP),
    '_$cutto'(CP).
$read_exprtl(S, _, Term, _, Term, S).

$read_exprtl1(infixop(F,L,O,R), C, Term, Precedence, Answer, S, S1,CP) :-
        Precedence >= O, C =< L, '_$cutto'(CP),
        $read(S1, R, Other, S2),
        $univ(Expr,[F,Term,Other]), /*!,*/
        $read_exprtl(S2, O, Expr, Precedence, Answer, S).
$read_exprtl1(postfixop(F,L,O), C, Term, Precedence, Answer, S, S1,CP) :-
        Precedence >= O, C =< L, '_$cutto'(CP),
        $univ(Expr,[F,Term]),
        $read_peepop(S1, S2),
        $read_exprtl(S2, O, Expr, Precedence, Answer, S).
$read_exprtl1(',', C, Term, Precedence, Answer, S, S1,CP) :-
        Precedence >= 1000, C < 1000, '_$cutto'(CP),
        $read(S1, 1000, Next, S2), /*!,*/
        $read_exprtl(S2, 1000, (Term,Next), Precedence, Answer, S).
$read_exprtl1('|', C, Term, Precedence, Answer, S, S1, CP) :-
        Precedence >= 1100, C < 1100, '_$cutto'(CP),
        $read(S1, 1100, Next, S2), /*!,*/
        $read_exprtl(S2, 1100, (Term;Next), Precedence, Answer, S).

/*
    This business of syntax errors is tricky.  When an error is detected,
    we have to write out a message.  We also have to note how far it was
    to the end of the input, and for this we are obliged to use the data-
    base.  Then we fail all the way back to $read(), and that prints the
    input list with a marker where the error was noticed.  If subgoal_of
    were available in compiled code we could use that to find the input
    list without hacking the data base.  The really hairy thing is that
    the original code noted a possible error and backtracked on, so that
    what looked at first sight like an error sometimes turned out to be
    a wrong decision by the parser.  This version of the parser makes
    fewer wrong decisions, and my goal was to get it to do no backtracking
    at all.  This goal has not yet been met, and it will still occasionally
    report an error message and then decide that it is happy with the input
    after all.  Sorry about that.
*/

/*  Modified by Saumya Debray, Nov 18 1986, to use SB-Prolog's database
    facilities to print out error messages.                */

$read_syntax_error(Message, List) :-
/*    $print('**'), $print_list(Message), $nl, */

    $length(List,Length),
    $symtype('_$synerr'(_),X),
    ( (X =:= 0 ; not('_$synerr'(_))) ->    /* _$synerr/1 undefined */
        $assert('_$synerr'(Length)) ;
        true
    ),
    !,
    fail.

$read_syntax_error(List) :-
        $nl, $print('*** syntax error ***'), $nl,
    '_$synerr'(AfterError),
    $retract('_$synerr'(AfterError)),
    $length(List,Length),
    BeforeError is Length - AfterError,
    $read_display_list(List,BeforeError), !,
    fail.

$read_display_list(X, 0) :-
    $print('<<here>> '), !,
    $read_display_list(X, 99999).
$read_display_list([Head|Tail], BeforeError) :-
    $print_token(Head),
    $writename(' '),
    Left is BeforeError-1, !,
    $read_display_list(Tail, Left).
$read_display_list([], _) :-
    $nl.


$print_list([]) :- $nl.
$print_list([Head|Tail]) :-
    $tab(1),
        $print_token(Head),
        $print_list(Tail).

$print_token(atom(X))    :- !, $print(X).
$print_token(var(V,X))   :- !, $print(X).
$print_token(number(X)) :-  !, $print(X).
$print_token(string(X))  :- !, $print(X).
$print_token(X)          :-    $print(X).

/*      An attempt at defining the "curr_op" predicate for read.       */

/* could add the clause:
    op(Prec,Assoc,Op) :- assert_fact($read_curr_op(Prec,Assoc,Op)).
   to implement op */

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



/*
    File   : RDTOK.PL
    Author : R.A.O'Keefe
    Updated: 5 July 1984
    Purpose: Tokeniser in reasonably standard Prolog.
*/
/*  This tokeniser is meant to complement the library READ routine.
    It recognises Dec-10 Prolog with the following exceptions:

        %( is not accepted as an alternative to {

        %) is not accepted as an alternative to )

        NOLC convention is not supported (read_name could be made to do it)

        ,.. is not accepted as an alternative to | (hooray!)

        large integers are not read in as xwd(Top18Bits,Bottom18Bits)

        After a comma, "(" is read as ' (' rather than '('.  This does the
        parser no harm at all, and the Dec-10 tokeniser's behaviour here
        doesn't actually buy you anything.  This tokeniser guarantees never
        to return '(' except immediately after an atom, yielding ' (' every
        other where.

    In particular, radix notation is EXACTLY as in Dec-10 Prolog version 3.53.
    Some times might be of interest.  Applied to an earlier version of this file:
        this code took                  1.66 seconds
        the Dec-10 tokeniser took       1.28 seconds
        A Pascal version took           0.96 seconds
    The Dec-10 tokeniser was called via the old RDTOK interface, with
    which this file is compatible.  One reason for the difference in
    speed is the way variables are looked up: this code uses a linear
    list, while the Dec-10 tokeniser uses some sort of tree.  The Pascal
    version is the program WLIST which lists "words" and their frequencies.
    It uses a hash table.  Another difference is the way characters are
    classified: the Dec-10 tokeniser and WLIST have a table which maps
    ASCII codes to character classes, and don't do all this comparison
    and and memberchking.  We could do that without leaving standard Prolog,
    but what do you want from one evening's work?
*/

/*  Modified by Saumya Debray to be compatible with C-Prolog syntax.  This
    involved (i) deleting "public" and "mode" declarations, and (ii)
    replacing ttynl/0 by nl/0, ttyput/1 by put/1.  (Apr 6, 1985)    */

/*
    $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 way end of file is handled is that everything else FAILS when it
    hits character "-1", sometimes printing a warning.  It might have been
    an idea to return the atom 'end_of_file' instead of the same token list
    that you'd have got from reading "end_of_file. ", but (1) this file is
    for compatibility, and (b) there are good practical reasons for wanting
    this behaviour. */

$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 read and */
        TokenList = ListOfTokens.       /*  then check even with filled in */
                    /*  arguments */
$read_tokens([atom(end_of_file)], []).   /*  only thing that can go wrong */

/*  read_tokens/3 modified by Saumya Debray : June 18, 1985 : to consist
     of a single clause with a search-tree structure over it that permits
     more efficient compiled code to be generated.  The tree is skewed, so
     that those characters expected to be encountered more often are
     closer to the top of the tree (the assumption here is that lower
     case letters are the most frequent, followed by upper case letters
     and numbers).                              */

$read_tokens(Ch,Dict,Tokens) :-
    ((Ch >= 97,
      ((Ch =< 122, Tokens = [atom(A)|TokRest],
        $read_name(Ch,S,NextCh), $name(A,S),
        $read_aft_atom(NextCh,Dict,TokRest)
       ) ;
       (Ch > 122,
        ((Ch =:= 124, Tokens = ['|'|TokRest],
          $get0(NextCh), $read_tokens(NextCh,Dict,TokRest)
         ) ;
         (Ch =\= 124,
          ((Ch =:= 123, Tokens = ['{'|TokRest], $get0(NextCh),
            $read_tokens(NextCh,Dict,TokRest)
           ) ;
           (Ch =\= 123,
            ((Ch =:= 125, Tokens = ['}'|TokRest], $get0(NextCh),
          $read_tokens(NextCh,Dict,TokRest)
         ) ;
         (Ch =\= 125, Tokens = [atom(A)|TokRest], $get0(AnotherCh),
          $read_symbol(AnotherCh,Chars,NextCh), $name(A,[Ch|Chars]),
          $read_aft_atom(NextCh,Dict,Tokens)
         ))))))))) ;
     (Ch < 97,
      ((Ch < 65,
        ((Ch < 48,
          ((Ch =< 39,
            ((Ch =< 34,
          ((Ch =< 32,
            ((Ch >= 0,
              ((Ch =:= 26, fail) ;
               (Ch =\= 26,
                $get0(NextCh), $read_tokens(NextCh,Dict,Tokens)
               )
              )
             ) ;
             (Ch < 0, fail)
            )
           ) ;
           (Ch > 32,
            ((Ch =:= 33, Tokens = [atom('!')|TokRest],
              $get0(NextCh), $read_tokens(NextCh,Dict,TokRest)
             ) ;
             (Ch =\= 33, Tokens = [string(S)|TokRest],
              $read_string(S,34,NextCh),
              $read_tokens(NextCh,Dict,TokRest)
             ))))
         ) ;
         (Ch > 34,
          ((Ch =< 37,
            ((Ch =:= 37, $read_skip_comment,
              $get0(NextCh), $read_tokens(NextCh,Dict,Tokens)
             ) ;
             (Ch =\= 37,
                      Tokens = [atom(A)|TokRest],
                    $read_name(Ch,S,NextCh), $name(A,S),
                    $read_aft_atom(NextCh,Dict,TokRest)
             )
            )
           ) ;
           (Ch > 37, Tokens = [atom(A)|TokRest],
            ((Ch =:= 39,
              $read_string(S,39,NextCh), $name(A,S),
              $read_aft_atom(NextCh,Dict,TokRest)
             ) ;
             (Ch =\= 39,
              $get0(AnotherCh), $read_symbol(AnotherCh,Chars,NextCh),
              $name(A,[Ch|Chars]),
              $read_aft_atom(NextCh,Dict,TokRest)
             ))))))
           ) ;
           (Ch > 39,
            ((Ch =< 42,
          ((Ch =:= 40, Tokens = [' ('|TokRest],
            $get0(NextCh), $read_tokens(NextCh,Dict,TokRest)
           ) ;
           (Ch =\= 40,
            ((Ch =:= 41, Tokens = [')'|TokRest],
              $get0(NextCh), $read_tokens(NextCh,Dict,TokRest)
             ) ;
             (Ch =\= 41, Tokens = [atom(A)|TokRest],
              $get0(AnotherCh), $read_symbol(AnotherCh,Chars,NextCh),
              $name(A,[Ch|Chars]),
              $read_aft_atom(NextCh,Dict,TokRest)
             ))))
         ) ;
         (Ch > 42,
          ((Ch =:= 44, Tokens = [','|TokRest],
            $get0(NextCh), $read_tokens(NextCh,Dict,TokRest)
           ) ;
           (Ch =\= 44,
            ((Ch =:= 46, $get0(NextCh),
              $read_fullstop(NextCh,Dict,Tokens)
             ) ;
             (Ch =\= 46,
              ((Ch =:= 47,
                $get0(NextCh), $read_solidus(NextCh,Dict,Tokens)
               ) ;
               (Ch =\= 47, Tokens = [atom(A)|TokRest],
                $get0(AnotherCh), $read_symbol(AnotherCh,Chars,NextCh),
                $name(A,[Ch|Chars]),
                $read_aft_atom(NextCh,Dict,TokRest)
               ))))))))))
         ) ;
         (Ch >= 48,
          ((Ch =< 57, Tokens = [number(I)|TokRest],
            $read_number(Ch,I,NextCh),
        (NextCh = '_$end_of_clause' ->
            TokRest = [] ;
            $read_tokens(NextCh,Dict,TokRest)
        )
           ) ;
           (Ch > 57,
            ((Ch =:= 59, Tokens = [atom((';'))|TokRest],
          $get0(NextCh), $read_tokens(NextCh,Dict,TokRest)
         ) ;
         (Ch =\= 59, Tokens = [atom(A)|TokRest],
          $get0(AnotherCh), $read_symbol(AnotherCh,Chars,NextCh),
          $name(A,[Ch|Chars]), $read_aft_atom(NextCh,Dict,TokRest)
         ))))))
       ) ;
       (Ch >= 65,
        ((Ch =< 90, Tokens = [var(Var,Name)|TokRest],
          $read_name(Ch,S,NextCh), $name(Name,S),
          $read_lookup(Dict, Name=Var),
          $read_tokens(NextCh,Dict,TokRest)
         ) ;
         (Ch > 90,
          ((Ch =< 93,
            ((Ch =:= 91, Tokens = ['['|TokRest],
          $get0(NextCh), $read_tokens(NextCh,Dict,TokRest)
         ) ;
         (Ch =\= 91,
          ((Ch =\= 92, Tokens = [']'|TokRest],
            $get0(NextCh), $read_tokens(NextCh,Dict,TokRest)
           ) ;
           (Ch =:= 92, Tokens = [atom(A)|TokRest],
            $get0(AnotherCh),
            $read_symbol(AnotherCh,Chars,NextCh),
            $name(A,[Ch|Chars]),
            $read_aft_atom(NextCh,Dict,TokRest)
           ))))
           ) ;
           (Ch > 93,
            ((Ch =:= 95, Tokens = [var(Var,Name)|TokRest],
          $read_name(Ch,S,NextCh),
          ((S = "_", Name = '_') ;
           ($name(Name,S), $read_lookup(Dict, Name=Var))
          ),
          $read_tokens(NextCh,Dict,TokRest)
         ) ;
         (Ch =\= 95, Tokens = [atom(A)|TokRest],
          $get0(AnotherCh), $read_symbol(AnotherCh,Chars,NextCh),
          $name(A,[Ch|Chars]),
          $read_aft_atom(NextCh,Dict,TokRest)
         )))))))))
    ).

$read_skip_comment :-
    repeat,
        $get0(Ch),
        (Ch = 13 ; Ch < 0 ; Ch = 31 ; Ch = 26),
    !,
    Ch =\= 26,
    Ch > 0.        /*  fail on EOF */



/*
    The only difference between $read_aft_atom(Ch, Dict, Tokens) and
    read_tokens/3 is what they do when Ch is "(".  rd_aft_atom
    finds the token to be '(', while read_tokens finds the token to be
    ' ('.  This is how the parser can tell whether <atom> <paren> must
    be an operator application or an ordinary function symbol application.
    See the library file READ.PL for details. */

/*  Modified by Saumya Debray : June 18, 1985 : to use the conditional
    to avoid both the cut and the laying down of the choice point.    */

$read_aft_atom(Ch,Dict,Tokens) :-
    ((Ch =:= 40, Tokens = ['('|TokRest], $get0(NextCh),
      $read_tokens(NextCh,Dict,TokRest)
     ) ;
     (Ch =\= 40, $read_tokens(Ch,Dict,Tokens))
    ).

/*
    $read_string(Chars, Quote, NextCh)
    reads the body of a string delimited by Quote characters.
    The result is a list of ASCII codes.  There are two complications.
    If we hit the end of the file inside the string this predicate FAILS.
    It does not return any special structure.  That is the only reason
    it can ever fail.  The other complication is that when we find a Quote
    we have to look ahead one character in case it is doubled.  Note that
    if we find an end-of-file after the quote we *don't* fail, we return
    a normal string and the end of file character is returned as NextCh.
    If we were going to accept C-like escape characters, as I think we
    should, this would need changing (as would the code for 0'x).  But
    the purpose of this module is not to present my ideal syntax but to
    present something which will read present-day Prolog programs. */

$read_string(Chars, Quote, NextCh) :-
        $get0(Ch),
        $read_string(Ch, Chars, Quote, NextCh).


$read_string(Eofsym, _, Quote, Eofsym) :-
    (Eofsym is 26; Eofsym is -1),  /* new */
        $print('! end of line or file in '), $put(Quote),
        $print(token), $put(Quote), nl,
        !, fail.
$read_string(Quote, Chars, Quote, NextCh) :- !,
        $get0(Ch),                               /* closing or doubled quote */
        $read_more_string(Ch, Quote, Chars, NextCh).
$read_string(Char, [Char|Chars], Quote, NextCh) :-
        $read_string(Chars, Quote, NextCh).      /* ordinary character */


$read_more_string(Quote, Quote, [Quote|Chars], NextCh) :- !,
        $read_string(Chars, Quote, NextCh).      /* doubled quote */
$read_more_string(NextCh, _, [], NextCh).             /* end */


/*
    $read_solidus(Ch, Dict, Tokens)
    checks to see whether /Ch is a /* comment or a symbol.  If the
    former, it skips the comment.  If the latter it just calls read_symbol.
    We have to take great care with /* comments to handle end of file
    inside a comment, which is why read_solidus/2 passes back an end of
    file character or a (forged) blank that we can give to read_tokens.
*/

$read_solidus(42, Dict, Tokens) :- !,
        $get0(Ch),
        $read_solidus(Ch, NextCh),
        $read_tokens(NextCh, Dict, Tokens).
$read_solidus(Ch, Dict, [atom(A)|Tokens]) :-
        $read_symbol(Ch, Chars, NextCh),         /* might read 0 chars */
        $name(A, [47|Chars]),
        $read_tokens(NextCh, Dict, Tokens).
$read_solidus(Ch, LastCh) :-
    Ch =:= -1,$print('! end of file in /*comment'), nl;
    Ch =\= -1,
     (Ch =:= 26,$print('! end of file in /*comment'), nl;
      Ch =\= 26,$get0(NextCh),
       (Ch =:= 42,
         (NextCh =\= 47, $read_solidus(NextCh,LastCh);
          NextCh =:= 47, LastCh=32)
       ;
        Ch =\= 42, $read_solidus(NextCh,LastCh)
       )
     ).

/* old read_solidus/2
$read_solidus(Ch, Ch) :- (Ch is -1 ; Ch is 26), !,
        $print('! end of file in /*comment'), nl.
$read_solidus(42, LastCh) :-
        $get0(NextCh),
        NextCh =\= 47, !,
        $read_solidus(NextCh, LastCh).
$read_solidus(42, 32) :- !.
$read_solidus(_, LastCh) :-
        $get0(NextCh),
        $read_solidus(NextCh, LastCh).
*/
/*
    $read_name(Char, String, LastCh)
    reads a sequence of letters, digits, and underscores, and returns
    them as String.  The first character which cannot join this sequence
    is returned as LastCh. */

/* modified by Saumya Debray : June 18, 1985 : to use search tree structure */

$read_name(Ch,ChList,LastCh) :-
    ((Ch >= 65,
      ((Ch =< 90, ChList = [Ch | Chars],
        $get0(NextCh), $read_name(NextCh, Chars, LastCh)
       ) ;
       (Ch > 90,
        ((Ch =:= 95, ChList = [Ch | Chars],
              $get0(NextCh), $read_name(NextCh, Chars, LastCh)
         ) ;
         (Ch =\= 95,
          ((Ch >= 97,
            ((Ch =< 122, ChList = [Ch | Chars],
              $get0(NextCh), $read_name(NextCh, Chars, LastCh)
             ) ;
         (Ch > 122, ChList = [], LastCh = Ch)
        )) ;
           (Ch < 97, ChList = [], LastCh = Ch)
          )))))) ;
     (Ch < 65,
      ((Ch >= 48,
        ((Ch =< 57, ChList = [Ch | Chars], $get0(NextCh),
          $read_name(NextCh,Chars,LastCh)
         ) ;
         (Ch > 57, ChList = [], LastCh = Ch)
        )) ;
       (Ch < 48,
        ((Ch =:= 36, ChList = [Ch | Chars], $get0(NextCh),
          $read_name(NextCh,Chars,LastCh)
         ) ;
         (Ch =\= 36,
          ChList = [], LastCh = Ch)
         )
       )
      ))).

/* **********************************************************************
$read_name(Char, [Char|Chars], LastCh) :-
        ( Char >= 97, Char =< 122       [* a..z *]
        ; Char >= 65, Char =< 90        [* A..Z *]
        ; Char >= 48, Char =< 57        [* 0..9 *]
        ; Char = 95                     [*  _   *]
        ), !,
        $get0(NextCh),
        $read_name(NextCh, Chars, LastCh).
$read_name(LastCh, [], LastCh).
********************************************************************** */
/*
    $read_symbol(Ch, String, NextCh)
    reads the other kind of atom which needs no quoting: one which is
    a string of "symbol" characters.  Note that it may accept 0
    characters, this happens when called from read_fullstop. */

$read_symbol(Char, [Char|Chars], LastCh) :-
/*        memberchk(Char, "#$&*+-./:<=>?@\^`~"), */
    $read_chkspec(Char),
        !,
        $get0(NextCh),
        $read_symbol(NextCh, Chars, LastCh).
$read_symbol(LastCh, [], LastCh).

$read_chkspec(0'#).    /* '#' 35 */
$read_chkspec(0'$).    /* '$' 36 */
$read_chkspec(0'&).    /* '&' 38 */
$read_chkspec(0'*).    /* '*' 42 */
$read_chkspec(0'+).    /* '+' 43 */
$read_chkspec(0'-).    /* '-' 45 */
$read_chkspec(0'.).    /* '.' 46 */
$read_chkspec(0'/).    /* '/' 47 */
$read_chkspec(0':).    /* ':' 58 */
$read_chkspec(0'<).    /* '<' 60 */
$read_chkspec(0'=).    /* '=' 61 */
$read_chkspec(0'>).    /* '>' 62 */
$read_chkspec(0'?).    /* '?' 63 */
$read_chkspec(0'@).    /* '@' 64 */
$read_chkspec(0'\).    /* '\' 92 */
$read_chkspec(0'^).    /* '^' 94 */
$read_chkspec(0'`).    /* '`' 96 */
$read_chkspec(0'~).    /* '~' 12 */

/*
    $read_fullstop(Char, Dict, Tokens)
    looks at the next character after a full stop.  There are
    three cases:
        (a) the next character is an end of file.  We treat this
            as an unexpected end of file.  The reason for this is
            that we HAVE to handle end of file characters in this
            module or they are gone forever; if we failed to check
            for end of file here and just accepted .<EOF> like .<NL>
            the caller would have no way of detecting an end of file
            and the next call would abort.
        (b) the next character is a layout character.  This is a
            clause terminator.
        (c) the next character is anything else.  This is just an
            ordinary symbol and we call read_symbol to process it.
*/

$read_fullstop(Ch, _, _) :-
    (Ch =:= -1 ; Ch =:= 26), !,
        $print('! end of file just after full stop'), $nl,
        fail.
$read_fullstop(Ch, _, []) :-
        Ch =< 32, !.            /* END OF CLAUSE */
$read_fullstop(Ch, Dict, [atom(A)|Tokens]) :-
        $read_symbol(Ch, S, NextCh),
        $name(A, [46|S]),
        $read_tokens(NextCh, Dict, Tokens).


/*
    read_number is complicated by having to understand radix notation.
    There are three forms of integer:
        0 ' <any character>     - the ASCII code for that character
        <digit> ' <digits>      - the digits, read in that base
        <digits>                - the digits, read in base 10.
    Note that radix 16 is not understood, because 16 is two digits,
    and that all the decimal digits are accepted in each base (this
    is also true of C).  So 2'89 = 25.  I can't say I care for this,
    but it does no great harm, and that's what Dec-10 Prolog does.
    The X =\= -1 (and 26) tests are to make sure we don't miss an end
    of file character.  The tokeniser really should be in C, not least to
    make handling end of file characters bearable.  If we hit an end
    of file inside an integer, read_number will fail.
*/

/*
   Modified by Saumya Debray, Nov 1986, to handle floating point numbers
*/

$read_number(BaseChar, Val, NextCh) :-
        Base is BaseChar - 48,
        $get0(Ch),
        Ch =\= 26, Ch > 0,
        (   Ch =\= 39, $read_digits(Ch, Base, 10, Val, NextCh)
        ;   Base >= 1, $read_digits(0, Base, Val, NextCh)
        ;   $get0(Val), Val =\= 26, $get0(NextCh)
        ),  !.

$read_digits(SoFar, Base, Value, NextCh) :-
        $get0(Ch),
    ((Ch > 0, Ch =\= 26) ->
            $read_digits(Ch, SoFar, Base, Value, NextCh) ;
        ($print('! end of file in number !'), fail)
    ).

$read_digits(46, SoFar, Base, Value, NextCh) :-
    !,
    $get0(Ch),
    ((Ch =:= 26 ; Ch < 0) ->
        ($print('! end of file just after full stop'), $nl, fail) ;
         ((Ch =< 32,                /* end of clause */
          Value = SoFar, NextCh = '_$end_of_clause'
             ) ;
             (Ch > 32,
              ( (Ch >= 48, Ch =< 57) ->
                    ($floor(Divisor,Base),
              $read_fraction(Ch, 0, Base, Divisor, Fraction, NextCh),
              Value is SoFar+Fraction) ;
                 (Value = SoFar, NextCh = Ch)
              )
             )
            )
    ).
$read_digits(Digit, SoFar, Base, Value, NextCh) :-
        Digit >= 48, Digit =< 57,
        !,
        Next is SoFar*Base-48+Digit,
        $read_digits(Next, Base, Value, NextCh).
$read_digits(LastCh, Value, _, Value, LastCh).

$read_fraction(Digit, SoFar, Base, Divisor, Value, NextCh) :-
        Digit >= 48, Digit =< 57,
        !,
        Next is SoFar + ((Digit-48)/Divisor),
    Divisor1 is Divisor*Base,
    $get0(Ch),
    ((Ch < 0 ; Ch =:= 26) ->
        ($print('! end of file in number !'), fail) ;
            $read_fraction(Ch, Next, Base, Divisor1, Value, NextCh)
    ).
$read_fraction(LastCh, Value, _, _, Value, LastCh).


/*
    read_lookup is identical to memberchk except for argument order and
    mode declaration.
*/

$read_lookup([X|_], X) :- !.
$read_lookup([_|T], X) :- $read_lookup(T, X).