CodeNet / Приложения / Алгоритмы / Разбор выражений. Компиляторы и интерпретаторы. / Компилятор пишется так...
Пример 1. Сканер
(**************************************) (* Данные для сканера *) (**************************************) const ExprLen = 240; Type LexEnum = (LexKeyword, LexNames, LexNumber, LexSpecs, LexExpr); SpecEnum = (SemiColn, Comma, Assign); var LexType : LexEnum; LexVal : integer; (* Буфер для кое-чего в квадратных скобках *) Buf : string [ExprLen]; EndStream, LogEOF : boolean; (* Буфер и указатель буфера строки входного файла*) LineBuf : string [81]; LinePtr : integer; (* А вот здесь мы храним символ, от которого мы отказались с помощью функции UngetCh *) OldCh : char; (* True, если в OldCh что-то лежит*) Suspend : boolean; procedure IniScan; begin LineBuf := ' '; LinePtr := 1; Suspend :=False; end; (* Сканер. Оставляет в переменных LexType и LexVal. Нечто в квадратных скобках остается в буфере Buf. Функции Alpha (c) и Num (c) равны True, если их аргумент буква или цифра соответственно. *) procedure Scan; var Ch : char; begin if Ch = ' ' then (* Бог с Ним! *) else UngetCh; if EndStream then LogEOF := true (* Конец файла! *) (* Встретили квадратную скобку - впереди выражение *) else if Ch = '[' then Brackets (* Впереди ключевое слово или переменная, а вот что неясно *) else if Alpha (Ch) then KeyOrNames else if Num (Ch) then Numbers (* Число!*) else if Ch = ';' then Spech (SemiColn) else if Ch = ',' then Spech (Comma) else if Ch = ':' then begin Ch := GetCh; Ch := GetCh; if Ch = '=' then Spech (Assign); (* := *) end; end; (* Сначала прочитать нечто алфавитно-цифровое, а потом уже разобраться, что это - ключевое слово или идентификатор *) procedure KeyOrNames; var LexBuf : bloc; i,t : integer; Ch : char; begin Ch := GetCh; i := 1; repeat LexBuf [i] := Ch; i := i+1; Ch := GetCh; until not (Alpha (Ch) or Num (Ch)); LexBuf [0] := chr (i); UngetCh; t := Find (LexBuf); if KeyEntry (t) then begin LexType := LexKeyword; LexVal := t; end else if t 0 then begin LexType := LexNames; Lexal := t; end else begin LexVal := LexNames; t := PutIn (LexBuf); end; end; (* Считать число *) procedure Numbers; Count : integer; Ch : char; begin Ch := GetCh; Count := 0; repeat Count := 10*Count + (ord (Ch)-ord ('0')); Ch := GetCh; until not Num (Ch); UngetCh; LexType := LexNumber; LexVal := Counter; end; (* Установить переменные LexType и LexVal для спецсимволов *) procedure Spech (Sym : EnumSpec); begin LexType := LexSpecs; LexVal := ord (Sym); end; ( Нечто в квадратных скобках **) procedure Brackets; var Ch : char; i : integer; begin Ch := GetCh; Ch := GetCh; i := 1; while Ch ']' do begin Buf [i] := Ch; Ch := GetCh; i := i+1; end; Buf [0] := chr (i-1); LexType := LexExpr; end; (* Вспомогательные подпрограммы для сканера *) Function GetCh : char; var i : integer; Ch : char; begin if Suspend then begin GetCh := OldCh; Suspend := False; end else repeat if LinePtr>legth (LineBuf) begin Ch := ' '; NewLine; end else begin Ch := LineBuf [LinePtr]; LinePtr := LinePtr+1; end; until ((Ch' ') and (Chchr (Tab))) or Eof (SRC); if Eof (SRC) then EndStream := 1; end; procedure UngetCh; begin Suspend :=True; end; procedure NewLine; begin ReadLn (LineBuf); if Eof (SRC) then LinePtr := 1; LinePtr := 1; end;