"Давайте создадим компилятор!" - читать интересную книгу автора (Креншоу Джек)

Объединение сканера и парсера

Теперь, когда мы охватили всю теорию и общие аспекты лексического анализа, я наконец готов подкрепит свое заявление о том, что мы можем приспособить многосимвольные токены с минимальными изменениями в нашей предыдущей работе. Для краткости и простоты я ограничу сам себя подмножеством того, что мы сделали ранее: я разрешу только одну управляющую конструкцию (IF) и никаких булевых выражений. Этого достаточно для демонстрации синтаксического анализа и ключевых слов и выражений. Расширение до полного набора конструкций должно быть довольно очевидно из того, что мы уже сделали.

Все элементы программы для синтаксического анализа этого подмножества с использованием односимвольных токенов уже существуют в наших предыдущих программах. Я построил ее осторожно скопировав эти файлы, но я не посмею попробовать провести вас через этот процесс. Вместо этого, во избежание беспорядка, вся программа показана ниже:

{–}

program KISS;

{–}

{ Constant Declarations }

const TAB = ^I;

CR = ^M;

LF = ^J;

{–}

{ Type Declarations }

type Symbol = string[8];

SymTab = array[1..1000] of Symbol;

TabPtr = ^SymTab;

{–}

{ Variable Declarations }

var Look : char; { Lookahead Character }

Lcount: integer; { Label Counter }

{–}

{ Read New Character From Input Stream }

procedure GetChar;

begin

Read(Look);

end;

{–}

{ Report an Error }

procedure Error(s: string);

begin

WriteLn;

WriteLn(^G, 'Error: ', s, '.');

end;

{–}

{ Report Error and Halt }

procedure Abort(s: string);

begin

Error(s);

Halt;

end;

{–}

{ Report What Was Expected }

procedure Expected(s: string);

begin

Abort(s + ' Expected');

end;

{–}

{ Recognize an Alpha Character }

function IsAlpha(c: char): boolean;

begin

IsAlpha := UpCase(c) in ['A'..'Z'];

end;

{–}

{ Recognize a Decimal Digit }

function IsDigit(c: char): boolean;

begin

IsDigit := c in ['0'..'9'];

end;

{–}

{ Recognize an AlphaNumeric Character }

function IsAlNum(c: char): boolean;

begin

IsAlNum := IsAlpha(c) or IsDigit(c);

end;

{–}

{ Recognize an Addop }

function IsAddop(c: char): boolean;

begin

IsAddop := c in ['+', '-'];

end;

{–}

{ Recognize a Mulop }

function IsMulop(c: char): boolean;

begin

IsMulop := c in ['*', '/'];

end;

{–}

{ Recognize White Space }

function IsWhite(c: char): boolean;

begin

IsWhite := c in [' ', TAB];

end;

{–}

{ Skip Over Leading White Space }

procedure SkipWhite;

begin

while IsWhite(Look) do

GetChar;

end;

{–}

{ Match a Specific Input Character }

procedure Match(x: char);

begin

if Look lt;gt; x then Expected('''' + x + '''');

GetChar;

SkipWhite;

end;

{–}

{ Skip a CRLF }

procedure Fin;

begin

if Look = CR then GetChar;

if Look = LF then GetChar;

SkipWhite;

end;

{–}

{ Get an Identifier }

function GetName: char;

begin

while Look = CR do

Fin;

if not IsAlpha(Look) then Expected('Name');

Getname := UpCase(Look);

GetChar;

SkipWhite;

end;

{–}

{ Get a Number }

function GetNum: char;

begin

if not IsDigit(Look) then Expected('Integer');

GetNum := Look;

GetChar;

SkipWhite;

end;

{–}

{ Generate a Unique Label }

function NewLabel: string;

var S: string;

begin

Str(LCount, S);

NewLabel := 'L' + S;

Inc(LCount);

end;

{–}

{ Post a Label To Output }

procedure PostLabel(L: string);

begin

WriteLn(L, ':');

end;

{–}

{ Output a String with Tab }

procedure Emit(s: string);

begin

Write(TAB, s);

end;

{–}

{ Output a String with Tab and CRLF }

procedure EmitLn(s: string);

begin

Emit(s);

WriteLn;

end;

{–}

{ Parse and Translate an Identifier }

procedure Ident;

var Name: char;

begin

Name := GetName;

if Look = '(' then begin

Match('(');

Match(')');

EmitLn('BSR ' + Name);

end

else

EmitLn('MOVE ' + Name + '(PC),D0');

end;

{–}

{ Parse and Translate a Math Factor }

procedure Expression; Forward;

procedure Factor;

begin

if Look = '(' then begin

Match('(');

Expression;

Match(')');

end

else if IsAlpha(Look) then

Ident

else

EmitLn('MOVE #' + GetNum + ',D0');

end;

{–}

{ Parse and Translate the First Math Factor }

procedure SignedFactor;

var s: boolean;

begin

s := Look = '-';

if IsAddop(Look) then begin

GetChar;

SkipWhite;

end;

Factor;

if s then

EmitLn('NEG D0');

end;

{–}

{ Recognize and Translate a Multiply }

procedure Multiply;

begin

Match('*');

Factor;

EmitLn('MULS (SP)+,D0');

end;

{–}

{ Recognize and Translate a Divide }

procedure Divide;

begin

Match('/');

Factor;

EmitLn('MOVE (SP)+,D1');

EmitLn('EXS.L D0');

EmitLn('DIVS D1,D0');

end;

{–}

{ Completion of Term Processing (called by Term and FirstTerm }

procedure Term1;

begin

while IsMulop(Look) do begin

EmitLn('MOVE D0,-(SP)');

case Look of

'*': Multiply;

'/': Divide;

end;

{–}

{ Parse and Translate a Math Term }

procedure Term;

begin

Factor;

Term1;

end;

{–}

{ Parse and Translate a Math Term with Possible Leading Sign }

procedure FirstTerm;

begin

SignedFactor;

Term1;

end;

{–}

{ Recognize and Translate an Add }

procedure Add;

begin

Match('+');

Term;

EmitLn('ADD (SP)+,D0');

end;

{–}

{ Recognize and Translate a Subtract }

procedure Subtract;

begin

Match('-');

Term;

EmitLn('SUB (SP)+,D0');

EmitLn('NEG D0');

end;

{–}

{ Parse and Translate an Expression }

procedure Expression;

begin

FirstTerm;

while IsAddop(Look) do begin

EmitLn('MOVE D0,-(SP)');

case Look of

'+': Add;

'-': Subtract;

end;

{–}

{ Parse and Translate a Boolean Condition }

{ This version is a dummy }

Procedure Condition;

begin

EmitLn('Condition');

end;

{–}

{ Recognize and Translate an IF Construct }

procedure Block;

Forward;

procedure DoIf;

var L1, L2: string;

begin

Match('i');

Condition;

L1 := NewLabel;

L2 := L1;

EmitLn('BEQ ' + L1);

Block;

if Look = 'l' then begin

Match('l');

L2 := NewLabel;

EmitLn('BRA ' + L2);

PostLabel(L1);

Block;

end;

PostLabel(L2);

Match('e');

end;

{–}

{ Parse and Translate an Assignment Statement }

procedure Assignment;

var Name: char;

begin

Name := GetName;

Match('=');

Expression;

EmitLn('LEA ' + Name + '(PC),A0');

EmitLn('MOVE D0,(A0)');

end;

{–}

{ Recognize and Translate a Statement Block }

procedure Block;

begin

while not(Look in ['e', 'l']) do begin

case Look of

'i': DoIf;

CR: while Look = CR do

Fin;

else Assignment;

end;

{–}

{ Parse and Translate a Program }

procedure DoProgram;

begin

Block;

if Look lt;gt; 'e' then Expected('END');

EmitLn('END')

end;

{–}

{ Initialize }

procedure Init;

begin

LCount := 0;

GetChar;

end;

{–}

{ Main Program }

begin

Init;

DoProgram;

end.

{–}

Пара комментариев:

Форма синтаксического анализатора выражений, использующего FirstTerm и т.п., немного отличается от того, что вы видели ранее. Это еще одна вариация на ту же самую тему. Не позволяйте им вертеть вами... изменения необязательны для того, что будет дальше.

Заметьте, что как обычно я добавил вызовы Fin в стратегических местах для поддержки множественных строк.

Прежде чем приступить к добавлению сканера, сначала скопируйте этот файл и проверьте, что он действительно корректно выполняет анализ. Не забудьте «кода»: "i" для IF, "l" для ELSE и "e" для ELSE или ENDIF.

Если программа работает, тогда давайте поспешим. При добавлении модулей сканера в программу поможет систематический план. Во всех синтаксических анализаторах, которые мы написали до этого времени, мы придерживались соглашения, что текущий предсказывающий символ должен всегда быть непустым символом. Мы предварительно загружали предсказывающий символ в Init и после этого оставляли «помпу запущенной». Чтобы позволить программе работать правильно с новыми строками мы должны ее немного модифицировать и обрабатывать символ новой строки как допустимый токен.

В многосимвольной версии правило аналогично: текущий предсказыващий символ должен всегда оставаться на начале следующей лексемы или на новой строке.

Многосимвольная версия показана ниже. Чтобы получить ее я сделал следующие изменения:

• Добавлены переменные Token и Value и определения типов, необходимые для Lookup.

• Добавлено определение KWList и KWcode.

• Добавлен Lookup.

• GetName и GetNum заменены их многосимвольными версиями. (Обратите внимание, что вызов Lookup был перемещен из GetName, так что он не будет выполняться внутри выражений).

• Создана новая, рудиментарная Scan, которая вызывает GetName затем сканирует ключевые слова.

• Создана новая процедура MatchString, которая ищет конкретное ключевое слово. Заметьте, что в отличие от Match, MatchString не считывает следующее ключевое слово.

• Изменен Block для вызова Scan.

• Немного изменены вызовы Fin. Fin теперь вызывается из GetName.

Программа полностью:

{–}

program KISS;

{–}

{ Constant Declarations }

const TAB = ^I;

CR = ^M;

LF = ^J;

{–}

{ Type Declarations }

type Symbol = string[8];

SymTab = array[1..1000] of Symbol;

TabPtr = ^SymTab;

{–}

{ Variable Declarations }

var Look : char; { Lookahead Character }

Token : char; { Encoded Token }

Value : string[16]; { Unencoded Token }

Lcount: integer; { Label Counter }

{–}

{ Definition of Keywords and Token Types }

const KWlist: array [1..4] of Symbol =

('IF', 'ELSE', 'ENDIF', 'END');

const KWcode: string[5] = 'xilee';

{–}

{ Read New Character From Input Stream }

procedure GetChar;

begin

Read(Look);

end;

{–}

{ Report an Error }

procedure Error(s: string);

begin

WriteLn;

WriteLn(^G, 'Error: ', s, '.');

end;

{–}

{ Report Error and Halt }

procedure Abort(s: string);

begin

Error(s);

Halt;

end;

{–}

{ Report What Was Expected }

procedure Expected(s: string);

begin

Abort(s + ' Expected');

end;

{–}

{ Recognize an Alpha Character }

function IsAlpha(c: char): boolean;

begin

IsAlpha := UpCase(c) in ['A'..'Z'];

end;

{–}

{ Recognize a Decimal Digit }

function IsDigit(c: char): boolean;

begin

IsDigit := c in ['0'..'9'];

end;

{–}

{ Recognize an AlphaNumeric Character }

function IsAlNum(c: char): boolean;

begin

IsAlNum := IsAlpha(c) or IsDigit(c);

end;

{–}

{ Recognize an Addop }

function IsAddop(c: char): boolean;

begin

IsAddop := c in ['+', '-'];

end;

{–}

{ Recognize a Mulop }

function IsMulop(c: char): boolean;

begin

IsMulop := c in ['*', '/'];

end;

{–}

{ Recognize White Space }

function IsWhite(c: char): boolean;

begin

IsWhite := c in [' ', TAB];

end;

{–}

{ Skip Over Leading White Space }

procedure SkipWhite;

begin

while IsWhite(Look) do

GetChar;

end;

{–}

{ Match a Specific Input Character }

procedure Match(x: char);

begin

if Look lt;gt; x then Expected('''' + x + '''');

GetChar;

SkipWhite;

end;

{–}

{ Skip a CRLF }

procedure Fin;

begin

if Look = CR then GetChar;

if Look = LF then GetChar;

SkipWhite;

end;

{–}

{ Table Lookup }

function Lookup(T: TabPtr; s: string; n: integer): integer;

var i: integer;

found: boolean;

begin

found := false;

i := n;

while (i gt; 0) and not found do

if s = T^[i] then

found := true

else

dec(i);

Lookup := i;

end;

{–}

{ Get an Identifier }

procedure GetName;

begin

while Look = CR do

Fin;

if not IsAlpha(Look) then Expected('Name');

Value := '';

while IsAlNum(Look) do begin

Value := Value + UpCase(Look);

GetChar;

end;

SkipWhite;

end;

{–}

{ Get a Number }

procedure GetNum;

begin

if not IsDigit(Look) then Expected('Integer');

Value := '';

while IsDigit(Look) do begin

Value := Value + Look;

GetChar;

end;

Token := '#';

SkipWhite;

end;

{–}

{ Get an Identifier and Scan it for Keywords }

procedure Scan;

begin

GetName;

Token := KWcode[Lookup(Addr(KWlist), Value, 4) + 1];

end;

{–}

{ Match a Specific Input String }

procedure MatchString(x: string);

begin

if Value lt;gt; x then Expected('''' + x + '''');

end;

{–}

{ Generate a Unique Label }

function NewLabel: string;

var S: string;

begin

Str(LCount, S);

NewLabel := 'L' + S;

Inc(LCount);

end;

{–}

{ Post a Label To Output }

procedure PostLabel(L: string);

begin

WriteLn(L, ':');

end;

{–}

{ Output a String with Tab }

procedure Emit(s: string);

begin

Write(TAB, s);

end;

{–}

{ Output a String with Tab and CRLF }

procedure EmitLn(s: string);

begin

Emit(s);

WriteLn;

end;

{–}

{ Parse and Translate an Identifier }

procedure Ident;

begin

GetName;

if Look = '(' then begin

Match('(');

Match(')');

EmitLn('BSR ' + Value);

end

else

EmitLn('MOVE ' + Value + '(PC),D0');

end;

{–}

{ Parse and Translate a Math Factor }

procedure Expression; Forward;

procedure Factor;

begin

if Look = '(' then begin

Match('(');

Expression;

Match(')');

end

else if IsAlpha(Look) then

Ident

else begin

GetNum;

EmitLn('MOVE #' + Value + ',D0');

end;

{–}

{ Parse and Translate the First Math Factor }

procedure SignedFactor;

var s: boolean;

begin

s := Look = '-';

if IsAddop(Look) then begin

GetChar;

SkipWhite;

end;

Factor;

if s then

EmitLn('NEG D0');

end;

{–}

{ Recognize and Translate a Multiply }

procedure Multiply;

begin

Match('*');

Factor;

EmitLn('MULS (SP)+,D0');

end;

{–}

{ Recognize and Translate a Divide }

procedure Divide;

begin

Match('/');

Factor;

EmitLn('MOVE (SP)+,D1');

EmitLn('EXS.L D0');

EmitLn('DIVS D1,D0');

end;

{–}

{ Completion of Term Processing (called by Term and FirstTerm }

procedure Term1;

begin

while IsMulop(Look) do begin

EmitLn('MOVE D0,-(SP)');

case Look of

'*': Multiply;

'/': Divide;

end;

{–}

{ Parse and Translate a Math Term }

procedure Term;

begin

Factor;

Term1;

end;

{–}

{ Parse and Translate a Math Term with Possible Leading Sign }

procedure FirstTerm;

begin

SignedFactor;

Term1;

end;

{–}

{ Recognize and Translate an Add }

procedure Add;

begin

Match('+');

Term;

EmitLn('ADD (SP)+,D0');

end;

{–}

{ Recognize and Translate a Subtract }

procedure Subtract;

begin

Match('-');

Term;

EmitLn('SUB (SP)+,D0');

EmitLn('NEG D0');

end;

{–}

{ Parse and Translate an Expression }

procedure Expression;

begin

FirstTerm;

while IsAddop(Look) do begin

EmitLn('MOVE D0,-(SP)');

case Look of

'+': Add;

'-': Subtract;

end;

{–}

{ Parse and Translate a Boolean Condition }

{ This version is a dummy }

Procedure Condition;

begin

EmitLn('Condition');

end;

{–}

{ Recognize and Translate an IF Construct }

procedure Block; Forward;

procedure DoIf;

var L1, L2: string;

begin

Condition;

L1 := NewLabel;

L2 := L1;

EmitLn('BEQ ' + L1);

Block;

if Token = 'l' then begin

L2 := NewLabel;

EmitLn('BRA ' + L2);

PostLabel(L1);

Block;

end;

PostLabel(L2);

MatchString('ENDIF');

end;

{–}

{ Parse and Translate an Assignment Statement }

procedure Assignment;

var Name: string;

begin

Name := Value;

Match('=');

Expression;

EmitLn('LEA ' + Name + '(PC),A0');

EmitLn('MOVE D0,(A0)');

end;

{–}

{ Recognize and Translate a Statement Block }

procedure Block;

begin

Scan;

while not (Token in ['e', 'l']) do begin

case Token of

'i': DoIf;

else Assignment;

end;

Scan;

end;

{–}

{ Parse and Translate a Program }

procedure DoProgram;

begin

Block;

MatchString('END');

EmitLn('END')

end;

{–}

{ Initialize }

procedure Init;

begin

LCount := 0;

GetChar;

end;

{–}

{ Main Program }

begin

Init;

DoProgram;

end.

{–}

Сравните эту программу с ее односимвольным вариантом. Я думаю вы согласитесь, что различия минимальны.