procedure getch;
   const tab = 9;
begin if eof then begin ch:='.'; theword:='<eof>     ' end
      else {not eof} if eoln then
      begin readln; writeln; ch:=' ';
            lineno:=lineno+1; write(lineno:3, ': ')
      end
      else begin {not eof and not eoln} read(ch); write(ch);
                 if ord(ch)=tab then ch:=' '
           end
end{getch};

procedure insymbol;
   const blank='          ';
   var len:integer;
begin repeat while ch=' ' do getch;
             if ch='{' then  { comment }
             begin repeat getch
                   until (ch='}') or eof;
                   getch
             end
      until not( ch in [' ', '{'] );
      if eof then sy:=eofsy
      
      else if ch in ['a'..'z', 'A'..'Z'] then                             {xyz}
      begin theword:=blank;
            len:=0;
            while ch in ['a'..'z', 'A'..'Z', '0'..'9'] do
            begin len:=len+1;
                  if len<=10 then theword[len] := ch;
                  getch
            end; {not ch in ['a'..'z', '0'..'9']}
            if      theword='hd        ' then sy:=hdsy  {not efficient}
            else if theword='tl        ' then sy:=tlsy
            else if theword='lambda    ' then sy:=lambdasy
            else if theword='if        ' then sy:=ifsy
            else if theword='then      ' then sy:=thensy
            else if theword='else      ' then sy:=elsesy
            else if theword='let       ' then sy:=letsy
            else if theword='in        ' then sy:=insy
            else if theword='rec       ' then sy:=recsy
            else if theword='or        ' then sy:=orsy
            else if theword='and       ' then sy:=andsy
            else if theword='not       ' then sy:=notsy
            else if theword='nil       ' then sy:=nilsy
            else if theword='null      ' then sy:=nullsy
            else if theword='true      ' then sy:=truesy
            else if theword='false     ' then sy:=falsesy
            else sy:=word
      end{alphanums}
      
      else if ch in ['0'..'9'] then                            {123}
      begin theint:=0;
            while ch in ['0'..'9'] do
            begin theint:=theint*10+ord(ch)-ord('0'); getch
            end;
            sy:=numeral
      end
      
      else if ch='''' then
      begin getch;
            theword:=blank; theword[1]:=ch; getch;
            if ch='''' then                             { 'z'   charliteral}
               begin getch; sy:=charliteral end
            else error('char lit  ')
      end
      
      else if ch in ['=', '<', '>', '+', '-', '*', '/',
                     '.', ',', ':', '(', ')', '[', ']', '"' ] then
         case ch of
            '<': begin getch;
                       if ch='=' then begin getch; sy:=le end
                       else if ch='>' then begin getch; sy:=ne end
                       else sy:=lt
                 end;
            '>': begin getch;
                       if ch='=' then begin getch; sy:=ge end
                       else sy:=gt
                 end;
            '(': begin getch;
                       if ch=')' then begin getch; sy:=empty end
                       else sy:=open
                 end;
            ':': begin getch;
                       if ch=':' then begin getch; sy:=conssy end
                       else sy:=colon
                 end;
            '=', '+', '-', '*', '/', '.', ',',
            ')', '[', ']', '"':
                 begin case ch of
                       '+': sy:=plus;
                       '-': sy:=minus;
                       '=': sy:=eq;
                       '*': sy:=times;
                       '/': sy:=over;
                       '.': sy:=dot;
                       ',': sy:=comma;
                       '(': sy:=open;  ')': sy:=close;
                       '[': sy:=sqopen; ']': sy:=sqclose;
                       '"': sy:=quote
                       end{case};
                       getch
                 end
         end{case}

      else error('bad symbol')
end{insymbol};

{\fB Lexical Analysis. \fP}

{Do not remove: Lazy.p, Strict.p, lazy.*.P, strict.*.P, lex.*.P, & syntax.*.P }
{ are released under Gnu `copyleft' General Public Licence (GPL)              }
{ - L. Allison, CSSE, Monash Uni., .au, 7/2003.                               }