Compare commits
11 Commits
| Author | SHA1 | Date | |
|---|---|---|---|
9bc6b50b94
|
|||
|
92ba0ff871
|
|||
|
ff547a295d
|
|||
|
23885e5b95
|
|||
|
a93d12eb50
|
|||
|
15135f14d8
|
|||
|
273e26b119
|
|||
|
4adac0531f
|
|||
|
04a52d5ad7
|
|||
|
ddc5865c7d
|
|||
|
731e9c700a
|
3
source/CommandLine.def
Normal file
3
source/CommandLine.def
Normal file
@ -0,0 +1,3 @@
|
||||
DEFINITION MODULE CommandLine;
|
||||
|
||||
END CommandLine.
|
||||
3
source/CommandLine.mod
Normal file
3
source/CommandLine.mod
Normal file
@ -0,0 +1,3 @@
|
||||
MODULE CommandLine;
|
||||
|
||||
END CommandLine.
|
||||
15
source/CommandLineInterface.def
Normal file
15
source/CommandLineInterface.def
Normal file
@ -0,0 +1,15 @@
|
||||
DEFINITION MODULE CommandLineInterface;
|
||||
|
||||
FROM Common IMPORT ShortString;
|
||||
|
||||
TYPE
|
||||
CommandLine = RECORD
|
||||
input: ShortString;
|
||||
lex: BOOLEAN;
|
||||
parse: BOOLEAN
|
||||
END;
|
||||
PCommandLine = POINTER TO CommandLine;
|
||||
|
||||
PROCEDURE parse_command_line(): PCommandLine;
|
||||
|
||||
END CommandLineInterface.
|
||||
74
source/CommandLineInterface.mod
Normal file
74
source/CommandLineInterface.mod
Normal file
@ -0,0 +1,74 @@
|
||||
IMPLEMENTATION MODULE CommandLineInterface;
|
||||
|
||||
FROM SYSTEM IMPORT ADR, TSIZE;
|
||||
|
||||
FROM Args IMPORT GetArg, Narg;
|
||||
FROM FIO IMPORT WriteString, WriteChar, WriteLine, StdErr;
|
||||
FROM Storage IMPORT ALLOCATE;
|
||||
FROM Strings IMPORT CompareStr, Length;
|
||||
FROM MemUtils IMPORT MemZero;
|
||||
|
||||
FROM Common IMPORT ShortString;
|
||||
|
||||
PROCEDURE parse_command_line(): PCommandLine;
|
||||
VAR
|
||||
parameter: ShortString;
|
||||
i: CARDINAL;
|
||||
result: PCommandLine;
|
||||
parsed: BOOLEAN;
|
||||
BEGIN
|
||||
i := 1;
|
||||
ALLOCATE(result, TSIZE(CommandLine));
|
||||
result^.lex := FALSE;
|
||||
result^.parse := FALSE;
|
||||
MemZero(ADR(result^.input), 256);
|
||||
|
||||
WHILE (i < Narg()) AND (result <> NIL) DO
|
||||
parsed := GetArg(parameter, i);
|
||||
parsed := FALSE;
|
||||
|
||||
IF CompareStr(parameter, '--lex') = 0 THEN
|
||||
parsed := TRUE;
|
||||
result^.lex := TRUE
|
||||
END;
|
||||
IF CompareStr(parameter, '--parse') = 0 THEN
|
||||
parsed := TRUE;
|
||||
result^.parse := TRUE
|
||||
END;
|
||||
IF parameter[1] <> '-' THEN
|
||||
parsed := TRUE;
|
||||
|
||||
IF Length(result^.input) > 0 THEN
|
||||
WriteString(StdErr, 'Fatal error: only one source file can be compiled at once. First given "');
|
||||
WriteString(StdErr, result^.input);
|
||||
WriteString(StdErr, '", then "');
|
||||
WriteString(StdErr, parameter);
|
||||
WriteString(StdErr, '".');
|
||||
WriteLine(StdErr);
|
||||
result := NIL
|
||||
END;
|
||||
IF result <> NIL THEN
|
||||
result^.input := parameter
|
||||
END
|
||||
END;
|
||||
IF parsed = FALSE THEN
|
||||
WriteString(StdErr, 'Fatal error: unknown command line options: ');
|
||||
|
||||
WriteString(StdErr, parameter);
|
||||
WriteChar(StdErr, '.');
|
||||
WriteLine(StdErr);
|
||||
|
||||
result := NIL
|
||||
END;
|
||||
|
||||
i := i + 1
|
||||
END;
|
||||
IF (result <> NIL) AND (Length(result^.input) = 0) THEN
|
||||
WriteString(StdErr, 'Fatal error: no input files.');
|
||||
WriteLine(StdErr);
|
||||
result := NIL
|
||||
END;
|
||||
|
||||
RETURN result
|
||||
END parse_command_line;
|
||||
END CommandLineInterface.
|
||||
8
source/Common.def
Normal file
8
source/Common.def
Normal file
@ -0,0 +1,8 @@
|
||||
DEFINITION MODULE Common;
|
||||
|
||||
TYPE
|
||||
ShortString = ARRAY[1..256] OF CHAR;
|
||||
Identifier = ARRAY[1..256] OF CHAR;
|
||||
PIdentifier = POINTER TO Identifier;
|
||||
|
||||
END Common.
|
||||
3
source/Common.mod
Normal file
3
source/Common.mod
Normal file
@ -0,0 +1,3 @@
|
||||
IMPLEMENTATION MODULE Common;
|
||||
|
||||
END Common.
|
||||
@ -1,18 +0,0 @@
|
||||
MODULE Compiler;
|
||||
|
||||
FROM FIO IMPORT StdIn;
|
||||
FROM SYSTEM IMPORT ADR;
|
||||
|
||||
FROM Lexer IMPORT Lexer, LexerDestroy, LexerInitialize;
|
||||
FROM Transpiler IMPORT Transpile;
|
||||
|
||||
VAR
|
||||
ALexer: Lexer;
|
||||
|
||||
BEGIN
|
||||
LexerInitialize(ADR(ALexer), StdIn);
|
||||
|
||||
Transpile(ADR(ALexer));
|
||||
|
||||
LexerDestroy(ADR(ALexer))
|
||||
END Compiler.
|
||||
50
source/Compiler.mod
Normal file
50
source/Compiler.mod
Normal file
@ -0,0 +1,50 @@
|
||||
MODULE Compiler;
|
||||
|
||||
FROM FIO IMPORT Close, IsNoError, File, OpenToRead, StdErr, StdOut, WriteLine, WriteString;
|
||||
FROM SYSTEM IMPORT ADR;
|
||||
FROM M2RTS IMPORT HALT, ExitOnHalt;
|
||||
|
||||
FROM Lexer IMPORT Lexer, lexer_destroy, lexer_initialize;
|
||||
FROM Transpiler IMPORT transpile;
|
||||
FROM CommandLineInterface IMPORT PCommandLine, parse_command_line;
|
||||
|
||||
VAR
|
||||
command_line: PCommandLine;
|
||||
|
||||
PROCEDURE compile_from_stream();
|
||||
VAR
|
||||
lexer: Lexer;
|
||||
source_input: File;
|
||||
BEGIN
|
||||
source_input := OpenToRead(command_line^.input);
|
||||
|
||||
IF IsNoError(source_input) = FALSE THEN
|
||||
WriteString(StdErr, 'Fatal error: failed to read the input file "');
|
||||
WriteString(StdErr, command_line^.input);
|
||||
WriteString(StdErr, '".');
|
||||
WriteLine(StdErr);
|
||||
|
||||
ExitOnHalt(2)
|
||||
END;
|
||||
IF IsNoError(source_input) THEN
|
||||
lexer_initialize(ADR(lexer), source_input);
|
||||
|
||||
transpile(ADR(lexer), StdOut, command_line^.input);
|
||||
|
||||
lexer_destroy(ADR(lexer));
|
||||
|
||||
Close(source_input)
|
||||
END
|
||||
END compile_from_stream;
|
||||
BEGIN
|
||||
ExitOnHalt(0);
|
||||
command_line := parse_command_line();
|
||||
|
||||
IF command_line <> NIL THEN
|
||||
compile_from_stream()
|
||||
END;
|
||||
IF command_line = NIL THEN
|
||||
ExitOnHalt(1)
|
||||
END;
|
||||
HALT()
|
||||
END Compiler.
|
||||
@ -2,6 +2,8 @@ DEFINITION MODULE Lexer;
|
||||
|
||||
FROM FIO IMPORT File;
|
||||
|
||||
FROM Common IMPORT Identifier;
|
||||
|
||||
TYPE
|
||||
PLexerBuffer = POINTER TO CHAR;
|
||||
Lexer = RECORD
|
||||
@ -71,25 +73,27 @@ TYPE
|
||||
lexerKindCharacter,
|
||||
lexerKindString,
|
||||
lexerKindFrom,
|
||||
lexerKindExclamation,
|
||||
lexerKindPointer,
|
||||
lexerKindArray,
|
||||
lexerKindArrow,
|
||||
lexerKindTrait,
|
||||
lexerKindProgram,
|
||||
lexerKindModule,
|
||||
lexerKindImport
|
||||
);
|
||||
LexerToken = RECORD
|
||||
CASE Kind: LexerKind OF
|
||||
lexerKindBoolean: booleanKind: BOOLEAN
|
||||
CASE kind: LexerKind OF
|
||||
lexerKindBoolean: booleanKind: BOOLEAN |
|
||||
lexerKindIdentifier: identifierKind: Identifier |
|
||||
lexerKindInteger: integerKind: INTEGER
|
||||
END
|
||||
END;
|
||||
PLexerToken = POINTER TO LexerToken;
|
||||
|
||||
PROCEDURE LexerInitialize(ALexer: PLexer; Input: File);
|
||||
PROCEDURE LexerDestroy(ALexer: PLexer);
|
||||
PROCEDURE lexer_initialize(ALexer: PLexer; Input: File);
|
||||
PROCEDURE lexer_destroy(ALexer: PLexer);
|
||||
(* Returns the last read token. *)
|
||||
PROCEDURE LexerCurrent(ALexer: PLexer): LexerToken;
|
||||
PROCEDURE lexer_current(ALexer: PLexer): LexerToken;
|
||||
(* Read and return the next token. *)
|
||||
PROCEDURE LexerLex(ALexer: PLexer): LexerToken;
|
||||
PROCEDURE lexer_lex(ALexer: PLexer): LexerToken;
|
||||
|
||||
END Lexer.
|
||||
|
||||
@ -1,722 +0,0 @@
|
||||
IMPLEMENTATION MODULE Lexer;
|
||||
|
||||
FROM FIO IMPORT ReadNBytes;
|
||||
FROM SYSTEM IMPORT ADR;
|
||||
|
||||
FROM Storage IMPORT DEALLOCATE, ALLOCATE;
|
||||
FROM Strings IMPORT Length;
|
||||
FROM MemUtils IMPORT MemZero;
|
||||
|
||||
CONST
|
||||
ChunkSize = 65536;
|
||||
|
||||
TYPE
|
||||
(*
|
||||
* Classification table assigns each possible character to a group (class). All
|
||||
* characters of the same group a handled equivalently.
|
||||
*
|
||||
* Classification:
|
||||
*)
|
||||
TransitionClass = (
|
||||
transitionClassInvalid,
|
||||
transitionClassDigit,
|
||||
transitionClassAlpha,
|
||||
transitionClassSpace,
|
||||
transitionClassColon,
|
||||
transitionClassEquals,
|
||||
transitionClassLeftParen,
|
||||
transitionClassRightParen,
|
||||
transitionClassAsterisk,
|
||||
transitionClassUnderscore,
|
||||
transitionClassSingle,
|
||||
transitionClassHex,
|
||||
transitionClassZero,
|
||||
transitionClassX,
|
||||
transitionClassEof,
|
||||
transitionClassDot,
|
||||
transitionClassMinus,
|
||||
transitionClassSingleQuote,
|
||||
transitionClassDoubleQuote,
|
||||
transitionClassGreater,
|
||||
transitionClassLess,
|
||||
transitionClassOther
|
||||
);
|
||||
TransitionState = (
|
||||
transitionStateStart,
|
||||
transitionStateColon,
|
||||
transitionStateIdentifier,
|
||||
transitionStateDecimal,
|
||||
transitionStateGreater,
|
||||
transitionStateMinus,
|
||||
transitionStateLeftParen,
|
||||
transitionStateLess,
|
||||
transitionStateDot,
|
||||
transitionStateComment,
|
||||
transitionStateClosingComment,
|
||||
transitionStateCharacter,
|
||||
transitionStateString,
|
||||
transitionStateLeadingZero,
|
||||
transitionStateDecimalSuffix,
|
||||
transitionStateEnd
|
||||
);
|
||||
TransitionAction = PROCEDURE(PLexer, PLexerToken);
|
||||
Transition = RECORD
|
||||
Action: TransitionAction;
|
||||
NextState: TransitionState
|
||||
END;
|
||||
|
||||
VAR
|
||||
Classification: ARRAY[1..128] OF TransitionClass;
|
||||
Transitions: ARRAY[0..MAX(TransitionState)] OF ARRAY[0..MAX(TransitionClass)] OF Transition;
|
||||
|
||||
PROCEDURE InitializeClassification();
|
||||
BEGIN
|
||||
Classification[1] := transitionClassEof; (* NUL *)
|
||||
Classification[2] := transitionClassInvalid; (* SOH *)
|
||||
Classification[3] := transitionClassInvalid; (* STX *)
|
||||
Classification[4] := transitionClassInvalid; (* ETX *)
|
||||
Classification[5] := transitionClassInvalid; (* EOT *)
|
||||
Classification[6] := transitionClassInvalid; (* EMQ *)
|
||||
Classification[7] := transitionClassInvalid; (* ACK *)
|
||||
Classification[8] := transitionClassInvalid; (* BEL *)
|
||||
Classification[9] := transitionClassInvalid; (* BS *)
|
||||
Classification[10] := transitionClassSpace; (* HT *)
|
||||
Classification[11] := transitionClassSpace; (* LF *)
|
||||
Classification[12] := transitionClassInvalid; (* VT *)
|
||||
Classification[13] := transitionClassInvalid; (* FF *)
|
||||
Classification[14] := transitionClassSpace; (* CR *)
|
||||
Classification[15] := transitionClassInvalid; (* SO *)
|
||||
Classification[16] := transitionClassInvalid; (* SI *)
|
||||
Classification[17] := transitionClassInvalid; (* DLE *)
|
||||
Classification[18] := transitionClassInvalid; (* DC1 *)
|
||||
Classification[19] := transitionClassInvalid; (* DC2 *)
|
||||
Classification[20] := transitionClassInvalid; (* DC3 *)
|
||||
Classification[21] := transitionClassInvalid; (* DC4 *)
|
||||
Classification[22] := transitionClassInvalid; (* NAK *)
|
||||
Classification[23] := transitionClassInvalid; (* SYN *)
|
||||
Classification[24] := transitionClassInvalid; (* ETB *)
|
||||
Classification[25] := transitionClassInvalid; (* CAN *)
|
||||
Classification[26] := transitionClassInvalid; (* EM *)
|
||||
Classification[27] := transitionClassInvalid; (* SUB *)
|
||||
Classification[28] := transitionClassInvalid; (* ESC *)
|
||||
Classification[29] := transitionClassInvalid; (* FS *)
|
||||
Classification[30] := transitionClassInvalid; (* GS *)
|
||||
Classification[31] := transitionClassInvalid; (* RS *)
|
||||
Classification[32] := transitionClassInvalid; (* US *)
|
||||
Classification[33] := transitionClassSpace; (* Space *)
|
||||
Classification[34] := transitionClassSingle; (* ! *)
|
||||
Classification[35] := transitionClassDoubleQuote; (* " *)
|
||||
Classification[36] := transitionClassOther; (* # *)
|
||||
Classification[37] := transitionClassOther; (* $ *)
|
||||
Classification[38] := transitionClassSingle; (* % *)
|
||||
Classification[39] := transitionClassSingle; (* & *)
|
||||
Classification[40] := transitionClassSingleQuote; (* ' *)
|
||||
Classification[41] := transitionClassLeftParen; (* ( *)
|
||||
Classification[42] := transitionClassRightParen; (* ) *)
|
||||
Classification[43] := transitionClassAsterisk; (* * *)
|
||||
Classification[44] := transitionClassSingle; (* + *)
|
||||
Classification[45] := transitionClassSingle; (* , *)
|
||||
Classification[46] := transitionClassMinus; (* - *)
|
||||
Classification[47] := transitionClassDot; (* . *)
|
||||
Classification[48] := transitionClassSingle; (* / *)
|
||||
Classification[49] := transitionClassZero; (* 0 *)
|
||||
Classification[50] := transitionClassDigit; (* 1 *)
|
||||
Classification[51] := transitionClassDigit; (* 2 *)
|
||||
Classification[52] := transitionClassDigit; (* 3 *)
|
||||
Classification[53] := transitionClassDigit; (* 4 *)
|
||||
Classification[54] := transitionClassDigit; (* 5 *)
|
||||
Classification[55] := transitionClassDigit; (* 6 *)
|
||||
Classification[56] := transitionClassDigit; (* 7 *)
|
||||
Classification[57] := transitionClassDigit; (* 8 *)
|
||||
Classification[58] := transitionClassDigit; (* 9 *)
|
||||
Classification[59] := transitionClassColon; (* : *)
|
||||
Classification[60] := transitionClassSingle; (* ; *)
|
||||
Classification[61] := transitionClassLess; (* < *)
|
||||
Classification[62] := transitionClassEquals; (* = *)
|
||||
Classification[63] := transitionClassGreater; (* > *)
|
||||
Classification[64] := transitionClassOther; (* ? *)
|
||||
Classification[65] := transitionClassSingle; (* @ *)
|
||||
Classification[66] := transitionClassAlpha; (* A *)
|
||||
Classification[67] := transitionClassAlpha; (* B *)
|
||||
Classification[68] := transitionClassAlpha; (* C *)
|
||||
Classification[69] := transitionClassAlpha; (* D *)
|
||||
Classification[70] := transitionClassAlpha; (* E *)
|
||||
Classification[71] := transitionClassAlpha; (* F *)
|
||||
Classification[72] := transitionClassAlpha; (* G *)
|
||||
Classification[73] := transitionClassAlpha; (* H *)
|
||||
Classification[74] := transitionClassAlpha; (* I *)
|
||||
Classification[75] := transitionClassAlpha; (* J *)
|
||||
Classification[76] := transitionClassAlpha; (* K *)
|
||||
Classification[77] := transitionClassAlpha; (* L *)
|
||||
Classification[78] := transitionClassAlpha; (* M *)
|
||||
Classification[79] := transitionClassAlpha; (* N *)
|
||||
Classification[80] := transitionClassAlpha; (* O *)
|
||||
Classification[81] := transitionClassAlpha; (* P *)
|
||||
Classification[82] := transitionClassAlpha; (* Q *)
|
||||
Classification[83] := transitionClassAlpha; (* R *)
|
||||
Classification[84] := transitionClassAlpha; (* S *)
|
||||
Classification[85] := transitionClassAlpha; (* T *)
|
||||
Classification[86] := transitionClassAlpha; (* U *)
|
||||
Classification[87] := transitionClassAlpha; (* V *)
|
||||
Classification[88] := transitionClassAlpha; (* W *)
|
||||
Classification[89] := transitionClassAlpha; (* X *)
|
||||
Classification[90] := transitionClassAlpha; (* Y *)
|
||||
Classification[91] := transitionClassAlpha; (* Z *)
|
||||
Classification[92] := transitionClassSingle; (* [ *)
|
||||
Classification[93] := transitionClassOther; (* \ *)
|
||||
Classification[94] := transitionClassSingle; (* ] *)
|
||||
Classification[95] := transitionClassSingle; (* ^ *)
|
||||
Classification[96] := transitionClassUnderscore; (* _ *)
|
||||
Classification[97] := transitionClassOther; (* ` *)
|
||||
Classification[98] := transitionClassHex; (* a *)
|
||||
Classification[99] := transitionClassHex; (* b *)
|
||||
Classification[100] := transitionClassHex; (* c *)
|
||||
Classification[101] := transitionClassHex; (* d *)
|
||||
Classification[102] := transitionClassHex; (* e *)
|
||||
Classification[103] := transitionClassHex; (* f *)
|
||||
Classification[104] := transitionClassAlpha; (* g *)
|
||||
Classification[105] := transitionClassAlpha; (* h *)
|
||||
Classification[106] := transitionClassAlpha; (* i *)
|
||||
Classification[107] := transitionClassAlpha; (* j *)
|
||||
Classification[108] := transitionClassAlpha; (* k *)
|
||||
Classification[109] := transitionClassAlpha; (* l *)
|
||||
Classification[110] := transitionClassAlpha; (* m *)
|
||||
Classification[111] := transitionClassAlpha; (* n *)
|
||||
Classification[112] := transitionClassAlpha; (* o *)
|
||||
Classification[113] := transitionClassAlpha; (* p *)
|
||||
Classification[114] := transitionClassAlpha; (* q *)
|
||||
Classification[115] := transitionClassAlpha; (* r *)
|
||||
Classification[116] := transitionClassAlpha; (* s *)
|
||||
Classification[117] := transitionClassAlpha; (* t *)
|
||||
Classification[118] := transitionClassAlpha; (* u *)
|
||||
Classification[119] := transitionClassAlpha; (* v *)
|
||||
Classification[120] := transitionClassAlpha; (* w *)
|
||||
Classification[121] := transitionClassX; (* x *)
|
||||
Classification[122] := transitionClassAlpha; (* y *)
|
||||
Classification[123] := transitionClassAlpha; (* z *)
|
||||
Classification[124] := transitionClassOther; (* { *)
|
||||
Classification[125] := transitionClassSingle; (* | *)
|
||||
Classification[126] := transitionClassOther; (* } *)
|
||||
Classification[127] := transitionClassSingle; (* ~ *)
|
||||
Classification[128] := transitionClassInvalid (* DEL *)
|
||||
END InitializeClassification;
|
||||
|
||||
PROCEDURE CompareKeyword(Keyword: ARRAY OF CHAR; TokenStart: PLexerBuffer; TokenEnd: PLexerBuffer): BOOLEAN;
|
||||
VAR
|
||||
Result: BOOLEAN;
|
||||
Index: CARDINAL;
|
||||
BEGIN
|
||||
Index := 0;
|
||||
Result := TRUE;
|
||||
|
||||
WHILE (Index < Length(Keyword)) AND (TokenStart <> TokenEnd) AND Result DO
|
||||
Result := Keyword[Index] = TokenStart^;
|
||||
INC(TokenStart);
|
||||
INC(Index)
|
||||
END;
|
||||
RETURN (Index = Length(Keyword)) AND (TokenStart = TokenEnd) AND Result
|
||||
END CompareKeyword;
|
||||
|
||||
(* Reached the end of file. *)
|
||||
PROCEDURE TransitionActionEof(ALexer: PLexer; AToken: PLexerToken);
|
||||
BEGIN
|
||||
AToken^.Kind := lexerKindEof
|
||||
END TransitionActionEof;
|
||||
|
||||
(* Add the character to the token currently read and advance to the next character. *)
|
||||
PROCEDURE TransitionActionAccumulate(ALexer: PLexer; AToken: PLexerToken);
|
||||
BEGIN
|
||||
INC(ALexer^.Current)
|
||||
END TransitionActionAccumulate;
|
||||
|
||||
(* The current character is not a part of the token. Finish the token already
|
||||
* read. Don't advance to the next character. *)
|
||||
PROCEDURE TransitionActionFinalize(ALexer: PLexer; AToken: PLexerToken);
|
||||
BEGIN
|
||||
IF ALexer^.Start^ = ':' THEN
|
||||
AToken^.Kind := lexerKindColon
|
||||
ELSIF ALexer^.Start^ = '>' THEN
|
||||
AToken^.Kind := lexerKindGreaterThan
|
||||
ELSIF ALexer^.Start^ = '<' THEN
|
||||
AToken^.Kind := lexerKindLessThan
|
||||
ELSIF ALexer^.Start^ = '(' THEN
|
||||
AToken^.Kind := lexerKindLeftParen
|
||||
ELSIF ALexer^.Start^ = '-' THEN
|
||||
AToken^.Kind := lexerKindLeftParen
|
||||
ELSIF ALexer^.Start^ = '.' THEN
|
||||
AToken^.Kind := lexerKindDot
|
||||
END
|
||||
END TransitionActionFinalize;
|
||||
|
||||
(* An action for tokens containing multiple characters. *)
|
||||
PROCEDURE TransitionActionComposite(ALexer: PLexer; AToken: PLexerToken);
|
||||
BEGIN
|
||||
IF ALexer^.Start^ = '<' THEN
|
||||
IF ALexer^.Current^ = '>' THEN
|
||||
AToken^.Kind := lexerKindNotEqual
|
||||
ELSIF ALexer^.Current^ = '=' THEN
|
||||
AToken^.Kind := lexerKindLessEqual
|
||||
END
|
||||
ELSIF (ALexer^.Start^ = '>') AND (ALexer^.Current^ = '=') THEN
|
||||
AToken^.Kind := lexerKindGreaterEqual
|
||||
ELSIF (ALexer^.Start^ = '.') AND (ALexer^.Current^ = '.') THEN
|
||||
AToken^.Kind := lexerKindRange
|
||||
ELSIF (ALexer^.Start^ = ':') AND (ALexer^.Current^ = '=') THEN
|
||||
AToken^.Kind := lexerKindAssignment
|
||||
END;
|
||||
INC(ALexer^.Current)
|
||||
END TransitionActionComposite;
|
||||
|
||||
(* Skip a space. *)
|
||||
PROCEDURE TransitionActionSkip(ALexer: PLexer; AToken: PLexerToken);
|
||||
BEGIN
|
||||
INC(ALexer^.Current);
|
||||
INC(ALexer^.Start)
|
||||
END TransitionActionSkip;
|
||||
|
||||
(* 0x04. Delimited string action. *)
|
||||
PROCEDURE TransitionActionDelimited(ALexer: PLexer; AToken: PLexerToken);
|
||||
BEGIN
|
||||
IF ALexer^.Start^ = '(' THEN
|
||||
AToken^.Kind := lexerKindComment
|
||||
ELSIF ALexer^.Start^ = '"' THEN
|
||||
AToken^.Kind := lexerKindCharacter
|
||||
ELSIF ALexer^.Start^ = "'" THEN
|
||||
AToken^.Kind := lexerKindString
|
||||
END;
|
||||
INC(ALexer^.Current)
|
||||
END TransitionActionDelimited;
|
||||
|
||||
(* Finalize keyword or identifier. *)
|
||||
PROCEDURE TransitionActionKeyId(ALexer: PLexer; AToken: PLexerToken);
|
||||
BEGIN
|
||||
IF CompareKeyword('PROGRAM', ALexer^.Start, ALexer^.Current) THEN
|
||||
AToken^.Kind := lexerKindProgram
|
||||
ELSIF CompareKeyword('IMPORT', ALexer^.Start, ALexer^.Current) THEN
|
||||
AToken^.Kind := lexerKindImport
|
||||
ELSIF CompareKeyword('CONST', ALexer^.Start, ALexer^.Current) THEN
|
||||
AToken^.Kind := lexerKindConst
|
||||
ELSIF CompareKeyword('VAR', ALexer^.Start, ALexer^.Current) THEN
|
||||
AToken^.Kind := lexerKindVar
|
||||
ELSIF CompareKeyword('IF', ALexer^.Start, ALexer^.Current) THEN
|
||||
AToken^.Kind := lexerKindIf
|
||||
ELSIF CompareKeyword('THEN', ALexer^.Start, ALexer^.Current) THEN
|
||||
AToken^.Kind := lexerKindThen
|
||||
ELSIF CompareKeyword('ELSIF', ALexer^.Start, ALexer^.Current) THEN
|
||||
AToken^.Kind := lexerKindElsif
|
||||
ELSIF CompareKeyword('ELSE', ALexer^.Start, ALexer^.Current) THEN
|
||||
AToken^.Kind := lexerKindElse
|
||||
ELSIF CompareKeyword('WHILE', ALexer^.Start, ALexer^.Current) THEN
|
||||
AToken^.Kind := lexerKindWhile
|
||||
ELSIF CompareKeyword('DO', ALexer^.Start, ALexer^.Current) THEN
|
||||
AToken^.Kind := lexerKindDo
|
||||
ELSIF CompareKeyword('PROCEDURE', ALexer^.Start, ALexer^.Current) THEN
|
||||
AToken^.Kind := lexerKindProc
|
||||
ELSIF CompareKeyword('BEGIN', ALexer^.Start, ALexer^.Current) THEN
|
||||
AToken^.Kind := lexerKindBegin
|
||||
ELSIF CompareKeyword('END', ALexer^.Start, ALexer^.Current) THEN
|
||||
AToken^.Kind := lexerKindEnd
|
||||
ELSIF CompareKeyword('TYPE', ALexer^.Start, ALexer^.Current) THEN
|
||||
AToken^.Kind := lexerKindType
|
||||
ELSIF CompareKeyword('RECORD', ALexer^.Start, ALexer^.Current) THEN
|
||||
AToken^.Kind := lexerKindRecord
|
||||
ELSIF CompareKeyword('UNION', ALexer^.Start, ALexer^.Current) THEN
|
||||
AToken^.Kind := lexerKindUnion
|
||||
ELSIF CompareKeyword('NIL', ALexer^.Start, ALexer^.Current) THEN
|
||||
AToken^.Kind := lexerKindNull
|
||||
ELSIF CompareKeyword('AND', ALexer^.Start, ALexer^.Current) THEN
|
||||
AToken^.Kind := lexerKindAnd
|
||||
ELSIF CompareKeyword('OR', ALexer^.Start, ALexer^.Current) THEN
|
||||
AToken^.Kind := lexerKindOr
|
||||
ELSIF CompareKeyword('RETURN', ALexer^.Start, ALexer^.Current) THEN
|
||||
AToken^.Kind := lexerKindReturn
|
||||
ELSIF CompareKeyword('DEFINITION', ALexer^.Start, ALexer^.Current) THEN
|
||||
AToken^.Kind := lexerKindDefinition
|
||||
ELSIF CompareKeyword('TO', ALexer^.Start, ALexer^.Current) THEN
|
||||
AToken^.Kind := lexerKindTo
|
||||
ELSIF CompareKeyword('CASE', ALexer^.Start, ALexer^.Current) THEN
|
||||
AToken^.Kind := lexerKindCase
|
||||
ELSIF CompareKeyword('OF', ALexer^.Start, ALexer^.Current) THEN
|
||||
AToken^.Kind := lexerKindOf
|
||||
ELSIF CompareKeyword('FROM', ALexer^.Start, ALexer^.Current) THEN
|
||||
AToken^.Kind := lexerKindFrom
|
||||
ELSIF CompareKeyword('MODULE', ALexer^.Start, ALexer^.Current) THEN
|
||||
AToken^.Kind := lexerKindModule
|
||||
ELSIF CompareKeyword('IMPLEMENTATION', ALexer^.Start, ALexer^.Current) THEN
|
||||
AToken^.Kind := lexerKindImplementation
|
||||
ELSIF CompareKeyword('TRUE', ALexer^.Start, ALexer^.Current) THEN
|
||||
AToken^.Kind := lexerKindBoolean;
|
||||
AToken^.booleanKind := TRUE
|
||||
ELSIF CompareKeyword('FALSE', ALexer^.Start, ALexer^.Current) THEN
|
||||
AToken^.Kind := lexerKindBoolean;
|
||||
AToken^.booleanKind := FALSE
|
||||
ELSE
|
||||
AToken^.Kind := lexerKindIdentifier
|
||||
END;
|
||||
END TransitionActionKeyId;
|
||||
|
||||
(* Action for tokens containing only one character. The character cannot be
|
||||
* followed by other characters forming a composite token. *)
|
||||
PROCEDURE TransitionActionSingle(ALexer: PLexer; AToken: PLexerToken);
|
||||
BEGIN
|
||||
CASE ALexer^.Current^ OF
|
||||
'&': AToken^.Kind := lexerKindAnd |
|
||||
';': AToken^.Kind := lexerKindSemicolon |
|
||||
',': AToken^.Kind := lexerKindComma |
|
||||
')': AToken^.Kind := lexerKindRightParen |
|
||||
'[': AToken^.Kind := lexerKindLeftSquare |
|
||||
']': AToken^.Kind := lexerKindRightSquare |
|
||||
'^': AToken^.Kind := lexerKindHat |
|
||||
'=': AToken^.Kind := lexerKindEqual |
|
||||
'+': AToken^.Kind := lexerKindPlus |
|
||||
'/': AToken^.Kind := lexerKindDivision |
|
||||
'%': AToken^.Kind := lexerKindRemainder |
|
||||
'@': AToken^.Kind := lexerKindAt |
|
||||
'|': AToken^.Kind := lexerKindPipe
|
||||
END;
|
||||
INC(ALexer^.Current)
|
||||
END TransitionActionSingle;
|
||||
|
||||
(* Handle an integer literal. *)
|
||||
PROCEDURE TransitionActionInteger(ALexer: PLexer; AToken: PLexerToken);
|
||||
BEGIN
|
||||
AToken^.Kind := lexerKindInteger
|
||||
END TransitionActionInteger;
|
||||
|
||||
PROCEDURE SetDefaultTransition(CurrentState: TransitionState; DefaultAction: TransitionAction; NextState: TransitionState);
|
||||
VAR DefaultTransition: Transition;
|
||||
BEGIN
|
||||
DefaultTransition.Action := DefaultAction;
|
||||
DefaultTransition.NextState := NextState;
|
||||
|
||||
Transitions[ORD(CurrentState)][ORD(transitionClassInvalid)] := DefaultTransition;
|
||||
Transitions[ORD(CurrentState)][ORD(transitionClassDigit)] := DefaultTransition;
|
||||
Transitions[ORD(CurrentState)][ORD(transitionClassAlpha)] := DefaultTransition;
|
||||
Transitions[ORD(CurrentState)][ORD(transitionClassSpace)] := DefaultTransition;
|
||||
Transitions[ORD(CurrentState)][ORD(transitionClassColon)] := DefaultTransition;
|
||||
Transitions[ORD(CurrentState)][ORD(transitionClassEquals)] := DefaultTransition;
|
||||
Transitions[ORD(CurrentState)][ORD(transitionClassLeftParen)] := DefaultTransition;
|
||||
Transitions[ORD(CurrentState)][ORD(transitionClassRightParen)] := DefaultTransition;
|
||||
Transitions[ORD(CurrentState)][ORD(transitionClassAsterisk)] := DefaultTransition;
|
||||
Transitions[ORD(CurrentState)][ORD(transitionClassUnderscore)] := DefaultTransition;
|
||||
Transitions[ORD(CurrentState)][ORD(transitionClassSingle)] := DefaultTransition;
|
||||
Transitions[ORD(CurrentState)][ORD(transitionClassHex)] := DefaultTransition;
|
||||
Transitions[ORD(CurrentState)][ORD(transitionClassZero)] := DefaultTransition;
|
||||
Transitions[ORD(CurrentState)][ORD(transitionClassX)] := DefaultTransition;
|
||||
Transitions[ORD(CurrentState)][ORD(transitionClassEof)] := DefaultTransition;
|
||||
Transitions[ORD(CurrentState)][ORD(transitionClassDot)] := DefaultTransition;
|
||||
Transitions[ORD(CurrentState)][ORD(transitionClassMinus)] := DefaultTransition;
|
||||
Transitions[ORD(CurrentState)][ORD(transitionClassSingleQuote)] := DefaultTransition;
|
||||
Transitions[ORD(CurrentState)][ORD(transitionClassDoubleQuote)] := DefaultTransition;
|
||||
Transitions[ORD(CurrentState)][ORD(transitionClassGreater)] := DefaultTransition;
|
||||
Transitions[ORD(CurrentState)][ORD(transitionClassLess)] := DefaultTransition;
|
||||
Transitions[ORD(CurrentState)][ORD(transitionClassOther)] := DefaultTransition;
|
||||
END SetDefaultTransition;
|
||||
|
||||
(*
|
||||
* The transition table describes transitions from one state to another, given
|
||||
* a symbol (character class).
|
||||
*
|
||||
* The table has m rows and n columns, where m is the amount of states and n is
|
||||
* the amount of classes. So given the current state and a classified character
|
||||
* the table can be used to look up the next state.
|
||||
*
|
||||
* Each cell is a word long.
|
||||
* - The least significant byte of the word is a row number (beginning with 0).
|
||||
* It specifies the target state. "ff" means that this is an end state and no
|
||||
* transition is possible.
|
||||
* - The next byte is the action that should be performed when transitioning.
|
||||
* For the meaning of actions see labels in the lex_next function, which
|
||||
* handles each action.
|
||||
*)
|
||||
PROCEDURE InitializeTransitions();
|
||||
BEGIN
|
||||
(* Start state. *)
|
||||
Transitions[ORD(transitionStateStart)][ORD(transitionClassInvalid)].Action := NIL;
|
||||
Transitions[ORD(transitionStateStart)][ORD(transitionClassInvalid)].NextState := transitionStateEnd;
|
||||
|
||||
Transitions[ORD(transitionStateStart)][ORD(transitionClassDigit)].Action := TransitionActionAccumulate;
|
||||
Transitions[ORD(transitionStateStart)][ORD(transitionClassDigit)].NextState := transitionStateDecimal;
|
||||
|
||||
Transitions[ORD(transitionStateStart)][ORD(transitionClassAlpha)].Action := TransitionActionAccumulate;
|
||||
Transitions[ORD(transitionStateStart)][ORD(transitionClassAlpha)].NextState := transitionStateIdentifier;
|
||||
|
||||
Transitions[ORD(transitionStateStart)][ORD(transitionClassSpace)].Action := TransitionActionSkip;
|
||||
Transitions[ORD(transitionStateStart)][ORD(transitionClassSpace)].NextState := transitionStateStart;
|
||||
|
||||
Transitions[ORD(transitionStateStart)][ORD(transitionClassColon)].Action := TransitionActionAccumulate;
|
||||
Transitions[ORD(transitionStateStart)][ORD(transitionClassColon)].NextState := transitionStateColon;
|
||||
|
||||
Transitions[ORD(transitionStateStart)][ORD(transitionClassEquals)].Action := TransitionActionSingle;
|
||||
Transitions[ORD(transitionStateStart)][ORD(transitionClassEquals)].NextState := transitionStateEnd;
|
||||
|
||||
Transitions[ORD(transitionStateStart)][ORD(transitionClassLeftParen)].Action := TransitionActionAccumulate;
|
||||
Transitions[ORD(transitionStateStart)][ORD(transitionClassLeftParen)].NextState := transitionStateLeftParen;
|
||||
|
||||
Transitions[ORD(transitionStateStart)][ORD(transitionClassRightParen)].Action := TransitionActionSingle;
|
||||
Transitions[ORD(transitionStateStart)][ORD(transitionClassRightParen)].NextState := transitionStateEnd;
|
||||
|
||||
Transitions[ORD(transitionStateStart)][ORD(transitionClassAsterisk)].Action := TransitionActionSingle;
|
||||
Transitions[ORD(transitionStateStart)][ORD(transitionClassAsterisk)].NextState := transitionStateEnd;
|
||||
|
||||
Transitions[ORD(transitionStateStart)][ORD(transitionClassUnderscore)].Action := TransitionActionAccumulate;
|
||||
Transitions[ORD(transitionStateStart)][ORD(transitionClassUnderscore)].NextState := transitionStateIdentifier;
|
||||
|
||||
Transitions[ORD(transitionStateStart)][ORD(transitionClassSingle)].Action := TransitionActionSingle;
|
||||
Transitions[ORD(transitionStateStart)][ORD(transitionClassSingle)].NextState := transitionStateEnd;
|
||||
|
||||
Transitions[ORD(transitionStateStart)][ORD(transitionClassHex)].Action := TransitionActionAccumulate;
|
||||
Transitions[ORD(transitionStateStart)][ORD(transitionClassHex)].NextState := transitionStateIdentifier;
|
||||
|
||||
Transitions[ORD(transitionStateStart)][ORD(transitionClassZero)].Action := TransitionActionAccumulate;
|
||||
Transitions[ORD(transitionStateStart)][ORD(transitionClassZero)].NextState := transitionStateLeadingZero;
|
||||
|
||||
Transitions[ORD(transitionStateStart)][ORD(transitionClassX)].Action := TransitionActionAccumulate;
|
||||
Transitions[ORD(transitionStateStart)][ORD(transitionClassX)].NextState := transitionStateIdentifier;
|
||||
|
||||
Transitions[ORD(transitionStateStart)][ORD(transitionClassEof)].Action := TransitionActionEof;
|
||||
Transitions[ORD(transitionStateStart)][ORD(transitionClassEof)].NextState := transitionStateEnd;
|
||||
|
||||
Transitions[ORD(transitionStateStart)][ORD(transitionClassDot)].Action := TransitionActionAccumulate;
|
||||
Transitions[ORD(transitionStateStart)][ORD(transitionClassDot)].NextState := transitionStateDot;
|
||||
|
||||
Transitions[ORD(transitionStateStart)][ORD(transitionClassMinus)].Action := TransitionActionAccumulate;
|
||||
Transitions[ORD(transitionStateStart)][ORD(transitionClassMinus)].NextState := transitionStateMinus;
|
||||
|
||||
Transitions[ORD(transitionStateStart)][ORD(transitionClassSingleQuote)].Action := TransitionActionAccumulate;
|
||||
Transitions[ORD(transitionStateStart)][ORD(transitionClassSingleQuote)].NextState := transitionStateCharacter;
|
||||
|
||||
Transitions[ORD(transitionStateStart)][ORD(transitionClassDoubleQuote)].Action := TransitionActionAccumulate;
|
||||
Transitions[ORD(transitionStateStart)][ORD(transitionClassDoubleQuote)].NextState := transitionStateString;
|
||||
|
||||
Transitions[ORD(transitionStateStart)][ORD(transitionClassGreater)].Action := TransitionActionAccumulate;
|
||||
Transitions[ORD(transitionStateStart)][ORD(transitionClassGreater)].NextState := transitionStateGreater;
|
||||
|
||||
Transitions[ORD(transitionStateStart)][ORD(transitionClassLess)].Action := TransitionActionAccumulate;
|
||||
Transitions[ORD(transitionStateStart)][ORD(transitionClassLess)].NextState := transitionStateLess;
|
||||
|
||||
Transitions[ORD(transitionStateStart)][ORD(transitionClassOther)].Action := NIL;
|
||||
Transitions[ORD(transitionStateStart)][ORD(transitionClassOther)].NextState := transitionStateEnd;
|
||||
|
||||
(* Colon state. *)
|
||||
SetDefaultTransition(transitionStateColon, TransitionActionFinalize, transitionStateEnd);
|
||||
|
||||
Transitions[ORD(transitionStateColon)][ORD(transitionClassEquals)].Action := TransitionActionComposite;
|
||||
Transitions[ORD(transitionStateColon)][ORD(transitionClassEquals)].NextState := transitionStateEnd;
|
||||
|
||||
(* Identifier state. *)
|
||||
SetDefaultTransition(transitionStateIdentifier, TransitionActionKeyId, transitionStateEnd);
|
||||
|
||||
Transitions[ORD(transitionStateIdentifier)][ORD(transitionClassDigit)].Action := TransitionActionAccumulate;
|
||||
Transitions[ORD(transitionStateIdentifier)][ORD(transitionClassDigit)].NextState := transitionStateIdentifier;
|
||||
|
||||
Transitions[ORD(transitionStateIdentifier)][ORD(transitionClassAlpha)].Action := TransitionActionAccumulate;
|
||||
Transitions[ORD(transitionStateIdentifier)][ORD(transitionClassAlpha)].NextState := transitionStateIdentifier;
|
||||
|
||||
Transitions[ORD(transitionStateIdentifier)][ORD(transitionClassUnderscore)].Action := TransitionActionAccumulate;
|
||||
Transitions[ORD(transitionStateIdentifier)][ORD(transitionClassUnderscore)].NextState := transitionStateIdentifier;
|
||||
|
||||
Transitions[ORD(transitionStateIdentifier)][ORD(transitionClassHex)].Action := TransitionActionAccumulate;
|
||||
Transitions[ORD(transitionStateIdentifier)][ORD(transitionClassHex)].NextState := transitionStateIdentifier;
|
||||
|
||||
Transitions[ORD(transitionStateIdentifier)][ORD(transitionClassZero)].Action := TransitionActionAccumulate;
|
||||
Transitions[ORD(transitionStateIdentifier)][ORD(transitionClassZero)].NextState := transitionStateIdentifier;
|
||||
|
||||
Transitions[ORD(transitionStateIdentifier)][ORD(transitionClassX)].Action := TransitionActionAccumulate;
|
||||
Transitions[ORD(transitionStateIdentifier)][ORD(transitionClassX)].NextState := transitionStateIdentifier;
|
||||
|
||||
(* Decimal state. *)
|
||||
SetDefaultTransition(transitionStateDecimal, TransitionActionInteger, transitionStateEnd);
|
||||
|
||||
Transitions[ORD(transitionStateDecimal)][ORD(transitionClassDigit)].Action := TransitionActionAccumulate;
|
||||
Transitions[ORD(transitionStateDecimal)][ORD(transitionClassDigit)].NextState := transitionStateDecimal;
|
||||
|
||||
Transitions[ORD(transitionStateDecimal)][ORD(transitionClassAlpha)].Action := TransitionActionAccumulate;
|
||||
Transitions[ORD(transitionStateDecimal)][ORD(transitionClassAlpha)].NextState := transitionStateDecimalSuffix;
|
||||
|
||||
Transitions[ORD(transitionStateDecimal)][ORD(transitionClassUnderscore)].Action := NIL;
|
||||
Transitions[ORD(transitionStateDecimal)][ORD(transitionClassUnderscore)].NextState := transitionStateEnd;
|
||||
|
||||
Transitions[ORD(transitionStateDecimal)][ORD(transitionClassHex)].Action := TransitionActionAccumulate;
|
||||
Transitions[ORD(transitionStateDecimal)][ORD(transitionClassHex)].NextState := transitionStateDecimalSuffix;
|
||||
|
||||
Transitions[ORD(transitionStateDecimal)][ORD(transitionClassZero)].Action := TransitionActionAccumulate;
|
||||
Transitions[ORD(transitionStateDecimal)][ORD(transitionClassZero)].NextState := transitionStateDecimal;
|
||||
|
||||
Transitions[ORD(transitionStateDecimal)][ORD(transitionClassX)].Action := TransitionActionAccumulate;
|
||||
Transitions[ORD(transitionStateDecimal)][ORD(transitionClassX)].NextState := transitionStateDecimalSuffix;
|
||||
|
||||
(* Greater state. *)
|
||||
SetDefaultTransition(transitionStateGreater, TransitionActionFinalize, transitionStateEnd);
|
||||
|
||||
Transitions[ORD(transitionStateGreater)][ORD(transitionClassEquals)].Action := TransitionActionComposite;
|
||||
Transitions[ORD(transitionStateGreater)][ORD(transitionClassEquals)].NextState := transitionStateEnd;
|
||||
|
||||
(* Minus state. *)
|
||||
SetDefaultTransition(transitionStateMinus, TransitionActionFinalize, transitionStateEnd);
|
||||
|
||||
Transitions[ORD(transitionStateMinus)][ORD(transitionClassGreater)].Action := TransitionActionComposite;
|
||||
Transitions[ORD(transitionStateMinus)][ORD(transitionClassGreater)].NextState := transitionStateEnd;
|
||||
|
||||
(* Left paren state. *)
|
||||
SetDefaultTransition(transitionStateLeftParen, TransitionActionFinalize, transitionStateEnd);
|
||||
|
||||
Transitions[ORD(transitionStateLeftParen)][ORD(transitionClassAsterisk)].Action := TransitionActionAccumulate;
|
||||
Transitions[ORD(transitionStateLeftParen)][ORD(transitionClassAsterisk)].NextState := transitionStateComment;
|
||||
|
||||
(* Less state. *)
|
||||
SetDefaultTransition(transitionStateLess, TransitionActionFinalize, transitionStateEnd);
|
||||
|
||||
Transitions[ORD(transitionStateLess)][ORD(transitionClassEquals)].Action := TransitionActionComposite;
|
||||
Transitions[ORD(transitionStateLess)][ORD(transitionClassEquals)].NextState := transitionStateEnd;
|
||||
|
||||
Transitions[ORD(transitionStateLess)][ORD(transitionClassGreater)].Action := TransitionActionComposite;
|
||||
Transitions[ORD(transitionStateLess)][ORD(transitionClassGreater)].NextState := transitionStateEnd;
|
||||
|
||||
(* Hexadecimal after 0x. *)
|
||||
SetDefaultTransition(transitionStateDot, TransitionActionFinalize, transitionStateEnd);
|
||||
|
||||
Transitions[ORD(transitionStateDot)][ORD(transitionClassDot)].Action := TransitionActionComposite;
|
||||
Transitions[ORD(transitionStateDot)][ORD(transitionClassDot)].NextState := transitionStateEnd;
|
||||
|
||||
(* Comment. *)
|
||||
SetDefaultTransition(transitionStateComment, TransitionActionAccumulate, transitionStateComment);
|
||||
|
||||
Transitions[ORD(transitionStateComment)][ORD(transitionClassAsterisk)].Action := TransitionActionAccumulate;
|
||||
Transitions[ORD(transitionStateComment)][ORD(transitionClassAsterisk)].NextState := transitionStateClosingComment;
|
||||
|
||||
Transitions[ORD(transitionStateComment)][ORD(transitionClassEof)].Action := NIL;
|
||||
Transitions[ORD(transitionStateComment)][ORD(transitionClassEof)].NextState := transitionStateEnd;
|
||||
|
||||
(* Closing comment. *)
|
||||
SetDefaultTransition(transitionStateClosingComment, TransitionActionAccumulate, transitionStateComment);
|
||||
|
||||
Transitions[ORD(transitionStateClosingComment)][ORD(transitionClassInvalid)].Action := NIL;
|
||||
Transitions[ORD(transitionStateClosingComment)][ORD(transitionClassInvalid)].NextState := transitionStateEnd;
|
||||
|
||||
Transitions[ORD(transitionStateClosingComment)][ORD(transitionClassRightParen)].Action := TransitionActionDelimited;
|
||||
Transitions[ORD(transitionStateClosingComment)][ORD(transitionClassRightParen)].NextState := transitionStateEnd;
|
||||
|
||||
Transitions[ORD(transitionStateClosingComment)][ORD(transitionClassAsterisk)].Action := TransitionActionAccumulate;
|
||||
Transitions[ORD(transitionStateClosingComment)][ORD(transitionClassAsterisk)].NextState := transitionStateClosingComment;
|
||||
|
||||
Transitions[ORD(transitionStateClosingComment)][ORD(transitionClassEof)].Action := NIL;
|
||||
Transitions[ORD(transitionStateClosingComment)][ORD(transitionClassEof)].NextState := transitionStateEnd;
|
||||
|
||||
(* Character. *)
|
||||
SetDefaultTransition(transitionStateCharacter, TransitionActionAccumulate, transitionStateCharacter);
|
||||
|
||||
Transitions[ORD(transitionStateCharacter)][ORD(transitionClassInvalid)].Action := NIL;
|
||||
Transitions[ORD(transitionStateCharacter)][ORD(transitionClassInvalid)].NextState := transitionStateEnd;
|
||||
|
||||
Transitions[ORD(transitionStateCharacter)][ORD(transitionClassEof)].Action := NIL;
|
||||
Transitions[ORD(transitionStateCharacter)][ORD(transitionClassEof)].NextState := transitionStateEnd;
|
||||
|
||||
Transitions[ORD(transitionStateCharacter)][ORD(transitionClassSingleQuote)].Action := TransitionActionDelimited;
|
||||
Transitions[ORD(transitionStateCharacter)][ORD(transitionClassSingleQuote)].NextState := transitionStateEnd;
|
||||
|
||||
(* String. *)
|
||||
SetDefaultTransition(transitionStateString, TransitionActionAccumulate, transitionStateString);
|
||||
|
||||
Transitions[ORD(transitionStateString)][ORD(transitionClassInvalid)].Action := NIL;
|
||||
Transitions[ORD(transitionStateString)][ORD(transitionClassInvalid)].NextState := transitionStateEnd;
|
||||
|
||||
Transitions[ORD(transitionStateString)][ORD(transitionClassEof)].Action := NIL;
|
||||
Transitions[ORD(transitionStateString)][ORD(transitionClassEof)].NextState := transitionStateEnd;
|
||||
|
||||
Transitions[ORD(transitionStateString)][ORD(transitionClassDoubleQuote)].Action := TransitionActionDelimited;
|
||||
Transitions[ORD(transitionStateString)][ORD(transitionClassDoubleQuote)].NextState := transitionStateEnd;
|
||||
|
||||
(* Leading zero. *)
|
||||
SetDefaultTransition(transitionStateLeadingZero, TransitionActionInteger, transitionStateEnd);
|
||||
|
||||
Transitions[ORD(transitionStateLeadingZero)][ORD(transitionClassDigit)].Action := NIL;
|
||||
Transitions[ORD(transitionStateLeadingZero)][ORD(transitionClassDigit)].NextState := transitionStateEnd;
|
||||
|
||||
Transitions[ORD(transitionStateLeadingZero)][ORD(transitionClassAlpha)].Action := NIL;
|
||||
Transitions[ORD(transitionStateLeadingZero)][ORD(transitionClassAlpha)].NextState := transitionStateEnd;
|
||||
|
||||
Transitions[ORD(transitionStateLeadingZero)][ORD(transitionClassUnderscore)].Action := NIL;
|
||||
Transitions[ORD(transitionStateLeadingZero)][ORD(transitionClassUnderscore)].NextState := transitionStateEnd;
|
||||
|
||||
Transitions[ORD(transitionStateLeadingZero)][ORD(transitionClassHex)].Action := NIL;
|
||||
Transitions[ORD(transitionStateLeadingZero)][ORD(transitionClassHex)].NextState := transitionStateEnd;
|
||||
|
||||
Transitions[ORD(transitionStateLeadingZero)][ORD(transitionClassZero)].Action := NIL;
|
||||
Transitions[ORD(transitionStateLeadingZero)][ORD(transitionClassZero)].NextState := transitionStateEnd;
|
||||
|
||||
Transitions[ORD(transitionStateLeadingZero)][ORD(transitionClassX)].Action := NIL;
|
||||
Transitions[ORD(transitionStateLeadingZero)][ORD(transitionClassX)].NextState := transitionStateEnd;
|
||||
|
||||
(* Digit with a character suffix. *)
|
||||
SetDefaultTransition(transitionStateDecimalSuffix, TransitionActionInteger, transitionStateEnd);
|
||||
|
||||
Transitions[ORD(transitionStateDecimalSuffix)][ORD(transitionClassAlpha)].Action := NIL;
|
||||
Transitions[ORD(transitionStateDecimalSuffix)][ORD(transitionClassAlpha)].NextState := transitionStateEnd;
|
||||
|
||||
Transitions[ORD(transitionStateDecimalSuffix)][ORD(transitionClassDigit)].Action := NIL;
|
||||
Transitions[ORD(transitionStateDecimalSuffix)][ORD(transitionClassDigit)].NextState := transitionStateEnd;
|
||||
|
||||
Transitions[ORD(transitionStateDecimalSuffix)][ORD(transitionClassHex)].Action := NIL;
|
||||
Transitions[ORD(transitionStateDecimalSuffix)][ORD(transitionClassHex)].NextState := transitionStateEnd;
|
||||
|
||||
Transitions[ORD(transitionStateDecimalSuffix)][ORD(transitionClassZero)].Action := NIL;
|
||||
Transitions[ORD(transitionStateDecimalSuffix)][ORD(transitionClassZero)].NextState := transitionStateEnd;
|
||||
|
||||
Transitions[ORD(transitionStateDecimalSuffix)][ORD(transitionClassX)].Action := NIL;
|
||||
Transitions[ORD(transitionStateDecimalSuffix)][ORD(transitionClassX)].NextState := transitionStateEnd
|
||||
END InitializeTransitions;
|
||||
|
||||
PROCEDURE LexerInitialize(ALexer: PLexer; Input: File);
|
||||
BEGIN
|
||||
ALexer^.Input := Input;
|
||||
ALexer^.Length := 0;
|
||||
|
||||
ALLOCATE(ALexer^.Buffer, ChunkSize);
|
||||
MemZero(ALexer^.Buffer, ChunkSize);
|
||||
ALexer^.Size := ChunkSize
|
||||
END LexerInitialize;
|
||||
|
||||
PROCEDURE LexerCurrent(ALexer: PLexer): LexerToken;
|
||||
VAR
|
||||
CurrentClass: TransitionClass;
|
||||
CurrentState: TransitionState;
|
||||
CurrentTransition: Transition;
|
||||
Result: LexerToken;
|
||||
BEGIN
|
||||
ALexer^.Current := ALexer^.Start;
|
||||
Result.Kind := lexerKindTrait;
|
||||
CurrentState := transitionStateStart;
|
||||
|
||||
WHILE CurrentState <> transitionStateEnd DO
|
||||
CurrentClass := Classification[ORD(ALexer^.Current^) + 1];
|
||||
|
||||
CurrentTransition := Transitions[ORD(CurrentState)][ORD(CurrentClass)];
|
||||
IF CurrentTransition.Action <> NIL THEN
|
||||
CurrentTransition.Action(ALexer, ADR(Result))
|
||||
END;
|
||||
CurrentState := CurrentTransition.NextState
|
||||
END;
|
||||
RETURN Result
|
||||
END LexerCurrent;
|
||||
|
||||
PROCEDURE LexerLex(ALexer: PLexer): LexerToken;
|
||||
BEGIN
|
||||
IF ALexer^.Length = 0 THEN
|
||||
ALexer^.Length := ReadNBytes(ALexer^.Input, ChunkSize, ALexer^.Buffer);
|
||||
ALexer^.Current := ALexer^.Buffer
|
||||
END;
|
||||
ALexer^.Start := ALexer^.Current;
|
||||
|
||||
RETURN LexerCurrent(ALexer)
|
||||
END LexerLex;
|
||||
|
||||
PROCEDURE LexerDestroy(ALexer: PLexer);
|
||||
BEGIN
|
||||
DEALLOCATE(ALexer^.Buffer, ALexer^.Size)
|
||||
END LexerDestroy;
|
||||
|
||||
BEGIN
|
||||
InitializeClassification();
|
||||
InitializeTransitions()
|
||||
END Lexer.
|
||||
811
source/Lexer.mod
Normal file
811
source/Lexer.mod
Normal file
@ -0,0 +1,811 @@
|
||||
IMPLEMENTATION MODULE Lexer;
|
||||
|
||||
FROM FIO IMPORT ReadNBytes, StdErr;
|
||||
FROM SYSTEM IMPORT ADR, TSIZE;
|
||||
|
||||
FROM DynamicStrings IMPORT String, InitStringCharStar, KillString;
|
||||
FROM StringConvert IMPORT StringToInteger;
|
||||
FROM Storage IMPORT DEALLOCATE, ALLOCATE;
|
||||
FROM Strings IMPORT Length;
|
||||
FROM MemUtils IMPORT MemCopy, MemZero;
|
||||
FROM StrCase IMPORT Lower;
|
||||
|
||||
CONST
|
||||
CHUNK_SIZE = 65536;
|
||||
|
||||
TYPE
|
||||
(*
|
||||
* Classification table assigns each possible character to a group (class). All
|
||||
* characters of the same group a handled equivalently.
|
||||
*
|
||||
* Classification:
|
||||
*)
|
||||
TransitionClass = (
|
||||
transitionClassInvalid,
|
||||
transitionClassDigit,
|
||||
transitionClassAlpha,
|
||||
transitionClassSpace,
|
||||
transitionClassColon,
|
||||
transitionClassEquals,
|
||||
transitionClassLeftParen,
|
||||
transitionClassRightParen,
|
||||
transitionClassAsterisk,
|
||||
transitionClassUnderscore,
|
||||
transitionClassSingle,
|
||||
transitionClassHex,
|
||||
transitionClassZero,
|
||||
transitionClassX,
|
||||
transitionClassEof,
|
||||
transitionClassDot,
|
||||
transitionClassMinus,
|
||||
transitionClassSingleQuote,
|
||||
transitionClassDoubleQuote,
|
||||
transitionClassGreater,
|
||||
transitionClassLess,
|
||||
transitionClassOther
|
||||
);
|
||||
TransitionState = (
|
||||
transitionStateStart,
|
||||
transitionStateColon,
|
||||
transitionStateIdentifier,
|
||||
transitionStateDecimal,
|
||||
transitionStateGreater,
|
||||
transitionStateMinus,
|
||||
transitionStateLeftParen,
|
||||
transitionStateLess,
|
||||
transitionStateDot,
|
||||
transitionStateComment,
|
||||
transitionStateClosingComment,
|
||||
transitionStateCharacter,
|
||||
transitionStateString,
|
||||
transitionStateLeadingZero,
|
||||
transitionStateDecimalSuffix,
|
||||
transitionStateEnd
|
||||
);
|
||||
TransitionAction = PROCEDURE(PLexer, PLexerToken);
|
||||
Transition = RECORD
|
||||
Action: TransitionAction;
|
||||
NextState: TransitionState
|
||||
END;
|
||||
TransitionClasses = ARRAY[1..22] OF Transition;
|
||||
|
||||
VAR
|
||||
classification: ARRAY[1..128] OF TransitionClass;
|
||||
transitions: ARRAY[1..16] OF TransitionClasses;
|
||||
|
||||
PROCEDURE initialize_classification();
|
||||
VAR
|
||||
i: CARDINAL;
|
||||
BEGIN
|
||||
classification[1] := transitionClassEof; (* NUL *)
|
||||
classification[2] := transitionClassInvalid; (* SOH *)
|
||||
classification[3] := transitionClassInvalid; (* STX *)
|
||||
classification[4] := transitionClassInvalid; (* ETX *)
|
||||
classification[5] := transitionClassInvalid; (* EOT *)
|
||||
classification[6] := transitionClassInvalid; (* EMQ *)
|
||||
classification[7] := transitionClassInvalid; (* ACK *)
|
||||
classification[8] := transitionClassInvalid; (* BEL *)
|
||||
classification[9] := transitionClassInvalid; (* BS *)
|
||||
classification[10] := transitionClassSpace; (* HT *)
|
||||
classification[11] := transitionClassSpace; (* LF *)
|
||||
classification[12] := transitionClassInvalid; (* VT *)
|
||||
classification[13] := transitionClassInvalid; (* FF *)
|
||||
classification[14] := transitionClassSpace; (* CR *)
|
||||
classification[15] := transitionClassInvalid; (* SO *)
|
||||
classification[16] := transitionClassInvalid; (* SI *)
|
||||
classification[17] := transitionClassInvalid; (* DLE *)
|
||||
classification[18] := transitionClassInvalid; (* DC1 *)
|
||||
classification[19] := transitionClassInvalid; (* DC2 *)
|
||||
classification[20] := transitionClassInvalid; (* DC3 *)
|
||||
classification[21] := transitionClassInvalid; (* DC4 *)
|
||||
classification[22] := transitionClassInvalid; (* NAK *)
|
||||
classification[23] := transitionClassInvalid; (* SYN *)
|
||||
classification[24] := transitionClassInvalid; (* ETB *)
|
||||
classification[25] := transitionClassInvalid; (* CAN *)
|
||||
classification[26] := transitionClassInvalid; (* EM *)
|
||||
classification[27] := transitionClassInvalid; (* SUB *)
|
||||
classification[28] := transitionClassInvalid; (* ESC *)
|
||||
classification[29] := transitionClassInvalid; (* FS *)
|
||||
classification[30] := transitionClassInvalid; (* GS *)
|
||||
classification[31] := transitionClassInvalid; (* RS *)
|
||||
classification[32] := transitionClassInvalid; (* US *)
|
||||
classification[33] := transitionClassSpace; (* Space *)
|
||||
classification[34] := transitionClassSingle; (* ! *)
|
||||
classification[35] := transitionClassDoubleQuote; (* " *)
|
||||
classification[36] := transitionClassOther; (* # *)
|
||||
classification[37] := transitionClassOther; (* $ *)
|
||||
classification[38] := transitionClassSingle; (* % *)
|
||||
classification[39] := transitionClassSingle; (* AND *)
|
||||
classification[40] := transitionClassSingleQuote; (* ' *)
|
||||
classification[41] := transitionClassLeftParen; (* ( *)
|
||||
classification[42] := transitionClassRightParen; (* ) *)
|
||||
classification[43] := transitionClassAsterisk; (* * *)
|
||||
classification[44] := transitionClassSingle; (* + *)
|
||||
classification[45] := transitionClassSingle; (* , *)
|
||||
classification[46] := transitionClassMinus; (* - *)
|
||||
classification[47] := transitionClassDot; (* . *)
|
||||
classification[48] := transitionClassSingle; (* / *)
|
||||
classification[49] := transitionClassZero; (* 0 *)
|
||||
classification[50] := transitionClassDigit; (* 1 *)
|
||||
classification[51] := transitionClassDigit; (* 2 *)
|
||||
classification[52] := transitionClassDigit; (* 3 *)
|
||||
classification[53] := transitionClassDigit; (* 4 *)
|
||||
classification[54] := transitionClassDigit; (* 5 *)
|
||||
classification[55] := transitionClassDigit; (* 6 *)
|
||||
classification[56] := transitionClassDigit; (* 7 *)
|
||||
classification[57] := transitionClassDigit; (* 8 *)
|
||||
classification[58] := transitionClassDigit; (* 9 *)
|
||||
classification[59] := transitionClassColon; (* : *)
|
||||
classification[60] := transitionClassSingle; (* ; *)
|
||||
classification[61] := transitionClassLess; (* < *)
|
||||
classification[62] := transitionClassEquals; (* = *)
|
||||
classification[63] := transitionClassGreater; (* > *)
|
||||
classification[64] := transitionClassOther; (* ? *)
|
||||
classification[65] := transitionClassSingle; (* @ *)
|
||||
classification[66] := transitionClassAlpha; (* A *)
|
||||
classification[67] := transitionClassAlpha; (* B *)
|
||||
classification[68] := transitionClassAlpha; (* C *)
|
||||
classification[69] := transitionClassAlpha; (* D *)
|
||||
classification[70] := transitionClassAlpha; (* E *)
|
||||
classification[71] := transitionClassAlpha; (* F *)
|
||||
classification[72] := transitionClassAlpha; (* G *)
|
||||
classification[73] := transitionClassAlpha; (* H *)
|
||||
classification[74] := transitionClassAlpha; (* I *)
|
||||
classification[75] := transitionClassAlpha; (* J *)
|
||||
classification[76] := transitionClassAlpha; (* K *)
|
||||
classification[77] := transitionClassAlpha; (* L *)
|
||||
classification[78] := transitionClassAlpha; (* M *)
|
||||
classification[79] := transitionClassAlpha; (* N *)
|
||||
classification[80] := transitionClassAlpha; (* O *)
|
||||
classification[81] := transitionClassAlpha; (* P *)
|
||||
classification[82] := transitionClassAlpha; (* Q *)
|
||||
classification[83] := transitionClassAlpha; (* R *)
|
||||
classification[84] := transitionClassAlpha; (* S *)
|
||||
classification[85] := transitionClassAlpha; (* T *)
|
||||
classification[86] := transitionClassAlpha; (* U *)
|
||||
classification[87] := transitionClassAlpha; (* V *)
|
||||
classification[88] := transitionClassAlpha; (* W *)
|
||||
classification[89] := transitionClassAlpha; (* X *)
|
||||
classification[90] := transitionClassAlpha; (* Y *)
|
||||
classification[91] := transitionClassAlpha; (* Z *)
|
||||
classification[92] := transitionClassSingle; (* [ *)
|
||||
classification[93] := transitionClassOther; (* \ *)
|
||||
classification[94] := transitionClassSingle; (* ] *)
|
||||
classification[95] := transitionClassSingle; (* ^ *)
|
||||
classification[96] := transitionClassUnderscore; (* _ *)
|
||||
classification[97] := transitionClassOther; (* ` *)
|
||||
classification[98] := transitionClassHex; (* a *)
|
||||
classification[99] := transitionClassHex; (* b *)
|
||||
classification[100] := transitionClassHex; (* c *)
|
||||
classification[101] := transitionClassHex; (* d *)
|
||||
classification[102] := transitionClassHex; (* e *)
|
||||
classification[103] := transitionClassHex; (* f *)
|
||||
classification[104] := transitionClassAlpha; (* g *)
|
||||
classification[105] := transitionClassAlpha; (* h *)
|
||||
classification[106] := transitionClassAlpha; (* i *)
|
||||
classification[107] := transitionClassAlpha; (* j *)
|
||||
classification[108] := transitionClassAlpha; (* k *)
|
||||
classification[109] := transitionClassAlpha; (* l *)
|
||||
classification[110] := transitionClassAlpha; (* m *)
|
||||
classification[111] := transitionClassAlpha; (* n *)
|
||||
classification[112] := transitionClassAlpha; (* o *)
|
||||
classification[113] := transitionClassAlpha; (* p *)
|
||||
classification[114] := transitionClassAlpha; (* q *)
|
||||
classification[115] := transitionClassAlpha; (* r *)
|
||||
classification[116] := transitionClassAlpha; (* s *)
|
||||
classification[117] := transitionClassAlpha; (* t *)
|
||||
classification[118] := transitionClassAlpha; (* u *)
|
||||
classification[119] := transitionClassAlpha; (* v *)
|
||||
classification[120] := transitionClassAlpha; (* w *)
|
||||
classification[121] := transitionClassX; (* x *)
|
||||
classification[122] := transitionClassAlpha; (* y *)
|
||||
classification[123] := transitionClassAlpha; (* z *)
|
||||
classification[124] := transitionClassOther; (* { *)
|
||||
classification[125] := transitionClassSingle; (* | *)
|
||||
classification[126] := transitionClassOther; (* } *)
|
||||
classification[127] := transitionClassSingle; (* ~ *)
|
||||
classification[128] := transitionClassInvalid; (* DEL *)
|
||||
|
||||
i := 129;
|
||||
WHILE i <= 256 DO
|
||||
classification[i] := transitionClassOther;
|
||||
i := i + 1
|
||||
END
|
||||
END initialize_classification;
|
||||
PROCEDURE compare_keyword(Keyword: ARRAY OF CHAR; TokenStart: PLexerBuffer; TokenEnd: PLexerBuffer): BOOLEAN;
|
||||
VAR
|
||||
result: BOOLEAN;
|
||||
index: CARDINAL;
|
||||
BEGIN
|
||||
index := 0;
|
||||
result := TRUE;
|
||||
|
||||
WHILE (index < Length(Keyword)) AND (TokenStart <> TokenEnd) AND result DO
|
||||
result := (Keyword[index] = TokenStart^) OR (Lower(Keyword[index]) = TokenStart^);
|
||||
INC(TokenStart);
|
||||
INC(index)
|
||||
END;
|
||||
result := (index = Length(Keyword)) AND (TokenStart = TokenEnd) AND result;
|
||||
RETURN result
|
||||
END compare_keyword;
|
||||
(* Reached the end of file. *)
|
||||
PROCEDURE transition_action_eof(lexer: PLexer; token: PLexerToken);
|
||||
BEGIN
|
||||
token^.kind := lexerKindEof
|
||||
END transition_action_eof;
|
||||
(* Add the character to the token currently read and advance to the next character. *)
|
||||
PROCEDURE transition_action_accumulate(lexer: PLexer; token: PLexerToken);
|
||||
BEGIN
|
||||
INC(lexer^.Current)
|
||||
END transition_action_accumulate;
|
||||
(* The current character is not a part of the token. Finish the token already
|
||||
* read. Don't advance to the next character. *)
|
||||
PROCEDURE transition_action_finalize(lexer: PLexer; token: PLexerToken);
|
||||
BEGIN
|
||||
IF lexer^.Start^ = ':' THEN
|
||||
token^.kind := lexerKindColon
|
||||
END;
|
||||
IF lexer^.Start^ = '>' THEN
|
||||
token^.kind := lexerKindGreaterThan
|
||||
END;
|
||||
IF lexer^.Start^ = '<' THEN
|
||||
token^.kind := lexerKindLessThan
|
||||
END;
|
||||
IF lexer^.Start^ = '(' THEN
|
||||
token^.kind := lexerKindLeftParen
|
||||
END;
|
||||
IF lexer^.Start^ = '-' THEN
|
||||
token^.kind := lexerKindLeftParen
|
||||
END;
|
||||
IF lexer^.Start^ = '.' THEN
|
||||
token^.kind := lexerKindDot
|
||||
END
|
||||
END transition_action_finalize;
|
||||
(* An action for tokens containing multiple characters. *)
|
||||
PROCEDURE transition_action_composite(lexer: PLexer; token: PLexerToken);
|
||||
BEGIN
|
||||
IF lexer^.Start^ = '<' THEN
|
||||
IF lexer^.Current^ = '>' THEN
|
||||
token^.kind := lexerKindNotEqual
|
||||
END;
|
||||
IF lexer^.Current^ = '=' THEN
|
||||
token^.kind := lexerKindLessEqual
|
||||
END
|
||||
END;
|
||||
IF (lexer^.Start^ = '>') AND (lexer^.Current^ = '=') THEN
|
||||
token^.kind := lexerKindGreaterEqual
|
||||
END;
|
||||
IF (lexer^.Start^ = '.') AND (lexer^.Current^ = '.') THEN
|
||||
token^.kind := lexerKindRange
|
||||
END;
|
||||
IF (lexer^.Start^ = ':') AND (lexer^.Current^ = '=') THEN
|
||||
token^.kind := lexerKindAssignment
|
||||
END;
|
||||
IF (lexer^.Start^ = '-') AND (lexer^.Current^ = '>') THEN
|
||||
token^.kind := lexerKindArrow
|
||||
END;
|
||||
INC(lexer^.Current)
|
||||
END transition_action_composite;
|
||||
(* Skip a space. *)
|
||||
PROCEDURE transition_action_skip(lexer: PLexer; token: PLexerToken);
|
||||
BEGIN
|
||||
INC(lexer^.Current);
|
||||
INC(lexer^.Start)
|
||||
END transition_action_skip;
|
||||
(* Delimited string action. *)
|
||||
PROCEDURE transition_action_delimited(lexer: PLexer; token: PLexerToken);
|
||||
BEGIN
|
||||
IF lexer^.Start^ = '(' THEN
|
||||
token^.kind := lexerKindComment
|
||||
END;
|
||||
IF lexer^.Start^ = '"' THEN
|
||||
token^.kind := lexerKindCharacter
|
||||
END;
|
||||
IF lexer^.Start^ = "'" THEN
|
||||
token^.kind := lexerKindString
|
||||
END;
|
||||
INC(lexer^.Current)
|
||||
END transition_action_delimited;
|
||||
(* Finalize keyword OR identifier. *)
|
||||
PROCEDURE transition_action_key_id(lexer: PLexer; token: PLexerToken);
|
||||
BEGIN
|
||||
token^.kind := lexerKindIdentifier;
|
||||
|
||||
token^.identifierKind[1] := lexer^.Current - lexer^.Start;
|
||||
MemCopy(lexer^.Start, ORD(token^.identifierKind[1]), ADR(token^.identifierKind[2]));
|
||||
|
||||
IF compare_keyword('PROGRAM', lexer^.Start, lexer^.Current) THEN
|
||||
token^.kind := lexerKindProgram
|
||||
END;
|
||||
IF compare_keyword('IMPORT', lexer^.Start, lexer^.Current) THEN
|
||||
token^.kind := lexerKindImport
|
||||
END;
|
||||
IF compare_keyword('CONST', lexer^.Start, lexer^.Current) THEN
|
||||
token^.kind := lexerKindConst
|
||||
END;
|
||||
IF compare_keyword('VAR', lexer^.Start, lexer^.Current) THEN
|
||||
token^.kind := lexerKindVar
|
||||
END;
|
||||
IF compare_keyword('IF', lexer^.Start, lexer^.Current) THEN
|
||||
token^.kind := lexerKindIf
|
||||
END;
|
||||
IF compare_keyword('THEN', lexer^.Start, lexer^.Current) THEN
|
||||
token^.kind := lexerKindThen
|
||||
END;
|
||||
IF compare_keyword('ELSIF', lexer^.Start, lexer^.Current) THEN
|
||||
token^.kind := lexerKindElsif
|
||||
END;
|
||||
IF compare_keyword('ELSE', lexer^.Start, lexer^.Current) THEN
|
||||
token^.kind := lexerKindElse
|
||||
END;
|
||||
IF compare_keyword('WHILE', lexer^.Start, lexer^.Current) THEN
|
||||
token^.kind := lexerKindWhile
|
||||
END;
|
||||
IF compare_keyword('DO', lexer^.Start, lexer^.Current) THEN
|
||||
token^.kind := lexerKindDo
|
||||
END;
|
||||
IF compare_keyword('proc', lexer^.Start, lexer^.Current) THEN
|
||||
token^.kind := lexerKindProc
|
||||
END;
|
||||
IF compare_keyword('BEGIN', lexer^.Start, lexer^.Current) THEN
|
||||
token^.kind := lexerKindBegin
|
||||
END;
|
||||
IF compare_keyword('END', lexer^.Start, lexer^.Current) THEN
|
||||
token^.kind := lexerKindEnd
|
||||
END;
|
||||
IF compare_keyword('TYPE', lexer^.Start, lexer^.Current) THEN
|
||||
token^.kind := lexerKindType
|
||||
END;
|
||||
IF compare_keyword('RECORD', lexer^.Start, lexer^.Current) THEN
|
||||
token^.kind := lexerKindRecord
|
||||
END;
|
||||
IF compare_keyword('UNION', lexer^.Start, lexer^.Current) THEN
|
||||
token^.kind := lexerKindUnion
|
||||
END;
|
||||
IF compare_keyword('NIL', lexer^.Start, lexer^.Current) THEN
|
||||
token^.kind := lexerKindNull
|
||||
END;
|
||||
IF compare_keyword('AND', lexer^.Start, lexer^.Current) THEN
|
||||
token^.kind := lexerKindAnd
|
||||
END;
|
||||
IF compare_keyword('OR', lexer^.Start, lexer^.Current) THEN
|
||||
token^.kind := lexerKindOr
|
||||
END;
|
||||
IF compare_keyword('RETURN', lexer^.Start, lexer^.Current) THEN
|
||||
token^.kind := lexerKindReturn
|
||||
END;
|
||||
IF compare_keyword('DEFINITION', lexer^.Start, lexer^.Current) THEN
|
||||
token^.kind := lexerKindDefinition
|
||||
END;
|
||||
IF compare_keyword('TO', lexer^.Start, lexer^.Current) THEN
|
||||
token^.kind := lexerKindTo
|
||||
END;
|
||||
IF compare_keyword('CASE', lexer^.Start, lexer^.Current) THEN
|
||||
token^.kind := lexerKindCase
|
||||
END;
|
||||
IF compare_keyword('OF', lexer^.Start, lexer^.Current) THEN
|
||||
token^.kind := lexerKindOf
|
||||
END;
|
||||
IF compare_keyword('FROM', lexer^.Start, lexer^.Current) THEN
|
||||
token^.kind := lexerKindFrom
|
||||
END;
|
||||
IF compare_keyword('MODULE', lexer^.Start, lexer^.Current) THEN
|
||||
token^.kind := lexerKindModule
|
||||
END;
|
||||
IF compare_keyword('IMPLEMENTATION', lexer^.Start, lexer^.Current) THEN
|
||||
token^.kind := lexerKindImplementation
|
||||
END;
|
||||
IF compare_keyword('POINTER', lexer^.Start, lexer^.Current) THEN
|
||||
token^.kind := lexerKindPointer
|
||||
END;
|
||||
IF compare_keyword('ARRAY', lexer^.Start, lexer^.Current) THEN
|
||||
token^.kind := lexerKindArray
|
||||
END;
|
||||
IF compare_keyword('TRUE', lexer^.Start, lexer^.Current) THEN
|
||||
token^.kind := lexerKindBoolean;
|
||||
token^.booleanKind := TRUE
|
||||
END;
|
||||
IF compare_keyword('FALSE', lexer^.Start, lexer^.Current) THEN
|
||||
token^.kind := lexerKindBoolean;
|
||||
token^.booleanKind := FALSE
|
||||
END
|
||||
END transition_action_key_id;
|
||||
(* Action for tokens containing only one character. The character cannot be
|
||||
* followed by other characters forming a composite token. *)
|
||||
PROCEDURE transition_action_single(lexer: PLexer; token: PLexerToken);
|
||||
BEGIN
|
||||
IF lexer^.Current^ = '&' THEN
|
||||
token^.kind := lexerKindAnd
|
||||
END;
|
||||
IF lexer^.Current^ = ';' THEN
|
||||
token^.kind := lexerKindSemicolon
|
||||
END;
|
||||
IF lexer^.Current^ = ',' THEN
|
||||
token^.kind := lexerKindComma
|
||||
END;
|
||||
IF lexer^.Current^ = ',' THEN
|
||||
token^.kind := lexerKindComma
|
||||
END;
|
||||
IF lexer^.Current^ = ')' THEN
|
||||
token^.kind := lexerKindRightParen
|
||||
END;
|
||||
IF lexer^.Current^ = '[' THEN
|
||||
token^.kind := lexerKindLeftSquare
|
||||
END;
|
||||
IF lexer^.Current^ = ']' THEN
|
||||
token^.kind := lexerKindRightSquare
|
||||
END;
|
||||
IF lexer^.Current^ = '^' THEN
|
||||
token^.kind := lexerKindHat
|
||||
END;
|
||||
IF lexer^.Current^ = '=' THEN
|
||||
token^.kind := lexerKindEqual
|
||||
END;
|
||||
IF lexer^.Current^ = '+' THEN
|
||||
token^.kind := lexerKindPlus
|
||||
END;
|
||||
IF lexer^.Current^ = '/' THEN
|
||||
token^.kind := lexerKindDivision
|
||||
END;
|
||||
IF lexer^.Current^ = '%' THEN
|
||||
token^.kind := lexerKindRemainder
|
||||
END;
|
||||
IF lexer^.Current^ = '@' THEN
|
||||
token^.kind := lexerKindAt
|
||||
END;
|
||||
IF lexer^.Current^ = '|' THEN
|
||||
token^.kind := lexerKindPipe
|
||||
END;
|
||||
INC(lexer^.Current)
|
||||
END transition_action_single;
|
||||
(* Handle an integer literal. *)
|
||||
PROCEDURE transition_action_integer(lexer: PLexer; token: PLexerToken);
|
||||
VAR
|
||||
buffer: String;
|
||||
integer_length: CARDINAL;
|
||||
found: BOOLEAN;
|
||||
BEGIN
|
||||
token^.kind := lexerKindInteger;
|
||||
|
||||
integer_length := lexer^.Current - lexer^.Start;
|
||||
MemZero(ADR(token^.identifierKind), TSIZE(Identifier));
|
||||
MemCopy(lexer^.Start, integer_length, ADR(token^.identifierKind[1]));
|
||||
|
||||
buffer := InitStringCharStar(ADR(token^.identifierKind[1]));
|
||||
token^.integerKind := StringToInteger(buffer, 10, found);
|
||||
buffer := KillString(buffer)
|
||||
END transition_action_integer;
|
||||
PROCEDURE set_default_transition(CurrentState: TransitionState; DefaultAction: TransitionAction; NextState: TransitionState);
|
||||
VAR
|
||||
DefaultTransition: Transition;
|
||||
BEGIN
|
||||
DefaultTransition.Action := DefaultAction;
|
||||
DefaultTransition.NextState := NextState;
|
||||
|
||||
transitions[ORD(CurrentState) + 1][ORD(transitionClassInvalid) + 1] := DefaultTransition;
|
||||
transitions[ORD(CurrentState) + 1][ORD(transitionClassDigit) + 1] := DefaultTransition;
|
||||
transitions[ORD(CurrentState) + 1][ORD(transitionClassAlpha) + 1] := DefaultTransition;
|
||||
transitions[ORD(CurrentState) + 1][ORD(transitionClassSpace) + 1] := DefaultTransition;
|
||||
transitions[ORD(CurrentState) + 1][ORD(transitionClassColon) + 1] := DefaultTransition;
|
||||
transitions[ORD(CurrentState) + 1][ORD(transitionClassEquals) + 1] := DefaultTransition;
|
||||
transitions[ORD(CurrentState) + 1][ORD(transitionClassLeftParen) + 1] := DefaultTransition;
|
||||
transitions[ORD(CurrentState) + 1][ORD(transitionClassRightParen) + 1] := DefaultTransition;
|
||||
transitions[ORD(CurrentState) + 1][ORD(transitionClassAsterisk) + 1] := DefaultTransition;
|
||||
transitions[ORD(CurrentState) + 1][ORD(transitionClassUnderscore) + 1] := DefaultTransition;
|
||||
transitions[ORD(CurrentState) + 1][ORD(transitionClassSingle) + 1] := DefaultTransition;
|
||||
transitions[ORD(CurrentState) + 1][ORD(transitionClassHex) + 1] := DefaultTransition;
|
||||
transitions[ORD(CurrentState) + 1][ORD(transitionClassZero) + 1] := DefaultTransition;
|
||||
transitions[ORD(CurrentState) + 1][ORD(transitionClassX) + 1] := DefaultTransition;
|
||||
transitions[ORD(CurrentState) + 1][ORD(transitionClassEof) + 1] := DefaultTransition;
|
||||
transitions[ORD(CurrentState) + 1][ORD(transitionClassDot) + 1] := DefaultTransition;
|
||||
transitions[ORD(CurrentState) + 1][ORD(transitionClassMinus) + 1] := DefaultTransition;
|
||||
transitions[ORD(CurrentState) + 1][ORD(transitionClassSingleQuote) + 1] := DefaultTransition;
|
||||
transitions[ORD(CurrentState) + 1][ORD(transitionClassDoubleQuote) + 1] := DefaultTransition;
|
||||
transitions[ORD(CurrentState) + 1][ORD(transitionClassGreater) + 1] := DefaultTransition;
|
||||
transitions[ORD(CurrentState) + 1][ORD(transitionClassLess) + 1] := DefaultTransition;
|
||||
transitions[ORD(CurrentState) + 1][ORD(transitionClassOther) + 1] := DefaultTransition
|
||||
END set_default_transition;
|
||||
(*
|
||||
* The transition table describes transitions from one state to another, given
|
||||
* a symbol (character class).
|
||||
*
|
||||
* The table has m rows and n columns, where m is the amount of states and n is
|
||||
* the amount of classes. So given the current state and a classified character
|
||||
* the table can be used to look up the next state.
|
||||
*
|
||||
* Each cell is a word long.
|
||||
* - The least significant byte of the word is a row number (beginning with 0).
|
||||
* It specifies the target state. "ff" means that this is an end state and no
|
||||
* transition is possible.
|
||||
* - The next byte is the action that should be performed when transitioning.
|
||||
* For the meaning of actions see labels in the lex_next function, which
|
||||
* handles each action.
|
||||
*)
|
||||
PROCEDURE initialize_transitions();
|
||||
BEGIN
|
||||
(* Start state. *)
|
||||
transitions[ORD(transitionStateStart) + 1][ORD(transitionClassInvalid) + 1].Action := NIL;
|
||||
transitions[ORD(transitionStateStart) + 1][ORD(transitionClassInvalid) + 1].NextState := transitionStateEnd;
|
||||
|
||||
transitions[ORD(transitionStateStart) + 1][ORD(transitionClassDigit) + 1].Action := transition_action_accumulate;
|
||||
transitions[ORD(transitionStateStart) + 1][ORD(transitionClassDigit) + 1].NextState := transitionStateDecimal;
|
||||
|
||||
transitions[ORD(transitionStateStart) + 1][ORD(transitionClassAlpha) + 1].Action := transition_action_accumulate;
|
||||
transitions[ORD(transitionStateStart) + 1][ORD(transitionClassAlpha) + 1].NextState := transitionStateIdentifier;
|
||||
|
||||
transitions[ORD(transitionStateStart) + 1][ORD(transitionClassSpace) + 1].Action := transition_action_skip;
|
||||
transitions[ORD(transitionStateStart) + 1][ORD(transitionClassSpace) + 1].NextState := transitionStateStart;
|
||||
|
||||
transitions[ORD(transitionStateStart) + 1][ORD(transitionClassColon) + 1].Action := transition_action_accumulate;
|
||||
transitions[ORD(transitionStateStart) + 1][ORD(transitionClassColon) + 1].NextState := transitionStateColon;
|
||||
|
||||
transitions[ORD(transitionStateStart) + 1][ORD(transitionClassEquals) + 1].Action := transition_action_single;
|
||||
transitions[ORD(transitionStateStart) + 1][ORD(transitionClassEquals) + 1].NextState := transitionStateEnd;
|
||||
|
||||
transitions[ORD(transitionStateStart) + 1][ORD(transitionClassLeftParen) + 1].Action := transition_action_accumulate;
|
||||
transitions[ORD(transitionStateStart) + 1][ORD(transitionClassLeftParen) + 1].NextState := transitionStateLeftParen;
|
||||
|
||||
transitions[ORD(transitionStateStart) + 1][ORD(transitionClassRightParen) + 1].Action := transition_action_single;
|
||||
transitions[ORD(transitionStateStart) + 1][ORD(transitionClassRightParen) + 1].NextState := transitionStateEnd;
|
||||
|
||||
transitions[ORD(transitionStateStart) + 1][ORD(transitionClassAsterisk) + 1].Action := transition_action_single;
|
||||
transitions[ORD(transitionStateStart) + 1][ORD(transitionClassAsterisk) + 1].NextState := transitionStateEnd;
|
||||
|
||||
transitions[ORD(transitionStateStart) + 1][ORD(transitionClassUnderscore) + 1].Action := transition_action_accumulate;
|
||||
transitions[ORD(transitionStateStart) + 1][ORD(transitionClassUnderscore) + 1].NextState := transitionStateIdentifier;
|
||||
|
||||
transitions[ORD(transitionStateStart) + 1][ORD(transitionClassSingle) + 1].Action := transition_action_single;
|
||||
transitions[ORD(transitionStateStart) + 1][ORD(transitionClassSingle) + 1].NextState := transitionStateEnd;
|
||||
|
||||
transitions[ORD(transitionStateStart) + 1][ORD(transitionClassHex) + 1].Action := transition_action_accumulate;
|
||||
transitions[ORD(transitionStateStart) + 1][ORD(transitionClassHex) + 1].NextState := transitionStateIdentifier;
|
||||
|
||||
transitions[ORD(transitionStateStart) + 1][ORD(transitionClassZero) + 1].Action := transition_action_accumulate;
|
||||
transitions[ORD(transitionStateStart) + 1][ORD(transitionClassZero) + 1].NextState := transitionStateLeadingZero;
|
||||
|
||||
transitions[ORD(transitionStateStart) + 1][ORD(transitionClassX) + 1].Action := transition_action_accumulate;
|
||||
transitions[ORD(transitionStateStart) + 1][ORD(transitionClassX) + 1].NextState := transitionStateIdentifier;
|
||||
|
||||
transitions[ORD(transitionStateStart) + 1][ORD(transitionClassEof) + 1].Action := transition_action_eof;
|
||||
transitions[ORD(transitionStateStart) + 1][ORD(transitionClassEof) + 1].NextState := transitionStateEnd;
|
||||
|
||||
transitions[ORD(transitionStateStart) + 1][ORD(transitionClassDot) + 1].Action := transition_action_accumulate;
|
||||
transitions[ORD(transitionStateStart) + 1][ORD(transitionClassDot) + 1].NextState := transitionStateDot;
|
||||
|
||||
transitions[ORD(transitionStateStart) + 1][ORD(transitionClassMinus) + 1].Action := transition_action_accumulate;
|
||||
transitions[ORD(transitionStateStart) + 1][ORD(transitionClassMinus) + 1].NextState := transitionStateMinus;
|
||||
|
||||
transitions[ORD(transitionStateStart) + 1][ORD(transitionClassSingleQuote) + 1].Action := transition_action_accumulate;
|
||||
transitions[ORD(transitionStateStart) + 1][ORD(transitionClassSingleQuote) + 1].NextState := transitionStateCharacter;
|
||||
|
||||
transitions[ORD(transitionStateStart) + 1][ORD(transitionClassDoubleQuote) + 1].Action := transition_action_accumulate;
|
||||
transitions[ORD(transitionStateStart) + 1][ORD(transitionClassDoubleQuote) + 1].NextState := transitionStateString;
|
||||
|
||||
transitions[ORD(transitionStateStart) + 1][ORD(transitionClassGreater) + 1].Action := transition_action_accumulate;
|
||||
transitions[ORD(transitionStateStart) + 1][ORD(transitionClassGreater) + 1].NextState := transitionStateGreater;
|
||||
|
||||
transitions[ORD(transitionStateStart) + 1][ORD(transitionClassLess) + 1].Action := transition_action_accumulate;
|
||||
transitions[ORD(transitionStateStart) + 1][ORD(transitionClassLess) + 1].NextState := transitionStateLess;
|
||||
|
||||
transitions[ORD(transitionStateStart) + 1][ORD(transitionClassOther) + 1].Action := NIL;
|
||||
transitions[ORD(transitionStateStart) + 1][ORD(transitionClassOther) + 1].NextState := transitionStateEnd;
|
||||
|
||||
(* Colon state. *)
|
||||
set_default_transition(transitionStateColon, transition_action_finalize, transitionStateEnd);
|
||||
|
||||
transitions[ORD(transitionStateColon) + 1][ORD(transitionClassEquals) + 1].Action := transition_action_composite;
|
||||
transitions[ORD(transitionStateColon) + 1][ORD(transitionClassEquals) + 1].NextState := transitionStateEnd;
|
||||
|
||||
(* Identifier state. *)
|
||||
set_default_transition(transitionStateIdentifier, transition_action_key_id, transitionStateEnd);
|
||||
|
||||
transitions[ORD(transitionStateIdentifier) + 1][ORD(transitionClassDigit) + 1].Action := transition_action_accumulate;
|
||||
transitions[ORD(transitionStateIdentifier) + 1][ORD(transitionClassDigit) + 1].NextState := transitionStateIdentifier;
|
||||
|
||||
transitions[ORD(transitionStateIdentifier) + 1][ORD(transitionClassAlpha) + 1].Action := transition_action_accumulate;
|
||||
transitions[ORD(transitionStateIdentifier) + 1][ORD(transitionClassAlpha) + 1].NextState := transitionStateIdentifier;
|
||||
|
||||
transitions[ORD(transitionStateIdentifier) + 1][ORD(transitionClassUnderscore) + 1].Action := transition_action_accumulate;
|
||||
transitions[ORD(transitionStateIdentifier) + 1][ORD(transitionClassUnderscore) + 1].NextState := transitionStateIdentifier;
|
||||
|
||||
transitions[ORD(transitionStateIdentifier) + 1][ORD(transitionClassHex) + 1].Action := transition_action_accumulate;
|
||||
transitions[ORD(transitionStateIdentifier) + 1][ORD(transitionClassHex) + 1].NextState := transitionStateIdentifier;
|
||||
|
||||
transitions[ORD(transitionStateIdentifier) + 1][ORD(transitionClassZero) + 1].Action := transition_action_accumulate;
|
||||
transitions[ORD(transitionStateIdentifier) + 1][ORD(transitionClassZero) + 1].NextState := transitionStateIdentifier;
|
||||
|
||||
transitions[ORD(transitionStateIdentifier) + 1][ORD(transitionClassX) + 1].Action := transition_action_accumulate;
|
||||
transitions[ORD(transitionStateIdentifier) + 1][ORD(transitionClassX) + 1].NextState := transitionStateIdentifier;
|
||||
|
||||
(* Decimal state. *)
|
||||
set_default_transition(transitionStateDecimal, transition_action_integer, transitionStateEnd);
|
||||
|
||||
transitions[ORD(transitionStateDecimal) + 1][ORD(transitionClassDigit) + 1].Action := transition_action_accumulate;
|
||||
transitions[ORD(transitionStateDecimal) + 1][ORD(transitionClassDigit) + 1].NextState := transitionStateDecimal;
|
||||
|
||||
transitions[ORD(transitionStateDecimal) + 1][ORD(transitionClassAlpha) + 1].Action := transition_action_accumulate;
|
||||
transitions[ORD(transitionStateDecimal) + 1][ORD(transitionClassAlpha) + 1].NextState := transitionStateDecimalSuffix;
|
||||
|
||||
transitions[ORD(transitionStateDecimal) + 1][ORD(transitionClassUnderscore) + 1].Action := NIL;
|
||||
transitions[ORD(transitionStateDecimal) + 1][ORD(transitionClassUnderscore) + 1].NextState := transitionStateEnd;
|
||||
|
||||
transitions[ORD(transitionStateDecimal) + 1][ORD(transitionClassHex) + 1].Action := transition_action_accumulate;
|
||||
transitions[ORD(transitionStateDecimal) + 1][ORD(transitionClassHex) + 1].NextState := transitionStateDecimalSuffix;
|
||||
|
||||
transitions[ORD(transitionStateDecimal) + 1][ORD(transitionClassZero) + 1].Action := transition_action_accumulate;
|
||||
transitions[ORD(transitionStateDecimal) + 1][ORD(transitionClassZero) + 1].NextState := transitionStateDecimal;
|
||||
|
||||
transitions[ORD(transitionStateDecimal) + 1][ORD(transitionClassX) + 1].Action := transition_action_accumulate;
|
||||
transitions[ORD(transitionStateDecimal) + 1][ORD(transitionClassX) + 1].NextState := transitionStateDecimalSuffix;
|
||||
|
||||
(* Greater state. *)
|
||||
set_default_transition(transitionStateGreater, transition_action_finalize, transitionStateEnd);
|
||||
|
||||
transitions[ORD(transitionStateGreater) + 1][ORD(transitionClassEquals) + 1].Action := transition_action_composite;
|
||||
transitions[ORD(transitionStateGreater) + 1][ORD(transitionClassEquals) + 1].NextState := transitionStateEnd;
|
||||
|
||||
(* Minus state. *)
|
||||
set_default_transition(transitionStateMinus, transition_action_finalize, transitionStateEnd);
|
||||
|
||||
transitions[ORD(transitionStateMinus) + 1][ORD(transitionClassGreater) + 1].Action := transition_action_composite;
|
||||
transitions[ORD(transitionStateMinus) + 1][ORD(transitionClassGreater) + 1].NextState := transitionStateEnd;
|
||||
|
||||
(* Left paren state. *)
|
||||
set_default_transition(transitionStateLeftParen, transition_action_finalize, transitionStateEnd);
|
||||
|
||||
transitions[ORD(transitionStateLeftParen) + 1][ORD(transitionClassAsterisk) + 1].Action := transition_action_accumulate;
|
||||
transitions[ORD(transitionStateLeftParen) + 1][ORD(transitionClassAsterisk) + 1].NextState := transitionStateComment;
|
||||
|
||||
(* Less state. *)
|
||||
set_default_transition(transitionStateLess, transition_action_finalize, transitionStateEnd);
|
||||
|
||||
transitions[ORD(transitionStateLess) + 1][ORD(transitionClassEquals) + 1].Action := transition_action_composite;
|
||||
transitions[ORD(transitionStateLess) + 1][ORD(transitionClassEquals) + 1].NextState := transitionStateEnd;
|
||||
|
||||
transitions[ORD(transitionStateLess) + 1][ORD(transitionClassGreater) + 1].Action := transition_action_composite;
|
||||
transitions[ORD(transitionStateLess) + 1][ORD(transitionClassGreater) + 1].NextState := transitionStateEnd;
|
||||
|
||||
(* Hexadecimal after 0x. *)
|
||||
set_default_transition(transitionStateDot, transition_action_finalize, transitionStateEnd);
|
||||
|
||||
transitions[ORD(transitionStateDot) + 1][ORD(transitionClassDot) + 1].Action := transition_action_composite;
|
||||
transitions[ORD(transitionStateDot) + 1][ORD(transitionClassDot) + 1].NextState := transitionStateEnd;
|
||||
|
||||
(* Comment. *)
|
||||
set_default_transition(transitionStateComment, transition_action_accumulate, transitionStateComment);
|
||||
|
||||
transitions[ORD(transitionStateComment) + 1][ORD(transitionClassAsterisk) + 1].Action := transition_action_accumulate;
|
||||
transitions[ORD(transitionStateComment) + 1][ORD(transitionClassAsterisk) + 1].NextState := transitionStateClosingComment;
|
||||
|
||||
transitions[ORD(transitionStateComment) + 1][ORD(transitionClassEof) + 1].Action := NIL;
|
||||
transitions[ORD(transitionStateComment) + 1][ORD(transitionClassEof) + 1].NextState := transitionStateEnd;
|
||||
|
||||
(* Closing comment. *)
|
||||
set_default_transition(transitionStateClosingComment, transition_action_accumulate, transitionStateComment);
|
||||
|
||||
transitions[ORD(transitionStateClosingComment) + 1][ORD(transitionClassInvalid) + 1].Action := NIL;
|
||||
transitions[ORD(transitionStateClosingComment) + 1][ORD(transitionClassInvalid) + 1].NextState := transitionStateEnd;
|
||||
|
||||
transitions[ORD(transitionStateClosingComment) + 1][ORD(transitionClassRightParen) + 1].Action := transition_action_delimited;
|
||||
transitions[ORD(transitionStateClosingComment) + 1][ORD(transitionClassRightParen) + 1].NextState := transitionStateEnd;
|
||||
|
||||
transitions[ORD(transitionStateClosingComment) + 1][ORD(transitionClassAsterisk) + 1].Action := transition_action_accumulate;
|
||||
transitions[ORD(transitionStateClosingComment) + 1][ORD(transitionClassAsterisk) + 1].NextState := transitionStateClosingComment;
|
||||
|
||||
transitions[ORD(transitionStateClosingComment) + 1][ORD(transitionClassEof) + 1].Action := NIL;
|
||||
transitions[ORD(transitionStateClosingComment) + 1][ORD(transitionClassEof) + 1].NextState := transitionStateEnd;
|
||||
|
||||
(* Character. *)
|
||||
set_default_transition(transitionStateCharacter, transition_action_accumulate, transitionStateCharacter);
|
||||
|
||||
transitions[ORD(transitionStateCharacter) + 1][ORD(transitionClassInvalid) + 1].Action := NIL;
|
||||
transitions[ORD(transitionStateCharacter) + 1][ORD(transitionClassInvalid) + 1].NextState := transitionStateEnd;
|
||||
|
||||
transitions[ORD(transitionStateCharacter) + 1][ORD(transitionClassEof) + 1].Action := NIL;
|
||||
transitions[ORD(transitionStateCharacter) + 1][ORD(transitionClassEof) + 1].NextState := transitionStateEnd;
|
||||
|
||||
transitions[ORD(transitionStateCharacter) + 1][ORD(transitionClassSingleQuote) + 1].Action := transition_action_delimited;
|
||||
transitions[ORD(transitionStateCharacter) + 1][ORD(transitionClassSingleQuote) + 1].NextState := transitionStateEnd;
|
||||
|
||||
(* String. *)
|
||||
set_default_transition(transitionStateString, transition_action_accumulate, transitionStateString);
|
||||
|
||||
transitions[ORD(transitionStateString) + 1][ORD(transitionClassInvalid) + 1].Action := NIL;
|
||||
transitions[ORD(transitionStateString) + 1][ORD(transitionClassInvalid) + 1].NextState := transitionStateEnd;
|
||||
|
||||
transitions[ORD(transitionStateString) + 1][ORD(transitionClassEof) + 1].Action := NIL;
|
||||
transitions[ORD(transitionStateString) + 1][ORD(transitionClassEof) + 1].NextState := transitionStateEnd;
|
||||
|
||||
transitions[ORD(transitionStateString) + 1][ORD(transitionClassDoubleQuote) + 1].Action := transition_action_delimited;
|
||||
transitions[ORD(transitionStateString) + 1][ORD(transitionClassDoubleQuote) + 1].NextState := transitionStateEnd;
|
||||
|
||||
(* Leading zero. *)
|
||||
set_default_transition(transitionStateLeadingZero, transition_action_integer, transitionStateEnd);
|
||||
|
||||
transitions[ORD(transitionStateLeadingZero) + 1][ORD(transitionClassDigit) + 1].Action := NIL;
|
||||
transitions[ORD(transitionStateLeadingZero) + 1][ORD(transitionClassDigit) + 1].NextState := transitionStateEnd;
|
||||
|
||||
transitions[ORD(transitionStateLeadingZero) + 1][ORD(transitionClassAlpha) + 1].Action := NIL;
|
||||
transitions[ORD(transitionStateLeadingZero) + 1][ORD(transitionClassAlpha) + 1].NextState := transitionStateEnd;
|
||||
|
||||
transitions[ORD(transitionStateLeadingZero) + 1][ORD(transitionClassUnderscore) + 1].Action := NIL;
|
||||
transitions[ORD(transitionStateLeadingZero) + 1][ORD(transitionClassUnderscore) + 1].NextState := transitionStateEnd;
|
||||
|
||||
transitions[ORD(transitionStateLeadingZero) + 1][ORD(transitionClassHex) + 1].Action := NIL;
|
||||
transitions[ORD(transitionStateLeadingZero) + 1][ORD(transitionClassHex) + 1].NextState := transitionStateEnd;
|
||||
|
||||
transitions[ORD(transitionStateLeadingZero) + 1][ORD(transitionClassZero) + 1].Action := NIL;
|
||||
transitions[ORD(transitionStateLeadingZero) + 1][ORD(transitionClassZero) + 1].NextState := transitionStateEnd;
|
||||
|
||||
transitions[ORD(transitionStateLeadingZero) + 1][ORD(transitionClassX) + 1].Action := NIL;
|
||||
transitions[ORD(transitionStateLeadingZero) + 1][ORD(transitionClassX) + 1].NextState := transitionStateEnd;
|
||||
|
||||
(* Digit with a character suffix. *)
|
||||
set_default_transition(transitionStateDecimalSuffix, transition_action_integer, transitionStateEnd);
|
||||
|
||||
transitions[ORD(transitionStateDecimalSuffix) + 1][ORD(transitionClassAlpha) + 1].Action := NIL;
|
||||
transitions[ORD(transitionStateDecimalSuffix) + 1][ORD(transitionClassAlpha) + 1].NextState := transitionStateEnd;
|
||||
|
||||
transitions[ORD(transitionStateDecimalSuffix) + 1][ORD(transitionClassDigit) + 1].Action := NIL;
|
||||
transitions[ORD(transitionStateDecimalSuffix) + 1][ORD(transitionClassDigit) + 1].NextState := transitionStateEnd;
|
||||
|
||||
transitions[ORD(transitionStateDecimalSuffix) + 1][ORD(transitionClassHex) + 1].Action := NIL;
|
||||
transitions[ORD(transitionStateDecimalSuffix) + 1][ORD(transitionClassHex) + 1].NextState := transitionStateEnd;
|
||||
|
||||
transitions[ORD(transitionStateDecimalSuffix) + 1][ORD(transitionClassZero) + 1].Action := NIL;
|
||||
transitions[ORD(transitionStateDecimalSuffix) + 1][ORD(transitionClassZero) + 1].NextState := transitionStateEnd;
|
||||
|
||||
transitions[ORD(transitionStateDecimalSuffix) + 1][ORD(transitionClassX) + 1].Action := NIL;
|
||||
transitions[ORD(transitionStateDecimalSuffix) + 1][ORD(transitionClassX) + 1].NextState := transitionStateEnd
|
||||
END initialize_transitions;
|
||||
PROCEDURE lexer_initialize(lexer: PLexer; Input: File);
|
||||
BEGIN
|
||||
lexer^.Input := Input;
|
||||
lexer^.Length := 0;
|
||||
|
||||
ALLOCATE(lexer^.Buffer, CHUNK_SIZE);
|
||||
MemZero(lexer^.Buffer, CHUNK_SIZE);
|
||||
lexer^.Size := CHUNK_SIZE
|
||||
END lexer_initialize;
|
||||
PROCEDURE lexer_current(lexer: PLexer): LexerToken;
|
||||
VAR
|
||||
CurrentClass: TransitionClass;
|
||||
CurrentState: TransitionState;
|
||||
CurrentTransition: Transition;
|
||||
result: LexerToken;
|
||||
BEGIN
|
||||
lexer^.Current := lexer^.Start;
|
||||
CurrentState := transitionStateStart;
|
||||
|
||||
WHILE CurrentState <> transitionStateEnd DO
|
||||
CurrentClass := classification[ORD(lexer^.Current^) + 1];
|
||||
|
||||
CurrentTransition := transitions[ORD(CurrentState) + 1][ORD(CurrentClass) + 1];
|
||||
IF CurrentTransition.Action <> NIL THEN
|
||||
CurrentTransition.Action(lexer, ADR(result))
|
||||
END;
|
||||
CurrentState := CurrentTransition.NextState
|
||||
END;
|
||||
RETURN result
|
||||
END lexer_current;
|
||||
PROCEDURE lexer_lex(lexer: PLexer): LexerToken;
|
||||
VAR
|
||||
result: LexerToken;
|
||||
BEGIN
|
||||
IF lexer^.Length = 0 THEN
|
||||
lexer^.Length := ReadNBytes(lexer^.Input, CHUNK_SIZE, lexer^.Buffer);
|
||||
lexer^.Current := lexer^.Buffer
|
||||
END;
|
||||
lexer^.Start := lexer^.Current;
|
||||
|
||||
result := lexer_current(lexer);
|
||||
RETURN result
|
||||
END lexer_lex;
|
||||
PROCEDURE lexer_destroy(lexer: PLexer);
|
||||
BEGIN
|
||||
DEALLOCATE(lexer^.Buffer, lexer^.Size)
|
||||
END lexer_destroy;
|
||||
BEGIN
|
||||
initialize_classification();
|
||||
initialize_transitions()
|
||||
END Lexer.
|
||||
78
source/Parser.def
Normal file
78
source/Parser.def
Normal file
@ -0,0 +1,78 @@
|
||||
DEFINITION MODULE Parser;
|
||||
|
||||
FROM Common IMPORT Identifier, PIdentifier;
|
||||
FROM Lexer IMPORT PLexer;
|
||||
|
||||
TYPE
|
||||
AstImportStatement = RECORD
|
||||
package: Identifier;
|
||||
symbols: PIdentifier
|
||||
END;
|
||||
PAstImportStatement = POINTER TO AstImportStatement;
|
||||
PPAstImportStatement = POINTER TO PAstImportStatement;
|
||||
|
||||
AstConstantDeclaration = RECORD
|
||||
constant_name: Identifier;
|
||||
constant_value: INTEGER
|
||||
END;
|
||||
PAstConstantDeclaration = POINTER TO AstConstantDeclaration;
|
||||
PPAstConstantDeclaration = POINTER TO PAstConstantDeclaration;
|
||||
|
||||
AstFieldDeclaration = RECORD
|
||||
field_name: Identifier;
|
||||
field_type: PAstTypeExpression
|
||||
END;
|
||||
PAstFieldDeclaration = POINTER TO AstFieldDeclaration;
|
||||
|
||||
AstTypeExpressionKind = (
|
||||
astTypeExpressionKindNamed,
|
||||
astTypeExpressionKindRecord,
|
||||
astTypeExpressionKindEnumeration,
|
||||
astTypeExpressionKindArray,
|
||||
astTypeExpressionKindPointer,
|
||||
astTypeExpressionKindProcedure
|
||||
);
|
||||
AstTypeExpression = RECORD
|
||||
CASE kind: AstTypeExpressionKind OF
|
||||
astTypeExpressionKindNamed: name: Identifier |
|
||||
astTypeExpressionKindEnumeration: cases: PIdentifier |
|
||||
astTypeExpressionKindPointer: target: PAstTypeExpression |
|
||||
astTypeExpressionKindRecord: fields: PAstFieldDeclaration |
|
||||
astTypeExpressionKindArray:
|
||||
base: PAstTypeExpression;
|
||||
length: CARDINAL |
|
||||
astTypeExpressionKindProcedure: parameters: PPAstTypeExpression
|
||||
END
|
||||
END;
|
||||
PAstTypeExpression = POINTER TO AstTypeExpression;
|
||||
PPAstTypeExpression = POINTER TO PAstTypeExpression;
|
||||
|
||||
AstTypeDeclaration = RECORD
|
||||
identifier: Identifier;
|
||||
type_expression: PAstTypeExpression
|
||||
END;
|
||||
PAstTypeDeclaration = POINTER TO AstTypeDeclaration;
|
||||
PPAstTypeDeclaration = POINTER TO PAstTypeDeclaration;
|
||||
|
||||
AstVariableDeclaration = RECORD
|
||||
variable_name: Identifier;
|
||||
variable_type: PAstTypeExpression
|
||||
END;
|
||||
PAstVariableDeclaration = POINTER TO AstVariableDeclaration;
|
||||
PPAstVariableDeclaration = POINTER TO PAstVariableDeclaration;
|
||||
|
||||
AstModule = RECORD
|
||||
imports: PPAstImportStatement;
|
||||
constants: PPAstConstantDeclaration;
|
||||
types: PPAstTypeDeclaration;
|
||||
variables: PPAstVariableDeclaration
|
||||
END;
|
||||
PAstModule = POINTER TO AstModule;
|
||||
|
||||
PROCEDURE parse_type_expression(lexer: PLexer): PAstTypeExpression;
|
||||
PROCEDURE parse_type_part(lexer: PLexer): PPAstTypeDeclaration;
|
||||
PROCEDURE parse_variable_part(lexer: PLexer): PPAstVariableDeclaration;
|
||||
PROCEDURE parse_constant_part(lexer: PLexer): PPAstConstantDeclaration;
|
||||
PROCEDURE parse_import_part(lexer: PLexer): PPAstImportStatement;
|
||||
|
||||
END Parser.
|
||||
449
source/Parser.mod
Normal file
449
source/Parser.mod
Normal file
@ -0,0 +1,449 @@
|
||||
IMPLEMENTATION MODULE Parser;
|
||||
|
||||
FROM SYSTEM IMPORT TSIZE;
|
||||
|
||||
FROM MemUtils IMPORT MemZero;
|
||||
FROM Storage IMPORT ALLOCATE, REALLOCATE;
|
||||
|
||||
FROM Lexer IMPORT LexerKind, LexerToken, lexer_current, lexer_lex;
|
||||
|
||||
(* Calls lexer_lex() but skips the comments. *)
|
||||
PROCEDURE transpiler_lex(lexer: PLexer): LexerToken;
|
||||
VAR
|
||||
result: LexerToken;
|
||||
BEGIN
|
||||
result := lexer_lex(lexer);
|
||||
|
||||
WHILE result.kind = lexerKindComment DO
|
||||
result := lexer_lex(lexer)
|
||||
END;
|
||||
|
||||
RETURN result
|
||||
END transpiler_lex;
|
||||
PROCEDURE parse_type_fields(lexer: PLexer): PAstFieldDeclaration;
|
||||
VAR
|
||||
token: LexerToken;
|
||||
field_declarations: PAstFieldDeclaration;
|
||||
field_count: CARDINAL;
|
||||
current_field: PAstFieldDeclaration;
|
||||
BEGIN
|
||||
ALLOCATE(field_declarations, TSIZE(AstFieldDeclaration));
|
||||
token := transpiler_lex(lexer);
|
||||
field_count := 0;
|
||||
|
||||
WHILE token.kind <> lexerKindEnd DO
|
||||
INC(field_count);
|
||||
REALLOCATE(field_declarations, TSIZE(AstFieldDeclaration) * (field_count + 1));
|
||||
current_field := field_declarations;
|
||||
INC(current_field , TSIZE(AstFieldDeclaration) * (field_count - 1));
|
||||
|
||||
token := transpiler_lex(lexer);
|
||||
|
||||
current_field^.field_name := token.identifierKind;
|
||||
|
||||
token := transpiler_lex(lexer);
|
||||
current_field^.field_type := parse_type_expression(lexer);
|
||||
token := transpiler_lex(lexer);
|
||||
|
||||
IF token.kind = lexerKindSemicolon THEN
|
||||
token := transpiler_lex(lexer)
|
||||
END
|
||||
END;
|
||||
INC(current_field, TSIZE(AstFieldDeclaration));
|
||||
MemZero(current_field, TSIZE(AstFieldDeclaration));
|
||||
|
||||
RETURN field_declarations
|
||||
END parse_type_fields;
|
||||
PROCEDURE parse_record_type(lexer: PLexer): PAstTypeExpression;
|
||||
VAR
|
||||
result: PAstTypeExpression;
|
||||
BEGIN
|
||||
ALLOCATE(result, TSIZE(AstTypeExpression));
|
||||
result^.kind := astTypeExpressionKindRecord;
|
||||
result^.fields := parse_type_fields(lexer);
|
||||
|
||||
RETURN result
|
||||
END parse_record_type;
|
||||
PROCEDURE parse_pointer_type(lexer: PLexer): PAstTypeExpression;
|
||||
VAR
|
||||
token: LexerToken;
|
||||
result: PAstTypeExpression;
|
||||
BEGIN
|
||||
ALLOCATE(result, TSIZE(AstTypeExpression));
|
||||
result^.kind := astTypeExpressionKindPointer;
|
||||
|
||||
token := lexer_current(lexer);
|
||||
|
||||
IF token.kind = lexerKindPointer THEN
|
||||
token := transpiler_lex(lexer)
|
||||
END;
|
||||
token := lexer_current(lexer);
|
||||
result^.target := parse_type_expression(lexer);
|
||||
|
||||
RETURN result
|
||||
END parse_pointer_type;
|
||||
PROCEDURE parse_array_type(lexer: PLexer): PAstTypeExpression;
|
||||
VAR
|
||||
token: LexerToken;
|
||||
buffer: ARRAY[1..20] OF CHAR;
|
||||
result: PAstTypeExpression;
|
||||
BEGIN
|
||||
ALLOCATE(result, TSIZE(AstTypeExpression));
|
||||
result^.kind := astTypeExpressionKindArray;
|
||||
result^.length := 0;
|
||||
|
||||
token := lexer_current(lexer);
|
||||
|
||||
IF token.kind = lexerKindArray THEN
|
||||
token := transpiler_lex(lexer)
|
||||
END;
|
||||
IF token.kind <> lexerKindOf THEN
|
||||
token := transpiler_lex(lexer);
|
||||
|
||||
result^.length := token.integerKind;
|
||||
|
||||
token := transpiler_lex(lexer);
|
||||
END;
|
||||
token := transpiler_lex(lexer);
|
||||
result^.base := parse_type_expression(lexer);
|
||||
|
||||
RETURN result
|
||||
END parse_array_type;
|
||||
PROCEDURE parse_enumeration_type(lexer: PLexer): PAstTypeExpression;
|
||||
VAR
|
||||
token: LexerToken;
|
||||
result: PAstTypeExpression;
|
||||
current_case: PIdentifier;
|
||||
case_count: CARDINAL;
|
||||
BEGIN
|
||||
ALLOCATE(result, TSIZE(AstTypeExpression));
|
||||
result^.kind := astTypeExpressionKindEnumeration;
|
||||
|
||||
case_count := 1;
|
||||
ALLOCATE(result^.cases, TSIZE(Identifier) * 2);
|
||||
token := transpiler_lex(lexer);
|
||||
current_case := result^.cases;
|
||||
current_case^ := token.identifierKind;
|
||||
|
||||
token := transpiler_lex(lexer);
|
||||
|
||||
WHILE token.kind = lexerKindComma DO
|
||||
token := transpiler_lex(lexer);
|
||||
|
||||
INC(case_count);
|
||||
REALLOCATE(result^.cases, TSIZE(Identifier) * (case_count + 1));
|
||||
current_case := result^.cases;
|
||||
INC(current_case, TSIZE(Identifier) * (case_count - 1));
|
||||
current_case^ := token.identifierKind;
|
||||
|
||||
token := transpiler_lex(lexer)
|
||||
END;
|
||||
INC(current_case, TSIZE(Identifier));
|
||||
MemZero(current_case, TSIZE(Identifier));
|
||||
|
||||
RETURN result
|
||||
END parse_enumeration_type;
|
||||
PROCEDURE parse_named_type(lexer: PLexer): PAstTypeExpression;
|
||||
VAR
|
||||
token: LexerToken;
|
||||
result: PAstTypeExpression;
|
||||
written_bytes: CARDINAL;
|
||||
BEGIN
|
||||
token := lexer_current(lexer);
|
||||
ALLOCATE(result, TSIZE(AstTypeExpression));
|
||||
|
||||
result^.kind := astTypeExpressionKindNamed;
|
||||
result^.name := token.identifierKind;
|
||||
|
||||
RETURN result
|
||||
END parse_named_type;
|
||||
PROCEDURE parse_procedure_type(lexer: PLexer): PAstTypeExpression;
|
||||
VAR
|
||||
token: LexerToken;
|
||||
result: PAstTypeExpression;
|
||||
current_parameter: PPAstTypeExpression;
|
||||
parameter_count: CARDINAL;
|
||||
BEGIN
|
||||
parameter_count := 0;
|
||||
ALLOCATE(result, TSIZE(AstTypeExpression));
|
||||
result^.kind := astTypeExpressionKindProcedure;
|
||||
|
||||
ALLOCATE(result^.parameters, 1);
|
||||
|
||||
token := transpiler_lex(lexer);
|
||||
token := transpiler_lex(lexer);
|
||||
|
||||
WHILE token.kind <> lexerKindRightParen DO
|
||||
INC(parameter_count);
|
||||
REALLOCATE(result^.parameters, TSIZE(PAstTypeExpression) * (parameter_count + 1));
|
||||
current_parameter := result^.parameters;
|
||||
INC(current_parameter, TSIZE(PAstTypeExpression) * (parameter_count - 1));
|
||||
|
||||
current_parameter^ := parse_type_expression(lexer);
|
||||
|
||||
token := transpiler_lex(lexer);
|
||||
IF token.kind = lexerKindComma THEN
|
||||
token := transpiler_lex(lexer)
|
||||
END
|
||||
END;
|
||||
current_parameter := result^.parameters;
|
||||
INC(current_parameter, TSIZE(PAstTypeExpression) * parameter_count);
|
||||
current_parameter^ := NIL;
|
||||
|
||||
RETURN result
|
||||
END parse_procedure_type;
|
||||
PROCEDURE parse_type_expression(lexer: PLexer): PAstTypeExpression;
|
||||
VAR
|
||||
token: LexerToken;
|
||||
result: PAstTypeExpression;
|
||||
BEGIN
|
||||
result := NIL;
|
||||
token := lexer_current(lexer);
|
||||
|
||||
IF token.kind = lexerKindRecord THEN
|
||||
result := parse_record_type(lexer)
|
||||
END;
|
||||
IF token.kind = lexerKindLeftParen THEN
|
||||
result := parse_enumeration_type(lexer)
|
||||
END;
|
||||
IF (token.kind = lexerKindArray) OR (token.kind = lexerKindLeftSquare) THEN
|
||||
result := parse_array_type(lexer)
|
||||
END;
|
||||
IF token.kind = lexerKindHat THEN
|
||||
result := parse_pointer_type(lexer)
|
||||
END;
|
||||
IF token.kind = lexerKindProc THEN
|
||||
result := parse_procedure_type(lexer)
|
||||
END;
|
||||
IF token.kind = lexerKindIdentifier THEN
|
||||
result := parse_named_type(lexer)
|
||||
END;
|
||||
RETURN result
|
||||
END parse_type_expression;
|
||||
PROCEDURE parse_type_declaration(lexer: PLexer): PAstTypeDeclaration;
|
||||
VAR
|
||||
token: LexerToken;
|
||||
result: PAstTypeDeclaration;
|
||||
BEGIN
|
||||
token := lexer_current(lexer);
|
||||
|
||||
ALLOCATE(result, TSIZE(AstTypeDeclaration));
|
||||
result^.identifier := token.identifierKind;
|
||||
|
||||
token := transpiler_lex(lexer);
|
||||
token := transpiler_lex(lexer);
|
||||
|
||||
result^.type_expression := parse_type_expression(lexer);
|
||||
token := transpiler_lex(lexer);
|
||||
|
||||
RETURN result
|
||||
END parse_type_declaration;
|
||||
PROCEDURE parse_type_part(lexer: PLexer): PPAstTypeDeclaration;
|
||||
VAR
|
||||
token: LexerToken;
|
||||
result: PPAstTypeDeclaration;
|
||||
current_declaration: PPAstTypeDeclaration;
|
||||
declaration_count: CARDINAL;
|
||||
BEGIN
|
||||
token := lexer_current(lexer);
|
||||
|
||||
ALLOCATE(result, TSIZE(PAstTypeDeclaration));
|
||||
current_declaration := result;
|
||||
declaration_count := 0;
|
||||
|
||||
IF token.kind = lexerKindType THEN
|
||||
token := transpiler_lex(lexer);
|
||||
|
||||
WHILE token.kind = lexerKindIdentifier DO
|
||||
INC(declaration_count);
|
||||
|
||||
REALLOCATE(result, TSIZE(PAstTypeDeclaration) * (declaration_count + 1));
|
||||
current_declaration := result;
|
||||
INC(current_declaration, TSIZE(PAstTypeDeclaration) * (declaration_count - 1));
|
||||
|
||||
current_declaration^ := parse_type_declaration(lexer);
|
||||
token := transpiler_lex(lexer)
|
||||
END
|
||||
END;
|
||||
IF declaration_count <> 0 THEN
|
||||
INC(current_declaration, TSIZE(PAstTypeDeclaration))
|
||||
END;
|
||||
current_declaration^ := NIL;
|
||||
|
||||
RETURN result
|
||||
END parse_type_part;
|
||||
PROCEDURE parse_variable_declaration(lexer: PLexer): PAstVariableDeclaration;
|
||||
VAR
|
||||
token: LexerToken;
|
||||
result: PAstVariableDeclaration;
|
||||
BEGIN
|
||||
ALLOCATE(result, TSIZE(AstVariableDeclaration));
|
||||
|
||||
token := lexer_current(lexer);
|
||||
result^.variable_name := token.identifierKind;
|
||||
|
||||
token := transpiler_lex(lexer);
|
||||
|
||||
token := transpiler_lex(lexer);
|
||||
result^.variable_type := parse_type_expression(lexer);
|
||||
|
||||
token := transpiler_lex(lexer);
|
||||
RETURN result
|
||||
END parse_variable_declaration;
|
||||
PROCEDURE parse_variable_part(lexer: PLexer): PPAstVariableDeclaration;
|
||||
VAR
|
||||
token: LexerToken;
|
||||
result: PPAstVariableDeclaration;
|
||||
current_declaration: PPAstVariableDeclaration;
|
||||
declaration_count: CARDINAL;
|
||||
BEGIN
|
||||
token := lexer_current(lexer);
|
||||
|
||||
ALLOCATE(result, TSIZE(PAstVariableDeclaration));
|
||||
current_declaration := result;
|
||||
declaration_count := 0;
|
||||
|
||||
IF token.kind = lexerKindVar THEN
|
||||
token := transpiler_lex(lexer);
|
||||
|
||||
WHILE token.kind = lexerKindIdentifier DO
|
||||
INC(declaration_count);
|
||||
|
||||
REALLOCATE(result, TSIZE(PAstVariableDeclaration) * (declaration_count + 1));
|
||||
current_declaration := result;
|
||||
INC(current_declaration, TSIZE(PAstVariableDeclaration) * (declaration_count - 1));
|
||||
|
||||
current_declaration^ := parse_variable_declaration(lexer);
|
||||
token := transpiler_lex(lexer)
|
||||
END
|
||||
END;
|
||||
IF declaration_count <> 0 THEN
|
||||
INC(current_declaration, TSIZE(PAstVariableDeclaration))
|
||||
END;
|
||||
current_declaration^ := NIL;
|
||||
|
||||
RETURN result
|
||||
END parse_variable_part;
|
||||
PROCEDURE parse_constant_declaration(lexer: PLexer): PAstConstantDeclaration;
|
||||
VAR
|
||||
token: LexerToken;
|
||||
result: PAstConstantDeclaration;
|
||||
BEGIN
|
||||
ALLOCATE(result, TSIZE(AstConstantDeclaration));
|
||||
|
||||
token := lexer_current(lexer);
|
||||
result^.constant_name := token.identifierKind;
|
||||
|
||||
token := transpiler_lex(lexer);
|
||||
|
||||
token := transpiler_lex(lexer);
|
||||
result^.constant_value := token.integerKind;
|
||||
|
||||
token := transpiler_lex(lexer);
|
||||
|
||||
RETURN result
|
||||
END parse_constant_declaration;
|
||||
PROCEDURE parse_constant_part(lexer: PLexer): PPAstConstantDeclaration;
|
||||
VAR
|
||||
token: LexerToken;
|
||||
result: PPAstConstantDeclaration;
|
||||
current_declaration: PPAstConstantDeclaration;
|
||||
declaration_count: CARDINAL;
|
||||
BEGIN
|
||||
token := lexer_current(lexer);
|
||||
|
||||
ALLOCATE(result, TSIZE(PAstConstantDeclaration));
|
||||
current_declaration := result;
|
||||
declaration_count := 0;
|
||||
|
||||
IF token.kind = lexerKindConst THEN
|
||||
token := transpiler_lex(lexer);
|
||||
|
||||
WHILE token.kind = lexerKindIdentifier DO
|
||||
INC(declaration_count);
|
||||
|
||||
REALLOCATE(result, TSIZE(PAstConstantDeclaration) * (declaration_count + 1));
|
||||
current_declaration := result;
|
||||
INC(current_declaration, TSIZE(PAstConstantDeclaration) * (declaration_count - 1));
|
||||
|
||||
current_declaration^ := parse_constant_declaration(lexer);
|
||||
token := transpiler_lex(lexer)
|
||||
END
|
||||
END;
|
||||
IF declaration_count <> 0 THEN
|
||||
INC(current_declaration, TSIZE(PAstConstantDeclaration))
|
||||
END;
|
||||
current_declaration^ := NIL;
|
||||
|
||||
RETURN result
|
||||
END parse_constant_part;
|
||||
PROCEDURE parse_import_statement(lexer: PLexer): PAstImportStatement;
|
||||
VAR
|
||||
result: PAstImportStatement;
|
||||
token: LexerToken;
|
||||
symbol_count: CARDINAL;
|
||||
current_symbol: PIdentifier;
|
||||
BEGIN
|
||||
ALLOCATE(result, TSIZE(AstImportStatement));
|
||||
symbol_count := 1;
|
||||
|
||||
token := transpiler_lex(lexer);
|
||||
result^.package := token.identifierKind;
|
||||
|
||||
token := transpiler_lex(lexer);
|
||||
ALLOCATE(result^.symbols, TSIZE(Identifier) * 2);
|
||||
|
||||
current_symbol := result^.symbols;
|
||||
|
||||
token := transpiler_lex(lexer);
|
||||
current_symbol^ := token.identifierKind;
|
||||
|
||||
token := transpiler_lex(lexer);
|
||||
WHILE token.kind <> lexerKindSemicolon DO
|
||||
token := transpiler_lex(lexer);
|
||||
INC(symbol_count);
|
||||
|
||||
REALLOCATE(result^.symbols, TSIZE(Identifier) * (symbol_count + 1));
|
||||
current_symbol := result^.symbols;
|
||||
INC(current_symbol, TSIZE(Identifier) * (symbol_count - 1));
|
||||
|
||||
current_symbol^ := token.identifierKind;
|
||||
token := transpiler_lex(lexer)
|
||||
END;
|
||||
INC(current_symbol, TSIZE(Identifier));
|
||||
MemZero(current_symbol, TSIZE(Identifier));
|
||||
|
||||
token := transpiler_lex(lexer);
|
||||
|
||||
RETURN result
|
||||
END parse_import_statement;
|
||||
PROCEDURE parse_import_part(lexer: PLexer): PPAstImportStatement;
|
||||
VAR
|
||||
token: LexerToken;
|
||||
import_statement: PPAstImportStatement;
|
||||
result: PPAstImportStatement;
|
||||
import_count: CARDINAL;
|
||||
BEGIN
|
||||
token := lexer_current(lexer);
|
||||
ALLOCATE(result, TSIZE(PAstImportStatement));
|
||||
import_statement := result;
|
||||
import_count := 0;
|
||||
|
||||
WHILE token.kind = lexerKindFrom DO
|
||||
INC(import_count);
|
||||
|
||||
REALLOCATE(result, TSIZE(PAstImportStatement) * (import_count + 1));
|
||||
import_statement := result;
|
||||
INC(import_statement, TSIZE(PAstImportStatement) * (import_count - 1));
|
||||
|
||||
import_statement^ := parse_import_statement(lexer);
|
||||
token := lexer_current(lexer)
|
||||
END;
|
||||
IF import_count > 0 THEN
|
||||
INC(import_statement, TSIZE(PAstImportStatement))
|
||||
END;
|
||||
import_statement^ := NIL;
|
||||
|
||||
RETURN result
|
||||
END parse_import_part;
|
||||
END Parser.
|
||||
@ -1,7 +1,18 @@
|
||||
DEFINITION MODULE Transpiler;
|
||||
|
||||
FROM Lexer IMPORT PLexer;
|
||||
FROM FIO IMPORT File;
|
||||
|
||||
PROCEDURE Transpile(ALexer: PLexer);
|
||||
FROM Common IMPORT ShortString;
|
||||
FROM Lexer IMPORT PLexer, Lexer;
|
||||
|
||||
TYPE
|
||||
TranspilerContext = RECORD
|
||||
input_name: ShortString;
|
||||
output: File;
|
||||
lexer: PLexer
|
||||
END;
|
||||
PTranspilerContext = POINTER TO TranspilerContext;
|
||||
|
||||
PROCEDURE transpile(lexer: PLexer; output: File; input_name: ShortString);
|
||||
|
||||
END Transpiler.
|
||||
|
||||
@ -1,160 +0,0 @@
|
||||
IMPLEMENTATION MODULE Transpiler;
|
||||
|
||||
FROM FIO IMPORT WriteNBytes, StdOut;
|
||||
FROM SYSTEM IMPORT ADR, ADDRESS;
|
||||
|
||||
FROM Terminal IMPORT Write, WriteLn, WriteString;
|
||||
FROM Lexer IMPORT Lexer, LexerToken, LexerCurrent, LexerLex, LexerKind;
|
||||
|
||||
TYPE
|
||||
TranspilerContext = RECORD
|
||||
END;
|
||||
PTranspilerContext = POINTER TO TranspilerContext;
|
||||
|
||||
(* Calls LexerLex() but skips the comments. *)
|
||||
PROCEDURE TranspilerLex(ALexer: PLexer): LexerToken;
|
||||
VAR
|
||||
Result: LexerToken;
|
||||
BEGIN
|
||||
Result := LexerLex(ALexer);
|
||||
|
||||
WHILE Result.Kind = lexerKindComment DO
|
||||
Result := LexerLex(ALexer)
|
||||
END;
|
||||
|
||||
RETURN Result
|
||||
END TranspilerLex;
|
||||
|
||||
(* Write a semicolon followed by a newline. *)
|
||||
PROCEDURE WriteSemicolon();
|
||||
BEGIN
|
||||
WriteString(';');
|
||||
WriteLn()
|
||||
END WriteSemicolon;
|
||||
|
||||
PROCEDURE TranspileImport(AContext: PTranspilerContext; ALexer: PLexer);
|
||||
VAR
|
||||
Token: LexerToken;
|
||||
WrittenBytes: CARDINAL;
|
||||
BEGIN
|
||||
WriteString('FROM ');
|
||||
Token := TranspilerLex(ALexer);
|
||||
|
||||
WrittenBytes := WriteNBytes(StdOut, ADDRESS(ALexer^.Current - ALexer^.Start), ALexer^.Start);
|
||||
|
||||
Token := TranspilerLex(ALexer);
|
||||
WriteString(' IMPORT ');
|
||||
|
||||
Token := TranspilerLex(ALexer);
|
||||
WrittenBytes := WriteNBytes(StdOut, ADDRESS(ALexer^.Current - ALexer^.Start), ALexer^.Start);
|
||||
|
||||
Token := TranspilerLex(ALexer);
|
||||
WHILE Token.Kind <> lexerKindSemicolon DO
|
||||
WriteString(', ');
|
||||
Token := TranspilerLex(ALexer);
|
||||
WrittenBytes := WriteNBytes(StdOut, ADDRESS(ALexer^.Current - ALexer^.Start), ALexer^.Start);
|
||||
Token := TranspilerLex(ALexer)
|
||||
END;
|
||||
WriteSemicolon();
|
||||
Token := TranspilerLex(ALexer)
|
||||
END TranspileImport;
|
||||
|
||||
PROCEDURE TranspileImportPart(AContext: PTranspilerContext; ALexer: PLexer);
|
||||
VAR
|
||||
Token: LexerToken;
|
||||
BEGIN
|
||||
Token := LexerCurrent(ALexer);
|
||||
|
||||
WHILE Token.Kind = lexerKindFrom DO
|
||||
TranspileImport(AContext, ALexer);
|
||||
Token := LexerCurrent(ALexer)
|
||||
END;
|
||||
WriteLn()
|
||||
END TranspileImportPart;
|
||||
|
||||
PROCEDURE TranspileConstant(AContext: PTranspilerContext; ALexer: PLexer);
|
||||
VAR
|
||||
Token: LexerToken;
|
||||
WrittenBytes: CARDINAL;
|
||||
BEGIN
|
||||
WriteString(' ');
|
||||
Token := LexerCurrent(ALexer);
|
||||
WrittenBytes := WriteNBytes(StdOut, ADDRESS(ALexer^.Current - ALexer^.Start), ALexer^.Start);
|
||||
|
||||
Token := TranspilerLex(ALexer);
|
||||
WriteString(' = ');
|
||||
|
||||
Token := TranspilerLex(ALexer);
|
||||
WrittenBytes := WriteNBytes(StdOut, ADDRESS(ALexer^.Current - ALexer^.Start), ALexer^.Start);
|
||||
|
||||
Token := TranspilerLex(ALexer);
|
||||
WriteSemicolon()
|
||||
END TranspileConstant;
|
||||
|
||||
PROCEDURE TranspileConstantPart(AContext: PTranspilerContext; ALexer: PLexer);
|
||||
VAR
|
||||
Token: LexerToken;
|
||||
BEGIN
|
||||
Token := LexerCurrent(ALexer);
|
||||
|
||||
IF Token.Kind = lexerKindConst THEN
|
||||
WriteString('CONST');
|
||||
WriteLn();
|
||||
Token := TranspilerLex(ALexer);
|
||||
|
||||
WHILE Token.Kind = lexerKindIdentifier DO
|
||||
TranspileConstant(AContext, ALexer);
|
||||
Token := TranspilerLex(ALexer)
|
||||
END;
|
||||
WriteLn()
|
||||
END
|
||||
END TranspileConstantPart;
|
||||
|
||||
PROCEDURE TranspileModule(AContext: PTranspilerContext; ALexer: PLexer);
|
||||
VAR
|
||||
Token: LexerToken;
|
||||
WrittenBytes: CARDINAL;
|
||||
BEGIN
|
||||
Token := TranspilerLex(ALexer);
|
||||
|
||||
IF Token.Kind = lexerKindDefinition THEN
|
||||
WriteString('DEFINITION ');
|
||||
Token := TranspilerLex(ALexer);
|
||||
ELSIF Token.Kind = lexerKindImplementation THEN
|
||||
WriteString('IMPLEMENTATION ');
|
||||
Token := TranspilerLex(ALexer)
|
||||
END;
|
||||
WriteString('MODULE ');
|
||||
|
||||
(* Write the module name and end the line with a semicolon and newline. *)
|
||||
Token := TranspilerLex(ALexer);
|
||||
WrittenBytes := WriteNBytes(StdOut, ADDRESS(ALexer^.Current - ALexer^.Start), ALexer^.Start);
|
||||
|
||||
Token := TranspilerLex(ALexer);
|
||||
WriteSemicolon();
|
||||
WriteLn();
|
||||
|
||||
(* Write the module body. *)
|
||||
Token := TranspilerLex(ALexer);
|
||||
TranspileImportPart(AContext, ALexer);
|
||||
TranspileConstantPart(AContext, ALexer);
|
||||
|
||||
Token := LexerCurrent(ALexer);
|
||||
WHILE Token.Kind <> lexerKindEof DO
|
||||
WrittenBytes := WriteNBytes(StdOut, ADDRESS(ALexer^.Current - ALexer^.Start), ALexer^.Start);
|
||||
WriteLn();
|
||||
|
||||
Token := TranspilerLex(ALexer)
|
||||
END
|
||||
END TranspileModule;
|
||||
|
||||
PROCEDURE Transpile(ALexer: PLexer);
|
||||
VAR
|
||||
Token: LexerToken;
|
||||
WrittenBytes: CARDINAL;
|
||||
Context: TranspilerContext;
|
||||
BEGIN
|
||||
TranspileModule(ADR(Context), ALexer)
|
||||
END Transpile;
|
||||
|
||||
END Transpiler.
|
||||
645
source/Transpiler.mod
Normal file
645
source/Transpiler.mod
Normal file
@ -0,0 +1,645 @@
|
||||
IMPLEMENTATION MODULE Transpiler;
|
||||
|
||||
FROM FIO IMPORT WriteNBytes, WriteLine, WriteChar, WriteString;
|
||||
FROM SYSTEM IMPORT ADR, ADDRESS, TSIZE;
|
||||
|
||||
FROM NumberIO IMPORT IntToStr;
|
||||
FROM Storage IMPORT ALLOCATE, REALLOCATE;
|
||||
FROM MemUtils IMPORT MemCopy, MemZero;
|
||||
|
||||
FROM Common IMPORT Identifier, PIdentifier, ShortString;
|
||||
FROM Lexer IMPORT Lexer, LexerToken, lexer_current, lexer_lex, LexerKind;
|
||||
FROM Parser IMPORT AstModule, PAstModule, AstTypeExpressionKind,
|
||||
PAstConstantDeclaration, PPAstConstantDeclaration,
|
||||
AstTypeDeclaration, PAstTypeDeclaration, PPAstTypeDeclaration,
|
||||
PAstVariableDeclaration, PPAstVariableDeclaration, PAstImportStatement, PPAstImportStatement,
|
||||
PAstTypeExpression, PPAstTypeExpression, AstFieldDeclaration, PAstFieldDeclaration,
|
||||
parse_type_expression, parse_variable_part, parse_type_part, parse_constant_part, parse_import_part;
|
||||
|
||||
(* Calls lexer_lex() but skips the comments. *)
|
||||
PROCEDURE transpiler_lex(lexer: PLexer): LexerToken;
|
||||
VAR
|
||||
result: LexerToken;
|
||||
BEGIN
|
||||
result := lexer_lex(lexer);
|
||||
|
||||
WHILE result.kind = lexerKindComment DO
|
||||
result := lexer_lex(lexer)
|
||||
END;
|
||||
|
||||
RETURN result
|
||||
END transpiler_lex;
|
||||
(* Write a semicolon followed by a newline. *)
|
||||
PROCEDURE write_semicolon(output: File);
|
||||
BEGIN
|
||||
WriteChar(output, ';');
|
||||
WriteLine(output)
|
||||
END write_semicolon;
|
||||
PROCEDURE write_current(lexer: PLexer; output: File);
|
||||
VAR
|
||||
written_bytes: CARDINAL;
|
||||
BEGIN
|
||||
written_bytes := WriteNBytes(output, ADDRESS(lexer^.Current - lexer^.Start), lexer^.Start)
|
||||
END write_current;
|
||||
PROCEDURE transpile_import_statement(context: PTranspilerContext; import_statement: PAstImportStatement);
|
||||
VAR
|
||||
token: LexerToken;
|
||||
written_bytes: CARDINAL;
|
||||
current_symbol: PIdentifier;
|
||||
BEGIN
|
||||
WriteString(context^.output, 'FROM ');
|
||||
written_bytes := WriteNBytes(context^.output, ORD(import_statement^.package[1]), ADR(import_statement^.package[2]));
|
||||
|
||||
WriteString(context^.output, ' IMPORT ');
|
||||
|
||||
current_symbol := import_statement^.symbols;
|
||||
written_bytes := WriteNBytes(context^.output, ORD(current_symbol^[1]), ADR(current_symbol^[2]));
|
||||
INC(current_symbol, TSIZE(Identifier));
|
||||
|
||||
WHILE ORD(current_symbol^[1]) <> 0 DO
|
||||
WriteString(context^.output, ', ');
|
||||
written_bytes := WriteNBytes(context^.output, ORD(current_symbol^[1]), ADR(current_symbol^[2]));
|
||||
INC(current_symbol, TSIZE(Identifier))
|
||||
END;
|
||||
write_semicolon(context^.output)
|
||||
END transpile_import_statement;
|
||||
PROCEDURE transpile_import_part(context: PTranspilerContext; imports: PPAstImportStatement);
|
||||
VAR
|
||||
import_statement: PAstImportStatement;
|
||||
BEGIN
|
||||
WHILE imports^ <> NIL DO
|
||||
transpile_import_statement(context, imports^);
|
||||
INC(imports, TSIZE(PAstImportStatement))
|
||||
END;
|
||||
WriteLine(context^.output)
|
||||
END transpile_import_part;
|
||||
PROCEDURE transpile_constant_declaration(context: PTranspilerContext; declaration: PAstConstantDeclaration);
|
||||
VAR
|
||||
buffer: ARRAY[1..20] OF CHAR;
|
||||
written_bytes: CARDINAL;
|
||||
BEGIN
|
||||
WriteString(context^.output, ' ');
|
||||
written_bytes := WriteNBytes(context^.output, ORD(declaration^.constant_name[1]), ADR(declaration^.constant_name[2]));
|
||||
|
||||
WriteString(context^.output, ' = ');
|
||||
|
||||
IntToStr(declaration^.constant_value, 0, buffer);
|
||||
WriteString(context^.output, buffer);
|
||||
|
||||
write_semicolon(context^.output)
|
||||
END transpile_constant_declaration;
|
||||
PROCEDURE transpile_constant_part(context: PTranspilerContext; declarations: PPAstConstantDeclaration);
|
||||
VAR
|
||||
current_declaration: PPAstConstantDeclaration;
|
||||
BEGIN
|
||||
IF declarations^ <> NIL THEN
|
||||
WriteString(context^.output, 'CONST');
|
||||
WriteLine(context^.output);
|
||||
|
||||
current_declaration := declarations;
|
||||
WHILE current_declaration^ <> NIL DO
|
||||
transpile_constant_declaration(context, current_declaration^);
|
||||
|
||||
INC(current_declaration, TSIZE(PAstConstantDeclaration))
|
||||
END;
|
||||
WriteLine(context^.output)
|
||||
END
|
||||
END transpile_constant_part;
|
||||
PROCEDURE transpile_module(context: PTranspilerContext): PAstModule;
|
||||
VAR
|
||||
token: LexerToken;
|
||||
result: PAstModule;
|
||||
BEGIN
|
||||
ALLOCATE(result, TSIZE(AstModule));
|
||||
token := transpiler_lex(context^.lexer);
|
||||
|
||||
IF token.kind = lexerKindModule THEN
|
||||
WriteString(context^.output, 'IMPLEMENTATION ')
|
||||
END;
|
||||
WriteString(context^.output, 'MODULE ');
|
||||
|
||||
(* Write the module name and end the line with a semicolon and newline. *)
|
||||
transpile_module_name(context);
|
||||
|
||||
token := transpiler_lex(context^.lexer);
|
||||
write_semicolon(context^.output);
|
||||
WriteLine(context^.output);
|
||||
|
||||
(* Write the module body. *)
|
||||
token := transpiler_lex(context^.lexer);
|
||||
|
||||
result^.imports := parse_import_part(context^.lexer);
|
||||
transpile_import_part(context, result^.imports);
|
||||
|
||||
result^.constants := parse_constant_part(context^.lexer);
|
||||
transpile_constant_part(context, result^.constants);
|
||||
result^.types := parse_type_part(context^.lexer);
|
||||
transpile_type_part(context, result^.types);
|
||||
|
||||
result^.variables := parse_variable_part(context^.lexer);
|
||||
transpile_variable_part(context, result^.variables);
|
||||
|
||||
transpile_procedure_part(context);
|
||||
transpile_statement_part(context);
|
||||
|
||||
WriteString(context^.output, 'END ');
|
||||
transpile_module_name(context);
|
||||
|
||||
token := transpiler_lex(context^.lexer);
|
||||
WriteChar(context^.output, '.');
|
||||
|
||||
token := transpiler_lex(context^.lexer);
|
||||
WriteLine(context^.output);
|
||||
|
||||
RETURN result
|
||||
END transpile_module;
|
||||
PROCEDURE transpile_type_fields(context: PTranspilerContext; fields: PAstFieldDeclaration);
|
||||
VAR
|
||||
written_bytes: CARDINAL;
|
||||
current_field: PAstFieldDeclaration;
|
||||
BEGIN
|
||||
current_field := fields;
|
||||
|
||||
WHILE ORD(current_field^.field_name[1]) <> 0 DO
|
||||
WriteString(context^.output, ' ');
|
||||
written_bytes := WriteNBytes(context^.output, ORD(current_field^.field_name[1]), ADR(current_field^.field_name[2]));
|
||||
|
||||
WriteString(context^.output, ': ');
|
||||
transpile_type_expression(context, current_field^.field_type);
|
||||
|
||||
INC(current_field , TSIZE(AstFieldDeclaration));
|
||||
|
||||
IF ORD(current_field^.field_name[1]) <> 0 THEN
|
||||
WriteChar(context^.output, ';')
|
||||
END;
|
||||
WriteLine(context^.output)
|
||||
END
|
||||
END transpile_type_fields;
|
||||
PROCEDURE transpile_record_type(context: PTranspilerContext; type_expression: PAstTypeExpression);
|
||||
BEGIN
|
||||
WriteString(context^.output, 'RECORD');
|
||||
WriteLine(context^.output);
|
||||
transpile_type_fields(context, type_expression^.fields);
|
||||
WriteString(context^.output, ' END')
|
||||
END transpile_record_type;
|
||||
PROCEDURE transpile_pointer_type(context: PTranspilerContext; type_expression: PAstTypeExpression);
|
||||
VAR
|
||||
token: LexerToken;
|
||||
BEGIN
|
||||
WriteString(context^.output, 'POINTER TO ');
|
||||
|
||||
transpile_type_expression(context, type_expression^.target)
|
||||
END transpile_pointer_type;
|
||||
PROCEDURE transpile_array_type(context: PTranspilerContext; type_expression: PAstTypeExpression);
|
||||
VAR
|
||||
buffer: ARRAY[1..20] OF CHAR;
|
||||
BEGIN
|
||||
WriteString(context^.output, 'ARRAY');
|
||||
|
||||
IF type_expression^.length <> 0 THEN
|
||||
WriteString(context^.output, '[1..');
|
||||
|
||||
IntToStr(type_expression^.length, 0, buffer);
|
||||
WriteString(context^.output, buffer);
|
||||
|
||||
WriteChar(context^.output, ']')
|
||||
END;
|
||||
WriteString(context^.output, ' OF ');
|
||||
|
||||
transpile_type_expression(context, type_expression^.base)
|
||||
END transpile_array_type;
|
||||
PROCEDURE transpile_enumeration_type(context: PTranspilerContext; type_expression: PAstTypeExpression);
|
||||
VAR
|
||||
current_case: PIdentifier;
|
||||
written_bytes: CARDINAL;
|
||||
BEGIN
|
||||
current_case := type_expression^.cases;
|
||||
|
||||
WriteString(context^.output, '(');
|
||||
WriteLine(context^.output);
|
||||
WriteString(context^.output, ' ');
|
||||
written_bytes := WriteNBytes(context^.output, ORD(current_case^[1]), ADR(current_case^[2]));
|
||||
INC(current_case, TSIZE(Identifier));
|
||||
|
||||
WHILE ORD(current_case^[1]) <> 0 DO
|
||||
WriteChar(context^.output, ',');
|
||||
WriteLine(context^.output);
|
||||
WriteString(context^.output, ' ');
|
||||
written_bytes := WriteNBytes(context^.output, ORD(current_case^[1]), ADR(current_case^[2]));
|
||||
|
||||
INC(current_case, TSIZE(Identifier))
|
||||
END;
|
||||
WriteLine(context^.output);
|
||||
WriteString(context^.output, ' )')
|
||||
END transpile_enumeration_type;
|
||||
PROCEDURE transpile_named_type(context: PTranspilerContext; type_expression: PAstTypeExpression);
|
||||
VAR
|
||||
written_bytes: CARDINAL;
|
||||
BEGIN
|
||||
written_bytes := WriteNBytes(context^.output, ORD(type_expression^.name[1]), ADR(type_expression^.name[2]))
|
||||
END transpile_named_type;
|
||||
PROCEDURE transpile_procedure_type(context: PTranspilerContext; type_expression: PAstTypeExpression);
|
||||
VAR
|
||||
result: PAstTypeExpression;
|
||||
current_parameter: PPAstTypeExpression;
|
||||
parameter_count: CARDINAL;
|
||||
BEGIN
|
||||
WriteString(context^.output, 'PROCEDURE(');
|
||||
current_parameter := type_expression^.parameters;
|
||||
|
||||
WHILE current_parameter^ <> NIL DO
|
||||
transpile_type_expression(context, current_parameter^);
|
||||
|
||||
INC(current_parameter, TSIZE(PAstTypeExpression));
|
||||
|
||||
IF current_parameter^ <> NIL THEN
|
||||
WriteString(context^.output, ', ')
|
||||
END
|
||||
END;
|
||||
WriteChar(context^.output, ')')
|
||||
END transpile_procedure_type;
|
||||
PROCEDURE transpile_type_expression(context: PTranspilerContext; type_expression: PAstTypeExpression);
|
||||
BEGIN
|
||||
IF type_expression^.kind = astTypeExpressionKindRecord THEN
|
||||
transpile_record_type(context, type_expression)
|
||||
END;
|
||||
IF type_expression^.kind = astTypeExpressionKindEnumeration THEN
|
||||
transpile_enumeration_type(context, type_expression)
|
||||
END;
|
||||
IF type_expression^.kind = astTypeExpressionKindArray THEN
|
||||
transpile_array_type(context, type_expression)
|
||||
END;
|
||||
IF type_expression^.kind = astTypeExpressionKindPointer THEN
|
||||
transpile_pointer_type(context, type_expression)
|
||||
END;
|
||||
IF type_expression^.kind = astTypeExpressionKindProcedure THEN
|
||||
transpile_procedure_type(context, type_expression)
|
||||
END;
|
||||
IF type_expression^.kind = astTypeExpressionKindNamed THEN
|
||||
transpile_named_type(context, type_expression)
|
||||
END
|
||||
END transpile_type_expression;
|
||||
PROCEDURE transpile_type_declaration(context: PTranspilerContext; declaration: PAstTypeDeclaration);
|
||||
VAR
|
||||
written_bytes: CARDINAL;
|
||||
BEGIN
|
||||
WriteString(context^.output, ' ');
|
||||
|
||||
written_bytes := WriteNBytes(context^.output, ORD(declaration^.identifier[1]), ADR(declaration^.identifier[2]));
|
||||
WriteString(context^.output, ' = ');
|
||||
|
||||
transpile_type_expression(context, declaration^.type_expression);
|
||||
write_semicolon(context^.output)
|
||||
END transpile_type_declaration;
|
||||
PROCEDURE transpile_type_part(context: PTranspilerContext; declarations: PPAstTypeDeclaration);
|
||||
VAR
|
||||
current_declaration: PPAstTypeDeclaration;
|
||||
BEGIN
|
||||
IF declarations^ <> NIL THEN
|
||||
WriteString(context^.output, 'TYPE');
|
||||
WriteLine(context^.output);
|
||||
|
||||
current_declaration := declarations;
|
||||
WHILE current_declaration^ <> NIL DO
|
||||
transpile_type_declaration(context, current_declaration^);
|
||||
|
||||
INC(current_declaration, TSIZE(PAstTypeDeclaration))
|
||||
END;
|
||||
WriteLine(context^.output)
|
||||
END
|
||||
END transpile_type_part;
|
||||
PROCEDURE transpile_variable_declaration(context: PTranspilerContext; declaration: PAstVariableDeclaration);
|
||||
VAR
|
||||
written_bytes: CARDINAL;
|
||||
BEGIN
|
||||
WriteString(context^.output, ' ');
|
||||
written_bytes := WriteNBytes(context^.output, ORD(declaration^.variable_name[1]), ADR(declaration^.variable_name[2]));
|
||||
|
||||
WriteString(context^.output, ': ');
|
||||
|
||||
transpile_type_expression(context, declaration^.variable_type);
|
||||
write_semicolon(context^.output)
|
||||
END transpile_variable_declaration;
|
||||
PROCEDURE transpile_variable_part(context: PTranspilerContext; declarations: PPAstVariableDeclaration);
|
||||
VAR
|
||||
current_declaration: PPAstVariableDeclaration;
|
||||
BEGIN
|
||||
IF declarations^ <> NIL THEN
|
||||
WriteString(context^.output, 'VAR');
|
||||
WriteLine(context^.output);
|
||||
|
||||
current_declaration := declarations;
|
||||
WHILE current_declaration^ <> NIL DO
|
||||
transpile_variable_declaration(context, current_declaration^);
|
||||
|
||||
INC(current_declaration, TSIZE(PAstVariableDeclaration))
|
||||
END;
|
||||
WriteLine(context^.output)
|
||||
END
|
||||
END transpile_variable_part;
|
||||
PROCEDURE transpile_procedure_heading(context: PTranspilerContext): LexerToken;
|
||||
VAR
|
||||
token: LexerToken;
|
||||
result: LexerToken;
|
||||
type_expression: PAstTypeExpression;
|
||||
BEGIN
|
||||
WriteString(context^.output, 'PROCEDURE ');
|
||||
|
||||
result := transpiler_lex(context^.lexer);
|
||||
write_current(context^.lexer, context^.output);
|
||||
|
||||
token := transpiler_lex(context^.lexer);
|
||||
WriteChar(context^.output, '(');
|
||||
|
||||
token := transpiler_lex(context^.lexer);
|
||||
WHILE token.kind <> lexerKindRightParen DO
|
||||
write_current(context^.lexer, context^.output);
|
||||
|
||||
token := transpiler_lex(context^.lexer);
|
||||
WriteString(context^.output, ': ');
|
||||
token := transpiler_lex(context^.lexer);
|
||||
|
||||
type_expression := parse_type_expression(context^.lexer);
|
||||
transpile_type_expression(context, type_expression);
|
||||
|
||||
token := transpiler_lex(context^.lexer);
|
||||
IF (token.kind = lexerKindSemicolon) OR (token.kind = lexerKindComma) THEN
|
||||
WriteString(context^.output, '; ');
|
||||
token := transpiler_lex(context^.lexer)
|
||||
END
|
||||
END;
|
||||
WriteString(context^.output, ')');
|
||||
token := transpiler_lex(context^.lexer);
|
||||
|
||||
(* Check for the return type and write it. *)
|
||||
IF token.kind = lexerKindArrow THEN
|
||||
WriteString(context^.output, ': ');
|
||||
token := transpiler_lex(context^.lexer);
|
||||
write_current(context^.lexer, context^.output);
|
||||
token := transpiler_lex(context^.lexer)
|
||||
END;
|
||||
token := transpiler_lex(context^.lexer);
|
||||
write_semicolon(context^.output);
|
||||
|
||||
RETURN result
|
||||
END transpile_procedure_heading;
|
||||
PROCEDURE transpile_expression(context: PTranspilerContext; trailing_token: LexerKind);
|
||||
VAR
|
||||
token: LexerToken;
|
||||
written_bytes: CARDINAL;
|
||||
BEGIN
|
||||
token := transpiler_lex(context^.lexer);
|
||||
|
||||
WHILE (token.kind <> trailing_token) AND (token.kind <> lexerKindEnd) DO
|
||||
written_bytes := 0;
|
||||
IF token.kind = lexerKindNull THEN
|
||||
WriteString(context^.output, 'NIL ');
|
||||
written_bytes := 1
|
||||
END;
|
||||
IF (token.kind = lexerKindBoolean) AND token.booleanKind THEN
|
||||
WriteString(context^.output, 'TRUE ');
|
||||
written_bytes := 1
|
||||
END;
|
||||
IF (token.kind = lexerKindBoolean) AND (~token.booleanKind) THEN
|
||||
WriteString(context^.output, 'FALSE ');
|
||||
written_bytes := 1
|
||||
END;
|
||||
IF token.kind = lexerKindOr THEN
|
||||
WriteString(context^.output, 'OR ');
|
||||
written_bytes := 1
|
||||
END;
|
||||
IF token.kind = lexerKindAnd THEN
|
||||
WriteString(context^.output, 'AND ');
|
||||
written_bytes := 1
|
||||
END;
|
||||
IF token.kind = lexerKindNot THEN
|
||||
WriteString(context^.output, 'NOT ');
|
||||
written_bytes := 1
|
||||
END;
|
||||
IF written_bytes = 0 THEN
|
||||
write_current(context^.lexer, context^.output);
|
||||
WriteChar(context^.output, ' ')
|
||||
END;
|
||||
token := transpiler_lex(context^.lexer)
|
||||
END
|
||||
END transpile_expression;
|
||||
PROCEDURE transpile_if_statement(context: PTranspilerContext);
|
||||
VAR
|
||||
token: LexerToken;
|
||||
BEGIN
|
||||
WriteString(context^.output, ' IF ');
|
||||
transpile_expression(context, lexerKindThen);
|
||||
|
||||
WriteString(context^.output, 'THEN');
|
||||
WriteLine(context^.output);
|
||||
transpile_statements(context);
|
||||
WriteString(context^.output, ' END');
|
||||
token := transpiler_lex(context^.lexer)
|
||||
END transpile_if_statement;
|
||||
PROCEDURE transpile_while_statement(context: PTranspilerContext);
|
||||
VAR
|
||||
token: LexerToken;
|
||||
BEGIN
|
||||
WriteString(context^.output, ' WHILE ');
|
||||
transpile_expression(context, lexerKindDo);
|
||||
|
||||
WriteString(context^.output, 'DO');
|
||||
WriteLine(context^.output);
|
||||
transpile_statements(context);
|
||||
WriteString(context^.output, ' END');
|
||||
token := transpiler_lex(context^.lexer)
|
||||
END transpile_while_statement;
|
||||
PROCEDURE transpile_assignment_statement(context: PTranspilerContext);
|
||||
BEGIN
|
||||
WriteString(context^.output, ' := ');
|
||||
transpile_expression(context, lexerKindSemicolon);
|
||||
END transpile_assignment_statement;
|
||||
PROCEDURE transpile_call_statement(context: PTranspilerContext);
|
||||
VAR
|
||||
token: LexerToken;
|
||||
BEGIN
|
||||
WriteString(context^.output, '(');
|
||||
token := transpiler_lex(context^.lexer);
|
||||
|
||||
WHILE (token.kind <> lexerKindSemicolon) AND (token.kind <> lexerKindEnd) DO
|
||||
write_current(context^.lexer, context^.output);
|
||||
token := transpiler_lex(context^.lexer)
|
||||
END
|
||||
END transpile_call_statement;
|
||||
PROCEDURE transpile_designator_expression(context: PTranspilerContext);
|
||||
VAR
|
||||
token: LexerToken;
|
||||
BEGIN
|
||||
WriteString(context^.output, ' ');
|
||||
write_current(context^.lexer, context^.output);
|
||||
token := transpiler_lex(context^.lexer);
|
||||
|
||||
WHILE token.kind = lexerKindLeftSquare DO
|
||||
WriteChar(context^.output, '[');
|
||||
token := transpiler_lex(context^.lexer);
|
||||
WHILE token.kind <> lexerKindRightSquare DO
|
||||
write_current(context^.lexer, context^.output);
|
||||
token := transpiler_lex(context^.lexer)
|
||||
END;
|
||||
WriteChar(context^.output, ']');
|
||||
token := transpiler_lex(context^.lexer)
|
||||
END;
|
||||
IF token.kind = lexerKindHat THEN
|
||||
WriteChar(context^.output, '^');
|
||||
token := transpiler_lex(context^.lexer)
|
||||
END;
|
||||
IF token.kind = lexerKindDot THEN
|
||||
WriteChar(context^.output, '.');
|
||||
token := transpiler_lex(context^.lexer);
|
||||
write_current(context^.lexer, context^.output);
|
||||
token := transpiler_lex(context^.lexer)
|
||||
END;
|
||||
IF token.kind = lexerKindHat THEN
|
||||
WriteChar(context^.output, '^');
|
||||
token := transpiler_lex(context^.lexer)
|
||||
END;
|
||||
WHILE token.kind = lexerKindLeftSquare DO
|
||||
WriteChar(context^.output, '[');
|
||||
token := transpiler_lex(context^.lexer);
|
||||
WHILE token.kind <> lexerKindRightSquare DO
|
||||
write_current(context^.lexer, context^.output);
|
||||
token := transpiler_lex(context^.lexer)
|
||||
END;
|
||||
WriteChar(context^.output, ']');
|
||||
token := transpiler_lex(context^.lexer)
|
||||
END
|
||||
END transpile_designator_expression;
|
||||
PROCEDURE transpile_return_statement(context: PTranspilerContext);
|
||||
VAR
|
||||
token: LexerToken;
|
||||
BEGIN
|
||||
WriteString(context^.output, ' RETURN ');
|
||||
transpile_expression(context, lexerKindSemicolon)
|
||||
END transpile_return_statement;
|
||||
PROCEDURE transpile_statement(context: PTranspilerContext);
|
||||
VAR
|
||||
token: LexerToken;
|
||||
BEGIN
|
||||
token := transpiler_lex(context^.lexer);
|
||||
|
||||
IF token.kind = lexerKindIf THEN
|
||||
transpile_if_statement(context)
|
||||
END;
|
||||
IF token.kind = lexerKindWhile THEN
|
||||
transpile_while_statement(context)
|
||||
END;
|
||||
IF token.kind = lexerKindReturn THEN
|
||||
transpile_return_statement(context)
|
||||
END;
|
||||
IF token.kind = lexerKindIdentifier THEN
|
||||
transpile_designator_expression(context);
|
||||
token := lexer_current(context^.lexer);
|
||||
|
||||
IF token.kind = lexerKindAssignment THEN
|
||||
transpile_assignment_statement(context)
|
||||
END;
|
||||
IF token.kind = lexerKindLeftParen THEN
|
||||
transpile_call_statement(context)
|
||||
END
|
||||
END
|
||||
END transpile_statement;
|
||||
PROCEDURE transpile_statements(context: PTranspilerContext);
|
||||
VAR
|
||||
token: LexerToken;
|
||||
BEGIN
|
||||
token := lexer_current(context^.lexer);
|
||||
|
||||
WHILE token.kind <> lexerKindEnd DO
|
||||
transpile_statement(context);
|
||||
token := lexer_current(context^.lexer);
|
||||
|
||||
IF token.kind = lexerKindSemicolon THEN
|
||||
WriteChar(context^.output, ';')
|
||||
END;
|
||||
WriteLine(context^.output)
|
||||
END
|
||||
END transpile_statements;
|
||||
PROCEDURE transpile_statement_part(context: PTranspilerContext);
|
||||
VAR
|
||||
token: LexerToken;
|
||||
BEGIN
|
||||
token := lexer_current(context^.lexer);
|
||||
IF token.kind = lexerKindBegin THEN
|
||||
WriteString(context^.output, 'BEGIN');
|
||||
WriteLine(context^.output);
|
||||
transpile_statements(context)
|
||||
END
|
||||
END transpile_statement_part;
|
||||
PROCEDURE transpile_procedure_declaration(context: PTranspilerContext);
|
||||
VAR
|
||||
token: LexerToken;
|
||||
seen_variables: PPAstVariableDeclaration;
|
||||
written_bytes: CARDINAL;
|
||||
seen_constants: PPAstConstantDeclaration;
|
||||
BEGIN
|
||||
token := transpile_procedure_heading(context);
|
||||
seen_constants := parse_constant_part(context^.lexer);
|
||||
transpile_constant_part(context, seen_constants);
|
||||
|
||||
seen_variables := parse_variable_part(context^.lexer);
|
||||
transpile_variable_part(context, seen_variables);
|
||||
transpile_statement_part(context);
|
||||
|
||||
WriteString(context^.output, 'END ');
|
||||
written_bytes := WriteNBytes(context^.output, ORD(token.identifierKind[1]), ADR(token.identifierKind[2]));
|
||||
|
||||
token := transpiler_lex(context^.lexer);
|
||||
write_semicolon(context^.output);
|
||||
token := transpiler_lex(context^.lexer)
|
||||
END transpile_procedure_declaration;
|
||||
PROCEDURE transpile_procedure_part(context: PTranspilerContext);
|
||||
VAR
|
||||
token: LexerToken;
|
||||
BEGIN
|
||||
token := lexer_current(context^.lexer);
|
||||
|
||||
WHILE token.kind = lexerKindProc DO
|
||||
transpile_procedure_declaration(context);
|
||||
token := lexer_current(context^.lexer);
|
||||
WriteLine(context^.output)
|
||||
END
|
||||
END transpile_procedure_part;
|
||||
PROCEDURE transpile_module_name(context: PTranspilerContext);
|
||||
VAR
|
||||
counter: CARDINAL;
|
||||
last_slash: CARDINAL;
|
||||
BEGIN
|
||||
counter := 1;
|
||||
last_slash := 0;
|
||||
|
||||
WHILE (context^.input_name[counter] <> '.') AND (ORD(context^.input_name[counter]) <> 0) DO
|
||||
IF context^.input_name[counter] = '/' THEN
|
||||
last_slash := counter
|
||||
END;
|
||||
INC(counter)
|
||||
END;
|
||||
|
||||
IF last_slash = 0 THEN
|
||||
counter := 1
|
||||
END;
|
||||
IF last_slash <> 0 THEN
|
||||
counter := last_slash + 1
|
||||
END;
|
||||
WHILE (context^.input_name[counter] <> '.') AND (ORD(context^.input_name[counter]) <> 0) DO
|
||||
WriteChar(context^.output, context^.input_name[counter]);
|
||||
INC(counter)
|
||||
END;
|
||||
END transpile_module_name;
|
||||
PROCEDURE transpile(lexer: PLexer; output: File; input_name: ShortString);
|
||||
VAR
|
||||
token: LexerToken;
|
||||
context: TranspilerContext;
|
||||
ast_module: PAstModule;
|
||||
BEGIN
|
||||
context.input_name := input_name;
|
||||
context.output := output;
|
||||
context.lexer := lexer;
|
||||
|
||||
ast_module := transpile_module(ADR(context))
|
||||
END transpile;
|
||||
END Transpiler.
|
||||
Loading…
x
Reference in New Issue
Block a user