1/*
    2
    3 _________________________________________________________________________
    4|	Copyright (C) 1982						  |
    5|									  |
    6|	David Warren,							  |
    7|		SRI International, 333 Ravenswood Ave., Menlo Park,	  |
    8|		California 94025, USA;					  |
    9|									  |
   10|	Fernando Pereira,						  |
   11|		Dept. of Architecture, University of Edinburgh,		  |
   12|		20 Chambers St., Edinburgh EH1 1JZ, Scotland		  |
   13|									  |
   14|	This program may be used, copied, altered or included in other	  |
   15|	programs only for academic purposes and provided that the	  |
   16|	authorship of the initial program is aknowledged.		  |
   17|	Use for commercial purposes without the previous written 	  |
   18|	agreement of the authors is forbidden.				  |
   19|_________________________________________________________________________|
   20
   21*/
   22
   23:- module(readin80,[read_sent/1]).   24
   25% maybe end_of_file.
   26/* Read a sentence */
   27
   28/* Read sentence */
   29
   30% :- share_mp(read_sent/1).
   31read_sent(P):-initread(L),words(P,L,[]),!,to_nl.
   32
   33initread([]):- at_end_of_stream,!.
   34initread(READ):- peek_code(C),C<32,!,get(C),!,initread(READ).
   35initread([K1,K2|U]):-get(K1),get0(K2),readrest(K2,U).
   36
   37readrest(46,[]):-!.
   38readrest(-1,[]):-!.
   39readrest(63,[]):-!.
   40readrest(33,[]):-!.
   41readrest(K,[K1|U]):-K=<32,!,get(K1),readrest(K1,U).
   42readrest(_K1,[K2|U]):-get0(K2),readrest(K2,U).
   43
   44words([V|U]) --> word(V),!,blanks80,words(U).
   45words([]) --> [].
   46
   47word(U1) --> [K],{lc(K,K1)},!,alphanums(U2),{name(U1,[K1|U2])}.
   48word(nquant(N)) --> [K],{digit(K)},!,digits(U),{name(N,[K|U])}.
   49word(V) --> [K],{name(V,[K])}.
   50
   51alphanums([K1|U]) --> [K],{alphanum(K,K1)},!,alphanums(U).
   52alphanums([]) --> [].
   53
   54alphanum(95,95) :- !.
   55alphanum(K,K1):-lc(K,K1).
   56alphanum(K,K):-digit(K).
   57
   58digits([K|U]) --> [K],{digit(K)},!,digits(U).
   59digits([]) --> [].
   60
   61blanks80--> [K],{K=<32},!,blanks80.
   62blanks80 --> [].
   63
   64digit(K):-K>47,K<58.
   65
   66lc(K,K1):-K>64,K<91,!,K1 is K\/8'40. %'
   67
   68lc(K,K):-K>96,K<123.
   69
   70to_nl :-
   71   repeat,
   72   (at_end_of_stream -> true ; get0(10)), !