procedure getch; const tab = 9; begin if eof then begin ch:='.'; theword:=' ' 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 if theword='chan ' then sy:=chansy 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 getch; if ch='>' then begin getch; sy:=sequencesy end {->} else sy:=minus end; '|': begin getch; if ch='|' then begin getch; sy:=parallelsy end {||} else sy:=choicesy { |} end; '=', '+', '*', '/', '.', ',', ')', '[', ']', '"', '!', '?': begin case ch of '+': sy:=plus; '=': sy:=eq; '*': sy:=times; '/': sy:=over; '.': sy:=dot; ',': sy:=comma; '(': sy:=open; ')': sy:=close; '[': sy:=sqopen; ']': sy:=sqclose; '"': sy:=quote; '!': sy:=outputsy; '?': sy:=inputsy end{case}; getch end end{case} else error('bad symbol') end{insymbol}; {\fB Lexical Analysis. \fP}