1%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    2%%%  read_line
    3%%%  This is a modified version for parsing pddl files.
    4%%%  Read the input file character by character and parse it
    5%%%  into a list. Brackets, comma, period and question marks
    6%%%  are treated as separate words. White spaces separed 
    7%%%  words. 
    8%%%
    9%%%  Similar to read_sent in Pereira and Shieber, Prolog and
   10%%%        Natural Language Analysis, CSLI, 1987.
   11%%%
   12%%%  Examples:
   13%%%           :- read_line('input.txt', L).
   14%%%           input.txt> The sky was blue, after the rain.
   15%%%           L = [the, sky, was, blue, (','), after, the, rain, '.']
   16%%%
   17%%%           :- read_line('domain.pddl', L).
   18%%%           domain.pddl>
   19%%%           (define (domain BLOCKS)
   20%%%             (:requirements :strips :typing :action-costs)
   21%%%             (:types block)
   22%%%             (:predicates (on ?x - block ?y - block)
   23%%%           ...
   24%%%           L = ['(', define, '(', domain, blocks, ')', '(', :, requirements|...].
   25%
   26%read_file(+File, -List).
   27read_file(File, List) :- seeing(Old), see(File), read_line(List), seen, see(Old).
   28
   29
   30read_line(Words) :- get0(C),
   31                    read_rest(C,Words).
   32          
   33/* Ends the input. */
   34read_rest(-1,[]) :- !.
   35
   36/* Spaces, tabs and newlines between words are ignored. */
   37read_rest(C,Words) :- ( C=32 ; C=10 ; C=9 ; C=13 ; C=92 ) , !,
   38                     get0(C1),
   39                     read_rest(C1,Words).
   40
   41/* Brackets, comma, period or question marks are treated as separed words */
   42read_rest(C, [Char|Words]) :- ( C=40 ; C=41 ; C=44 ; C=45 ; C=46 ; C=63 ; C=58 ) , name(Char, [C]), !,
   43			get0(C1),
   44			read_rest(C1, Words).
   45
   46/* Read comments to the end of line */
   47read_rest(59, Words) :- get0(Next), !, 
   48			      read_comment(Next, Last),
   49			      read_rest(Last, Words).
   50
   51/* Otherwise get all of the next word. */
   52read_rest(C,[Word|Words]) :- read_word(C,Chars,Next),
   53                             name(Word,Chars),
   54                             read_rest(Next,Words).
   55
   56/* Space, comma, newline, period, end-of-file or question mark separate words. */
   57read_word(C,[],C) :- ( C=32 ; C=44 ; C=10 ; C=9 ; C=13 ;
   58                         C=46 ; C=63 ; C=40 ; C=41 ; C=58 ; C= -1 ) , !.
   59
   60/* Otherwise, get characters and convert to lower case. */
   61read_word(C,[LC|Chars],Last) :- lower_case(C, LC),
   62				get0(Next),
   63                                read_word(Next,Chars,Last).
   64
   65/* Convert to lower case if necessary. */
   66lower_case(C,C) :- ( C <  65 ; C > 90 ) , !.
   67lower_case(C,LC) :- LC is C + 32.
   68
   69
   70/* Keep reading as long you dont find end-of-line or end-of-file */
   71read_comment(10, 10) :- !.
   72read_comment(-1, -1) :- !.
   73read_comment(_, Last) :- get0(Next),
   74			 read_comment(Next, Last).
   75
   76/* for reference ... 
   77newline(10).
   78comma(44).
   79space(32).
   80period(46).
   81question_mark(63).
   82*/