1/* @(#)readin.pl	24.1 2/23/88 */
    2
    3/* 
    4	Copyright 1986, Fernando C.N. Pereira and David H.D. Warren,
    5
    6			   All Rights Reserved
    7*/
    8/* Read a sentence */
    9
   10 :- mode initread(-).   11 :- mode readrest(+,-).   12 :- mode word(-,?,?).   13 :- mode words(-,?,?).   14 :- mode alphanum(+,-).   15 :- mode alphanums(-,?,?).   16 :- mode digits(-,?,?).   17 :- mode digit(+).   18 :- mode lc(+,-).   19
   20 :- public read_in/1.   21
   22/* Read sentence */
   23
   24read_in(P):-initread(L),words(P,L,[]),!,to_nl.
   25
   26initread([K1,K2|U]):-get(K1),get0(K2),readrest(K2,U).
   27
   28readrest(46,[]):-!.
   29readrest(63,[]):-!.
   30readrest(33,[]):-!.
   31readrest(K,[K1|U]):-K=<32,!,get(K1),readrest(K1,U).
   32readrest(_K1,[K2|U]):-get0(K2),readrest(K2,U).
   33
   34words([V|U]) --> word(V),!,blanks,words(U).
   35words([]) --> [].
   36
   37word(U1) --> [K],{lc(K,K1)},!,alphanums(U2),{name(U1,[K1|U2])}.
   38word(nb(N)) --> [K],{digit(K)},!,digits(U),{name(N,[K|U])}.
   39word(V) --> [K],{name(V,[K])}.
   40
   41alphanums([K1|U]) --> [K],{alphanum(K,K1)},!,alphanums(U).
   42alphanums([]) --> [].
   43
   44alphanum(95,95) :- !.
   45alphanum(K,K1):-lc(K,K1).
   46alphanum(K,K):-digit(K).
   47
   48digits([K|U]) --> [K],{digit(K)},!,digits(U).
   49digits([]) --> [].
   50
   51blanks--> [K],{K=<32},!,blanks.
   52blanks --> [].
   53
   54digit(K):-K>47,K<58.
   55
   56% Jan lc(K,K1):-K>64,K<91,!,K1 is K\/8'40.
   57lc(K,K1):-K>64,K<91,!,K1 is K+32.
   58lc(K,K):-K>96,K<123.
   59
   60to_nl :-
   61   repeat,
   62   get0(10), !