Add lexer and parser sources
This commit is contained in:
16
source/CommandLineInterface.def
Normal file
16
source/CommandLineInterface.def
Normal file
@ -0,0 +1,16 @@
|
||||
DEFINITION MODULE CommandLineInterface;
|
||||
|
||||
FROM Common IMPORT ShortString;
|
||||
|
||||
TYPE
|
||||
CommandLine = RECORD
|
||||
input: ShortString;
|
||||
output: ShortString;
|
||||
lex: BOOLEAN;
|
||||
parse: BOOLEAN
|
||||
END;
|
||||
PCommandLine = POINTER TO CommandLine;
|
||||
|
||||
PROCEDURE parse_command_line(): PCommandLine;
|
||||
|
||||
END CommandLineInterface.
|
||||
89
source/CommandLineInterface.elna
Normal file
89
source/CommandLineInterface.elna
Normal file
@ -0,0 +1,89 @@
|
||||
module;
|
||||
|
||||
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;
|
||||
|
||||
proc parse_command_line() -> PCommandLine;
|
||||
var
|
||||
parameter: ShortString;
|
||||
i: CARDINAL;
|
||||
result: PCommandLine;
|
||||
parsed: BOOLEAN;
|
||||
begin
|
||||
i := 1;
|
||||
NEW(result);
|
||||
result^.lex := false;
|
||||
result^.parse := false;
|
||||
MemZero(ADR(result^.input), 256);
|
||||
result^.output[1] := CHAR(0);
|
||||
|
||||
while (i < Narg()) & (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 CompareStr(parameter, '-o') = 0 then
|
||||
INC(i);
|
||||
|
||||
if i = Narg() then
|
||||
WriteString(StdErr, 'Fatal error: expecting a file name following -o.');
|
||||
result := nil
|
||||
end;
|
||||
if i < Narg() then
|
||||
parsed := GetArg(parameter, i);
|
||||
result^.output := parameter
|
||||
end;
|
||||
parsed := true
|
||||
end;
|
||||
if (parameter[1] <> '-') & (parsed = false) 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) & (Length(result^.input) = 0) then
|
||||
WriteString(StdErr, 'Fatal error: no input files.');
|
||||
WriteLine(StdErr);
|
||||
result := nil
|
||||
end;
|
||||
|
||||
return result
|
||||
end;
|
||||
|
||||
end.
|
||||
12
source/Common.def
Normal file
12
source/Common.def
Normal file
@ -0,0 +1,12 @@
|
||||
DEFINITION MODULE Common;
|
||||
|
||||
TYPE
|
||||
ShortString = ARRAY[1..256] OF CHAR;
|
||||
Identifier = ARRAY[1..256] OF CHAR;
|
||||
PIdentifier = POINTER TO Identifier;
|
||||
TextLocation = RECORD
|
||||
line: CARDINAL;
|
||||
column: CARDINAL
|
||||
END;
|
||||
|
||||
END Common.
|
||||
3
source/Common.elna
Normal file
3
source/Common.elna
Normal file
@ -0,0 +1,3 @@
|
||||
module;
|
||||
|
||||
end.
|
||||
73
source/Compiler.elna
Normal file
73
source/Compiler.elna
Normal file
@ -0,0 +1,73 @@
|
||||
program;
|
||||
|
||||
from FIO import Close, IsNoError, File, OpenToRead, OpenToWrite, StdErr, StdOut, WriteLine, WriteString;
|
||||
from SYSTEM import ADR;
|
||||
from M2RTS import HALT, ExitOnHalt;
|
||||
|
||||
from Lexer import Lexer, lexer_destroy, lexer_initialize;
|
||||
from Parser import Parser;
|
||||
from Transpiler import transpile;
|
||||
from CommandLineInterface import PCommandLine, parse_command_line;
|
||||
from Parser import PAstModule, parse;
|
||||
from Strings import Length;
|
||||
|
||||
var
|
||||
command_line: PCommandLine;
|
||||
|
||||
proc compile_from_stream();
|
||||
var
|
||||
lexer: Lexer;
|
||||
source_input: File;
|
||||
source_output: File;
|
||||
ast_module: PAstModule;
|
||||
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;
|
||||
source_output := nil;
|
||||
|
||||
if Length(command_line^.output) > 0 then
|
||||
source_output := OpenToWrite(command_line^.output);
|
||||
|
||||
if IsNoError(source_output) = false then
|
||||
WriteString(StdErr, 'Fatal error: failed to create the output file "');
|
||||
WriteString(StdErr, command_line^.output);
|
||||
WriteString(StdErr, '".');
|
||||
WriteLine(StdErr);
|
||||
|
||||
ExitOnHalt(2)
|
||||
end
|
||||
end;
|
||||
|
||||
if IsNoError(source_input) then
|
||||
lexer_initialize(ADR(lexer), source_input);
|
||||
|
||||
ast_module := parse(ADR(lexer));
|
||||
transpile(ast_module, StdOut, source_output, command_line^.input);
|
||||
|
||||
lexer_destroy(ADR(lexer));
|
||||
|
||||
Close(source_output);
|
||||
Close(source_input)
|
||||
end
|
||||
end;
|
||||
|
||||
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.
|
||||
107
source/Lexer.def
Normal file
107
source/Lexer.def
Normal file
@ -0,0 +1,107 @@
|
||||
DEFINITION MODULE Lexer;
|
||||
|
||||
FROM FIO IMPORT File;
|
||||
|
||||
FROM Common IMPORT Identifier, ShortString, TextLocation;
|
||||
|
||||
TYPE
|
||||
PLexerBuffer = POINTER TO CHAR;
|
||||
BufferPosition = RECORD
|
||||
iterator: PLexerBuffer;
|
||||
location: TextLocation
|
||||
END;
|
||||
PBufferPosition = POINTER TO BufferPosition;
|
||||
Lexer = RECORD
|
||||
input: File;
|
||||
buffer: PLexerBuffer;
|
||||
size: CARDINAL;
|
||||
length: CARDINAL;
|
||||
start: BufferPosition;
|
||||
current: BufferPosition
|
||||
END;
|
||||
PLexer = POINTER TO Lexer;
|
||||
LexerKind = (
|
||||
lexerKindEof,
|
||||
lexerKindIdentifier,
|
||||
lexerKindIf,
|
||||
lexerKindThen,
|
||||
lexerKindElse,
|
||||
lexerKindElsif,
|
||||
lexerKindWhile,
|
||||
lexerKindDo,
|
||||
lexerKindProc,
|
||||
lexerKindBegin,
|
||||
lexerKindEnd,
|
||||
lexerKindXor,
|
||||
lexerKindConst,
|
||||
lexerKindVar,
|
||||
lexerKindCase,
|
||||
lexerKindOf,
|
||||
lexerKindType,
|
||||
lexerKindRecord,
|
||||
lexerKindUnion,
|
||||
lexerKindPipe,
|
||||
lexerKindTo,
|
||||
lexerKindBoolean,
|
||||
lexerKindNull,
|
||||
lexerKindAnd,
|
||||
lexerKindOr,
|
||||
lexerKindTilde,
|
||||
lexerKindReturn,
|
||||
lexerKindDefer,
|
||||
lexerKindRange,
|
||||
lexerKindLeftParen,
|
||||
lexerKindRightParen,
|
||||
lexerKindLeftSquare,
|
||||
lexerKindRightSquare,
|
||||
lexerKindGreaterEqual,
|
||||
lexerKindLessEqual,
|
||||
lexerKindGreaterThan,
|
||||
lexerKindLessThan,
|
||||
lexerKindNotEqual,
|
||||
lexerKindEqual,
|
||||
lexerKindSemicolon,
|
||||
lexerKindDot,
|
||||
lexerKindComma,
|
||||
lexerKindPlus,
|
||||
lexerKindMinus,
|
||||
lexerKindAsterisk,
|
||||
lexerKindDivision,
|
||||
lexerKindRemainder,
|
||||
lexerKindAssignment,
|
||||
lexerKindColon,
|
||||
lexerKindHat,
|
||||
lexerKindAt,
|
||||
lexerKindComment,
|
||||
lexerKindInteger,
|
||||
lexerKindWord,
|
||||
lexerKindCharacter,
|
||||
lexerKindString,
|
||||
lexerKindFrom,
|
||||
lexerKindPointer,
|
||||
lexerKindArray,
|
||||
lexerKindArrow,
|
||||
lexerKindProgram,
|
||||
lexerKindModule,
|
||||
lexerKindImport
|
||||
);
|
||||
LexerToken = RECORD
|
||||
CASE kind: LexerKind OF
|
||||
lexerKindBoolean: booleanKind: BOOLEAN |
|
||||
lexerKindIdentifier: identifierKind: Identifier |
|
||||
lexerKindInteger: integerKind: INTEGER |
|
||||
lexerKindString: stringKind: ShortString
|
||||
END;
|
||||
start_location: TextLocation;
|
||||
end_location: TextLocation
|
||||
END;
|
||||
PLexerToken = POINTER TO LexerToken;
|
||||
|
||||
PROCEDURE lexer_initialize(lexer: PLexer; input: File);
|
||||
PROCEDURE lexer_destroy(lexer: PLexer);
|
||||
(* Returns the last read token. *)
|
||||
PROCEDURE lexer_current(lexer: PLexer): LexerToken;
|
||||
(* Read and return the next token. *)
|
||||
PROCEDURE lexer_lex(lexer: PLexer): LexerToken;
|
||||
|
||||
END Lexer.
|
||||
876
source/Lexer.elna
Normal file
876
source/Lexer.elna
Normal file
@ -0,0 +1,876 @@
|
||||
module;
|
||||
|
||||
from FIO import ReadNBytes;
|
||||
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 = 85536;
|
||||
|
||||
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 = proc(PLexer, PLexerToken);
|
||||
Transition = record
|
||||
action: TransitionAction;
|
||||
next_state: TransitionState
|
||||
end;
|
||||
TransitionClasses = [22]Transition;
|
||||
|
||||
var
|
||||
classification: [128]TransitionClass;
|
||||
transitions: [16]TransitionClasses;
|
||||
|
||||
proc 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; (* & *)
|
||||
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;
|
||||
INC(i)
|
||||
end
|
||||
end;
|
||||
|
||||
proc compare_keyword(keyword: ARRAY OF CHAR, token_start: BufferPosition, token_end: PLexerBuffer) -> BOOLEAN;
|
||||
var
|
||||
result: BOOLEAN;
|
||||
index: CARDINAL;
|
||||
keyword_length: CARDINAL;
|
||||
continue: BOOLEAN;
|
||||
begin
|
||||
index := 0;
|
||||
result := true;
|
||||
keyword_length := Length(keyword);
|
||||
continue := (index < keyword_length) & (token_start.iterator <> token_end);
|
||||
|
||||
while continue & result do
|
||||
result := (keyword[index] = token_start.iterator^) or (Lower(keyword[index]) = token_start.iterator^);
|
||||
INC(token_start.iterator);
|
||||
INC(index);
|
||||
continue := (index < keyword_length) & (token_start.iterator <> token_end)
|
||||
end;
|
||||
result := result & (index = Length(keyword));
|
||||
|
||||
return result & (token_start.iterator = token_end)
|
||||
end;
|
||||
|
||||
(* Reached the end of file. *)
|
||||
proc transition_action_eof(lexer: PLexer, token: PLexerToken);
|
||||
begin
|
||||
token^.kind := lexerKindEof
|
||||
end;
|
||||
|
||||
proc increment(position: PBufferPosition);
|
||||
begin
|
||||
INC(position^.iterator)
|
||||
end;
|
||||
|
||||
(* Add the character to the token currently read and advance to the next character. *)
|
||||
proc transition_action_accumulate(lexer: PLexer, token: PLexerToken);
|
||||
begin
|
||||
increment(ADR(lexer^.current))
|
||||
end;
|
||||
|
||||
(* The current character is not a part of the token. Finish the token already
|
||||
* read. Don't advance to the next character. *)
|
||||
proc transition_action_finalize(lexer: PLexer, token: PLexerToken);
|
||||
begin
|
||||
if lexer^.start.iterator^ = ':' then
|
||||
token^.kind := lexerKindColon
|
||||
end;
|
||||
if lexer^.start.iterator^ = '>' then
|
||||
token^.kind := lexerKindGreaterThan
|
||||
end;
|
||||
if lexer^.start.iterator^ = '<' then
|
||||
token^.kind := lexerKindLessThan
|
||||
end;
|
||||
if lexer^.start.iterator^ = '(' then
|
||||
token^.kind := lexerKindLeftParen
|
||||
end;
|
||||
if lexer^.start.iterator^ = '-' then
|
||||
token^.kind := lexerKindMinus
|
||||
end;
|
||||
if lexer^.start.iterator^ = '.' then
|
||||
token^.kind := lexerKindDot
|
||||
end
|
||||
end;
|
||||
|
||||
(* An action for tokens containing multiple characters. *)
|
||||
proc transition_action_composite(lexer: PLexer, token: PLexerToken);
|
||||
begin
|
||||
if lexer^.start.iterator^ = '<' then
|
||||
if lexer^.current.iterator^ = '>' then
|
||||
token^.kind := lexerKindNotEqual
|
||||
end;
|
||||
if lexer^.current.iterator^ = '=' then
|
||||
token^.kind := lexerKindLessEqual
|
||||
end
|
||||
end;
|
||||
if (lexer^.start.iterator^ = '>') & (lexer^.current.iterator^ = '=') then
|
||||
token^.kind := lexerKindGreaterEqual
|
||||
end;
|
||||
if (lexer^.start.iterator^ = '.') & (lexer^.current.iterator^ = '.') then
|
||||
token^.kind := lexerKindRange
|
||||
end;
|
||||
if (lexer^.start.iterator^ = ':') & (lexer^.current.iterator^ = '=') then
|
||||
token^.kind := lexerKindAssignment
|
||||
end;
|
||||
if (lexer^.start.iterator^ = '-') & (lexer^.current.iterator^ = '>') then
|
||||
token^.kind := lexerKindArrow
|
||||
end;
|
||||
increment(ADR(lexer^.current))
|
||||
end;
|
||||
|
||||
(* Skip a space. *)
|
||||
proc transition_action_skip(lexer: PLexer, token: PLexerToken);
|
||||
begin
|
||||
increment(ADR(lexer^.start));
|
||||
|
||||
if ORD(lexer^.start.iterator^) = 10 then
|
||||
INC(lexer^.start.location.line);
|
||||
lexer^.start.location.column := 1
|
||||
end;
|
||||
lexer^.current := lexer^.start
|
||||
end;
|
||||
|
||||
(* Delimited string action. *)
|
||||
proc transition_action_delimited(lexer: PLexer, token: PLexerToken);
|
||||
var
|
||||
text_length: CARDINAL;
|
||||
begin
|
||||
if lexer^.start.iterator^ = '(' then
|
||||
token^.kind := lexerKindComment
|
||||
end;
|
||||
if lexer^.start.iterator^ = '"' then
|
||||
text_length := lexer^.current.iterator;
|
||||
DEC(text_length, lexer^.start.iterator);
|
||||
INC(text_length);
|
||||
|
||||
MemZero(ADR(token^.stringKind), TSIZE(ShortString));
|
||||
MemCopy(lexer^.start.iterator, text_length, ADR(token^.stringKind));
|
||||
|
||||
token^.kind := lexerKindCharacter
|
||||
end;
|
||||
if lexer^.start.iterator^ = "'" then
|
||||
text_length := lexer^.current.iterator;
|
||||
DEC(text_length, lexer^.start.iterator);
|
||||
INC(text_length);
|
||||
|
||||
MemZero(ADR(token^.stringKind), TSIZE(ShortString));
|
||||
MemCopy(lexer^.start.iterator, text_length, ADR(token^.stringKind));
|
||||
|
||||
token^.kind := lexerKindString
|
||||
end;
|
||||
increment(ADR(lexer^.current))
|
||||
end;
|
||||
|
||||
(* Finalize keyword or identifier. *)
|
||||
proc transition_action_key_id(lexer: PLexer, token: PLexerToken);
|
||||
begin
|
||||
token^.kind := lexerKindIdentifier;
|
||||
|
||||
token^.identifierKind[1] := lexer^.current.iterator;
|
||||
DEC(token^.identifierKind[1], lexer^.start.iterator);
|
||||
MemCopy(lexer^.start.iterator, ORD(token^.identifierKind[1]), ADR(token^.identifierKind[2]));
|
||||
|
||||
if compare_keyword('program', lexer^.start, lexer^.current.iterator) then
|
||||
token^.kind := lexerKindProgram
|
||||
end;
|
||||
if compare_keyword('import', lexer^.start, lexer^.current.iterator) then
|
||||
token^.kind := lexerKindImport
|
||||
end;
|
||||
if compare_keyword('const', lexer^.start, lexer^.current.iterator) then
|
||||
token^.kind := lexerKindConst
|
||||
end;
|
||||
if compare_keyword('var', lexer^.start, lexer^.current.iterator) then
|
||||
token^.kind := lexerKindVar
|
||||
end;
|
||||
if compare_keyword('if', lexer^.start, lexer^.current.iterator) then
|
||||
token^.kind := lexerKindIf
|
||||
end;
|
||||
if compare_keyword('then', lexer^.start, lexer^.current.iterator) then
|
||||
token^.kind := lexerKindThen
|
||||
end;
|
||||
if compare_keyword('elsif', lexer^.start, lexer^.current.iterator) then
|
||||
token^.kind := lexerKindElsif
|
||||
end;
|
||||
if compare_keyword('else', lexer^.start, lexer^.current.iterator) then
|
||||
token^.kind := lexerKindElse
|
||||
end;
|
||||
if compare_keyword('while', lexer^.start, lexer^.current.iterator) then
|
||||
token^.kind := lexerKindWhile
|
||||
end;
|
||||
if compare_keyword('do', lexer^.start, lexer^.current.iterator) then
|
||||
token^.kind := lexerKindDo
|
||||
end;
|
||||
if compare_keyword('proc', lexer^.start, lexer^.current.iterator) then
|
||||
token^.kind := lexerKindProc
|
||||
end;
|
||||
if compare_keyword('begin', lexer^.start, lexer^.current.iterator) then
|
||||
token^.kind := lexerKindBegin
|
||||
end;
|
||||
if compare_keyword('end', lexer^.start, lexer^.current.iterator) then
|
||||
token^.kind := lexerKindEnd
|
||||
end;
|
||||
if compare_keyword('type', lexer^.start, lexer^.current.iterator) then
|
||||
token^.kind := lexerKindType
|
||||
end;
|
||||
if compare_keyword('record', lexer^.start, lexer^.current.iterator) then
|
||||
token^.kind := lexerKindRecord
|
||||
end;
|
||||
if compare_keyword('union', lexer^.start, lexer^.current.iterator) then
|
||||
token^.kind := lexerKindUnion
|
||||
end;
|
||||
if compare_keyword('NIL', lexer^.start, lexer^.current.iterator) then
|
||||
token^.kind := lexerKindNull
|
||||
end;
|
||||
if compare_keyword('or', lexer^.start, lexer^.current.iterator) then
|
||||
token^.kind := lexerKindOr
|
||||
end;
|
||||
if compare_keyword('return', lexer^.start, lexer^.current.iterator) then
|
||||
token^.kind := lexerKindReturn
|
||||
end;
|
||||
if compare_keyword('defer', lexer^.start, lexer^.current.iterator) then
|
||||
token^.kind := lexerKindDefer
|
||||
end;
|
||||
if compare_keyword('TO', lexer^.start, lexer^.current.iterator) then
|
||||
token^.kind := lexerKindTo
|
||||
end;
|
||||
if compare_keyword('CASE', lexer^.start, lexer^.current.iterator) then
|
||||
token^.kind := lexerKindCase
|
||||
end;
|
||||
if compare_keyword('OF', lexer^.start, lexer^.current.iterator) then
|
||||
token^.kind := lexerKindOf
|
||||
end;
|
||||
if compare_keyword('FROM', lexer^.start, lexer^.current.iterator) then
|
||||
token^.kind := lexerKindFrom
|
||||
end;
|
||||
if compare_keyword('module', lexer^.start, lexer^.current.iterator) then
|
||||
token^.kind := lexerKindModule
|
||||
end;
|
||||
if compare_keyword('xor', lexer^.start, lexer^.current.iterator) then
|
||||
token^.kind := lexerKindXor
|
||||
end;
|
||||
if compare_keyword('POINTER', lexer^.start, lexer^.current.iterator) then
|
||||
token^.kind := lexerKindPointer
|
||||
end;
|
||||
if compare_keyword('ARRAY', lexer^.start, lexer^.current.iterator) then
|
||||
token^.kind := lexerKindArray
|
||||
end;
|
||||
if compare_keyword('TRUE', lexer^.start, lexer^.current.iterator) then
|
||||
token^.kind := lexerKindBoolean;
|
||||
token^.booleanKind := true
|
||||
end;
|
||||
if compare_keyword('FALSE', lexer^.start, lexer^.current.iterator) then
|
||||
token^.kind := lexerKindBoolean;
|
||||
token^.booleanKind := false
|
||||
end
|
||||
end;
|
||||
|
||||
(* Action for tokens containing only one character. The character cannot be
|
||||
* followed by other characters forming a composite token. *)
|
||||
proc transition_action_single(lexer: PLexer, token: PLexerToken);
|
||||
begin
|
||||
if lexer^.current.iterator^ = '&' then
|
||||
token^.kind := lexerKindAnd
|
||||
end;
|
||||
if lexer^.current.iterator^ = ';' then
|
||||
token^.kind := lexerKindSemicolon
|
||||
end;
|
||||
if lexer^.current.iterator^ = ',' then
|
||||
token^.kind := lexerKindComma
|
||||
end;
|
||||
if lexer^.current.iterator^ = '~' then
|
||||
token^.kind := lexerKindTilde
|
||||
end;
|
||||
if lexer^.current.iterator^ = ')' then
|
||||
token^.kind := lexerKindRightParen
|
||||
end;
|
||||
if lexer^.current.iterator^ = '[' then
|
||||
token^.kind := lexerKindLeftSquare
|
||||
end;
|
||||
if lexer^.current.iterator^ = ']' then
|
||||
token^.kind := lexerKindRightSquare
|
||||
end;
|
||||
if lexer^.current.iterator^ = '^' then
|
||||
token^.kind := lexerKindHat
|
||||
end;
|
||||
if lexer^.current.iterator^ = '=' then
|
||||
token^.kind := lexerKindEqual
|
||||
end;
|
||||
if lexer^.current.iterator^ = '+' then
|
||||
token^.kind := lexerKindPlus
|
||||
end;
|
||||
if lexer^.current.iterator^ = '*' then
|
||||
token^.kind := lexerKindAsterisk
|
||||
end;
|
||||
if lexer^.current.iterator^ = '/' then
|
||||
token^.kind := lexerKindDivision
|
||||
end;
|
||||
if lexer^.current.iterator^ = '%' then
|
||||
token^.kind := lexerKindRemainder
|
||||
end;
|
||||
if lexer^.current.iterator^ = '@' then
|
||||
token^.kind := lexerKindAt
|
||||
end;
|
||||
if lexer^.current.iterator^ = '|' then
|
||||
token^.kind := lexerKindPipe
|
||||
end;
|
||||
increment(ADR(lexer^.current.iterator))
|
||||
end;
|
||||
|
||||
(* Handle an integer literal. *)
|
||||
proc transition_action_integer(lexer: PLexer, token: PLexerToken);
|
||||
var
|
||||
buffer: String;
|
||||
integer_length: CARDINAL;
|
||||
found: BOOLEAN;
|
||||
begin
|
||||
token^.kind := lexerKindInteger;
|
||||
|
||||
integer_length := lexer^.current.iterator;
|
||||
DEC(integer_length, lexer^.start.iterator);
|
||||
MemZero(ADR(token^.identifierKind), TSIZE(Identifier));
|
||||
MemCopy(lexer^.start.iterator, integer_length, ADR(token^.identifierKind[1]));
|
||||
|
||||
buffer := InitStringCharStar(ADR(token^.identifierKind[1]));
|
||||
token^.integerKind := StringToInteger(buffer, 10, found);
|
||||
buffer := KillString(buffer)
|
||||
end;
|
||||
|
||||
proc set_default_transition(current_state: TransitionState, default_action: TransitionAction, next_state: TransitionState);
|
||||
var
|
||||
default_transition: Transition;
|
||||
begin
|
||||
default_transition.action := default_action;
|
||||
default_transition.next_state := next_state;
|
||||
|
||||
transitions[ORD(current_state) + 1][ORD(transitionClassInvalid) + 1] := default_transition;
|
||||
transitions[ORD(current_state) + 1][ORD(transitionClassDigit) + 1] := default_transition;
|
||||
transitions[ORD(current_state) + 1][ORD(transitionClassAlpha) + 1] := default_transition;
|
||||
transitions[ORD(current_state) + 1][ORD(transitionClassSpace) + 1] := default_transition;
|
||||
transitions[ORD(current_state) + 1][ORD(transitionClassColon) + 1] := default_transition;
|
||||
transitions[ORD(current_state) + 1][ORD(transitionClassEquals) + 1] := default_transition;
|
||||
transitions[ORD(current_state) + 1][ORD(transitionClassLeftParen) + 1] := default_transition;
|
||||
transitions[ORD(current_state) + 1][ORD(transitionClassRightParen) + 1] := default_transition;
|
||||
transitions[ORD(current_state) + 1][ORD(transitionClassAsterisk) + 1] := default_transition;
|
||||
transitions[ORD(current_state) + 1][ORD(transitionClassUnderscore) + 1] := default_transition;
|
||||
transitions[ORD(current_state) + 1][ORD(transitionClassSingle) + 1] := default_transition;
|
||||
transitions[ORD(current_state) + 1][ORD(transitionClassHex) + 1] := default_transition;
|
||||
transitions[ORD(current_state) + 1][ORD(transitionClassZero) + 1] := default_transition;
|
||||
transitions[ORD(current_state) + 1][ORD(transitionClassX) + 1] := default_transition;
|
||||
transitions[ORD(current_state) + 1][ORD(transitionClassEof) + 1] := default_transition;
|
||||
transitions[ORD(current_state) + 1][ORD(transitionClassDot) + 1] := default_transition;
|
||||
transitions[ORD(current_state) + 1][ORD(transitionClassMinus) + 1] := default_transition;
|
||||
transitions[ORD(current_state) + 1][ORD(transitionClassSingleQuote) + 1] := default_transition;
|
||||
transitions[ORD(current_state) + 1][ORD(transitionClassDoubleQuote) + 1] := default_transition;
|
||||
transitions[ORD(current_state) + 1][ORD(transitionClassGreater) + 1] := default_transition;
|
||||
transitions[ORD(current_state) + 1][ORD(transitionClassLess) + 1] := default_transition;
|
||||
transitions[ORD(current_state) + 1][ORD(transitionClassOther) + 1] := default_transition
|
||||
end;
|
||||
|
||||
(*
|
||||
* 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.
|
||||
*)
|
||||
proc initialize_transitions();
|
||||
begin
|
||||
(* Start state. *)
|
||||
transitions[ORD(transitionStateStart) + 1][ORD(transitionClassInvalid) + 1].action := nil;
|
||||
transitions[ORD(transitionStateStart) + 1][ORD(transitionClassInvalid) + 1].next_state := transitionStateEnd;
|
||||
|
||||
transitions[ORD(transitionStateStart) + 1][ORD(transitionClassDigit) + 1].action := transition_action_accumulate;
|
||||
transitions[ORD(transitionStateStart) + 1][ORD(transitionClassDigit) + 1].next_state := transitionStateDecimal;
|
||||
|
||||
transitions[ORD(transitionStateStart) + 1][ORD(transitionClassAlpha) + 1].action := transition_action_accumulate;
|
||||
transitions[ORD(transitionStateStart) + 1][ORD(transitionClassAlpha) + 1].next_state := transitionStateIdentifier;
|
||||
|
||||
transitions[ORD(transitionStateStart) + 1][ORD(transitionClassSpace) + 1].action := transition_action_skip;
|
||||
transitions[ORD(transitionStateStart) + 1][ORD(transitionClassSpace) + 1].next_state := transitionStateStart;
|
||||
|
||||
transitions[ORD(transitionStateStart) + 1][ORD(transitionClassColon) + 1].action := transition_action_accumulate;
|
||||
transitions[ORD(transitionStateStart) + 1][ORD(transitionClassColon) + 1].next_state := transitionStateColon;
|
||||
|
||||
transitions[ORD(transitionStateStart) + 1][ORD(transitionClassEquals) + 1].action := transition_action_single;
|
||||
transitions[ORD(transitionStateStart) + 1][ORD(transitionClassEquals) + 1].next_state := transitionStateEnd;
|
||||
|
||||
transitions[ORD(transitionStateStart) + 1][ORD(transitionClassLeftParen) + 1].action := transition_action_accumulate;
|
||||
transitions[ORD(transitionStateStart) + 1][ORD(transitionClassLeftParen) + 1].next_state := transitionStateLeftParen;
|
||||
|
||||
transitions[ORD(transitionStateStart) + 1][ORD(transitionClassRightParen) + 1].action := transition_action_single;
|
||||
transitions[ORD(transitionStateStart) + 1][ORD(transitionClassRightParen) + 1].next_state := transitionStateEnd;
|
||||
|
||||
transitions[ORD(transitionStateStart) + 1][ORD(transitionClassAsterisk) + 1].action := transition_action_single;
|
||||
transitions[ORD(transitionStateStart) + 1][ORD(transitionClassAsterisk) + 1].next_state := transitionStateEnd;
|
||||
|
||||
transitions[ORD(transitionStateStart) + 1][ORD(transitionClassUnderscore) + 1].action := transition_action_accumulate;
|
||||
transitions[ORD(transitionStateStart) + 1][ORD(transitionClassUnderscore) + 1].next_state := transitionStateIdentifier;
|
||||
|
||||
transitions[ORD(transitionStateStart) + 1][ORD(transitionClassSingle) + 1].action := transition_action_single;
|
||||
transitions[ORD(transitionStateStart) + 1][ORD(transitionClassSingle) + 1].next_state := transitionStateEnd;
|
||||
|
||||
transitions[ORD(transitionStateStart) + 1][ORD(transitionClassHex) + 1].action := transition_action_accumulate;
|
||||
transitions[ORD(transitionStateStart) + 1][ORD(transitionClassHex) + 1].next_state := transitionStateIdentifier;
|
||||
|
||||
transitions[ORD(transitionStateStart) + 1][ORD(transitionClassZero) + 1].action := transition_action_accumulate;
|
||||
transitions[ORD(transitionStateStart) + 1][ORD(transitionClassZero) + 1].next_state := transitionStateLeadingZero;
|
||||
|
||||
transitions[ORD(transitionStateStart) + 1][ORD(transitionClassX) + 1].action := transition_action_accumulate;
|
||||
transitions[ORD(transitionStateStart) + 1][ORD(transitionClassX) + 1].next_state := transitionStateIdentifier;
|
||||
|
||||
transitions[ORD(transitionStateStart) + 1][ORD(transitionClassEof) + 1].action := transition_action_eof;
|
||||
transitions[ORD(transitionStateStart) + 1][ORD(transitionClassEof) + 1].next_state := transitionStateEnd;
|
||||
|
||||
transitions[ORD(transitionStateStart) + 1][ORD(transitionClassDot) + 1].action := transition_action_accumulate;
|
||||
transitions[ORD(transitionStateStart) + 1][ORD(transitionClassDot) + 1].next_state := transitionStateDot;
|
||||
|
||||
transitions[ORD(transitionStateStart) + 1][ORD(transitionClassMinus) + 1].action := transition_action_accumulate;
|
||||
transitions[ORD(transitionStateStart) + 1][ORD(transitionClassMinus) + 1].next_state := transitionStateMinus;
|
||||
|
||||
transitions[ORD(transitionStateStart) + 1][ORD(transitionClassSingleQuote) + 1].action := transition_action_accumulate;
|
||||
transitions[ORD(transitionStateStart) + 1][ORD(transitionClassSingleQuote) + 1].next_state := transitionStateCharacter;
|
||||
|
||||
transitions[ORD(transitionStateStart) + 1][ORD(transitionClassDoubleQuote) + 1].action := transition_action_accumulate;
|
||||
transitions[ORD(transitionStateStart) + 1][ORD(transitionClassDoubleQuote) + 1].next_state := transitionStateString;
|
||||
|
||||
transitions[ORD(transitionStateStart) + 1][ORD(transitionClassGreater) + 1].action := transition_action_accumulate;
|
||||
transitions[ORD(transitionStateStart) + 1][ORD(transitionClassGreater) + 1].next_state := transitionStateGreater;
|
||||
|
||||
transitions[ORD(transitionStateStart) + 1][ORD(transitionClassLess) + 1].action := transition_action_accumulate;
|
||||
transitions[ORD(transitionStateStart) + 1][ORD(transitionClassLess) + 1].next_state := transitionStateLess;
|
||||
|
||||
transitions[ORD(transitionStateStart) + 1][ORD(transitionClassOther) + 1].action := nil;
|
||||
transitions[ORD(transitionStateStart) + 1][ORD(transitionClassOther) + 1].next_state := 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].next_state := 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].next_state := transitionStateIdentifier;
|
||||
|
||||
transitions[ORD(transitionStateIdentifier) + 1][ORD(transitionClassAlpha) + 1].action := transition_action_accumulate;
|
||||
transitions[ORD(transitionStateIdentifier) + 1][ORD(transitionClassAlpha) + 1].next_state := transitionStateIdentifier;
|
||||
|
||||
transitions[ORD(transitionStateIdentifier) + 1][ORD(transitionClassUnderscore) + 1].action := transition_action_accumulate;
|
||||
transitions[ORD(transitionStateIdentifier) + 1][ORD(transitionClassUnderscore) + 1].next_state := transitionStateIdentifier;
|
||||
|
||||
transitions[ORD(transitionStateIdentifier) + 1][ORD(transitionClassHex) + 1].action := transition_action_accumulate;
|
||||
transitions[ORD(transitionStateIdentifier) + 1][ORD(transitionClassHex) + 1].next_state := transitionStateIdentifier;
|
||||
|
||||
transitions[ORD(transitionStateIdentifier) + 1][ORD(transitionClassZero) + 1].action := transition_action_accumulate;
|
||||
transitions[ORD(transitionStateIdentifier) + 1][ORD(transitionClassZero) + 1].next_state := transitionStateIdentifier;
|
||||
|
||||
transitions[ORD(transitionStateIdentifier) + 1][ORD(transitionClassX) + 1].action := transition_action_accumulate;
|
||||
transitions[ORD(transitionStateIdentifier) + 1][ORD(transitionClassX) + 1].next_state := 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].next_state := transitionStateDecimal;
|
||||
|
||||
transitions[ORD(transitionStateDecimal) + 1][ORD(transitionClassAlpha) + 1].action := transition_action_accumulate;
|
||||
transitions[ORD(transitionStateDecimal) + 1][ORD(transitionClassAlpha) + 1].next_state := transitionStateDecimalSuffix;
|
||||
|
||||
transitions[ORD(transitionStateDecimal) + 1][ORD(transitionClassUnderscore) + 1].action := nil;
|
||||
transitions[ORD(transitionStateDecimal) + 1][ORD(transitionClassUnderscore) + 1].next_state := transitionStateEnd;
|
||||
|
||||
transitions[ORD(transitionStateDecimal) + 1][ORD(transitionClassHex) + 1].action := transition_action_accumulate;
|
||||
transitions[ORD(transitionStateDecimal) + 1][ORD(transitionClassHex) + 1].next_state := transitionStateDecimalSuffix;
|
||||
|
||||
transitions[ORD(transitionStateDecimal) + 1][ORD(transitionClassZero) + 1].action := transition_action_accumulate;
|
||||
transitions[ORD(transitionStateDecimal) + 1][ORD(transitionClassZero) + 1].next_state := transitionStateDecimal;
|
||||
|
||||
transitions[ORD(transitionStateDecimal) + 1][ORD(transitionClassX) + 1].action := transition_action_accumulate;
|
||||
transitions[ORD(transitionStateDecimal) + 1][ORD(transitionClassX) + 1].next_state := 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].next_state := 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].next_state := 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].next_state := 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].next_state := transitionStateEnd;
|
||||
|
||||
transitions[ORD(transitionStateLess) + 1][ORD(transitionClassGreater) + 1].action := transition_action_composite;
|
||||
transitions[ORD(transitionStateLess) + 1][ORD(transitionClassGreater) + 1].next_state := 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].next_state := 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].next_state := transitionStateClosingComment;
|
||||
|
||||
transitions[ORD(transitionStateComment) + 1][ORD(transitionClassEof) + 1].action := nil;
|
||||
transitions[ORD(transitionStateComment) + 1][ORD(transitionClassEof) + 1].next_state := 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].next_state := transitionStateEnd;
|
||||
|
||||
transitions[ORD(transitionStateClosingComment) + 1][ORD(transitionClassRightParen) + 1].action := transition_action_delimited;
|
||||
transitions[ORD(transitionStateClosingComment) + 1][ORD(transitionClassRightParen) + 1].next_state := transitionStateEnd;
|
||||
|
||||
transitions[ORD(transitionStateClosingComment) + 1][ORD(transitionClassAsterisk) + 1].action := transition_action_accumulate;
|
||||
transitions[ORD(transitionStateClosingComment) + 1][ORD(transitionClassAsterisk) + 1].next_state := transitionStateClosingComment;
|
||||
|
||||
transitions[ORD(transitionStateClosingComment) + 1][ORD(transitionClassEof) + 1].action := nil;
|
||||
transitions[ORD(transitionStateClosingComment) + 1][ORD(transitionClassEof) + 1].next_state := 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].next_state := transitionStateEnd;
|
||||
|
||||
transitions[ORD(transitionStateCharacter) + 1][ORD(transitionClassEof) + 1].action := nil;
|
||||
transitions[ORD(transitionStateCharacter) + 1][ORD(transitionClassEof) + 1].next_state := transitionStateEnd;
|
||||
|
||||
transitions[ORD(transitionStateCharacter) + 1][ORD(transitionClassSingleQuote) + 1].action := transition_action_delimited;
|
||||
transitions[ORD(transitionStateCharacter) + 1][ORD(transitionClassSingleQuote) + 1].next_state := 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].next_state := transitionStateEnd;
|
||||
|
||||
transitions[ORD(transitionStateString) + 1][ORD(transitionClassEof) + 1].action := nil;
|
||||
transitions[ORD(transitionStateString) + 1][ORD(transitionClassEof) + 1].next_state := transitionStateEnd;
|
||||
|
||||
transitions[ORD(transitionStateString) + 1][ORD(transitionClassDoubleQuote) + 1].action := transition_action_delimited;
|
||||
transitions[ORD(transitionStateString) + 1][ORD(transitionClassDoubleQuote) + 1].next_state := 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].next_state := transitionStateEnd;
|
||||
|
||||
transitions[ORD(transitionStateLeadingZero) + 1][ORD(transitionClassAlpha) + 1].action := nil;
|
||||
transitions[ORD(transitionStateLeadingZero) + 1][ORD(transitionClassAlpha) + 1].next_state := transitionStateEnd;
|
||||
|
||||
transitions[ORD(transitionStateLeadingZero) + 1][ORD(transitionClassUnderscore) + 1].action := nil;
|
||||
transitions[ORD(transitionStateLeadingZero) + 1][ORD(transitionClassUnderscore) + 1].next_state := transitionStateEnd;
|
||||
|
||||
transitions[ORD(transitionStateLeadingZero) + 1][ORD(transitionClassHex) + 1].action := nil;
|
||||
transitions[ORD(transitionStateLeadingZero) + 1][ORD(transitionClassHex) + 1].next_state := transitionStateEnd;
|
||||
|
||||
transitions[ORD(transitionStateLeadingZero) + 1][ORD(transitionClassZero) + 1].action := nil;
|
||||
transitions[ORD(transitionStateLeadingZero) + 1][ORD(transitionClassZero) + 1].next_state := transitionStateEnd;
|
||||
|
||||
transitions[ORD(transitionStateLeadingZero) + 1][ORD(transitionClassX) + 1].action := nil;
|
||||
transitions[ORD(transitionStateLeadingZero) + 1][ORD(transitionClassX) + 1].next_state := 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].next_state := transitionStateEnd;
|
||||
|
||||
transitions[ORD(transitionStateDecimalSuffix) + 1][ORD(transitionClassDigit) + 1].action := nil;
|
||||
transitions[ORD(transitionStateDecimalSuffix) + 1][ORD(transitionClassDigit) + 1].next_state := transitionStateEnd;
|
||||
|
||||
transitions[ORD(transitionStateDecimalSuffix) + 1][ORD(transitionClassHex) + 1].action := nil;
|
||||
transitions[ORD(transitionStateDecimalSuffix) + 1][ORD(transitionClassHex) + 1].next_state := transitionStateEnd;
|
||||
|
||||
transitions[ORD(transitionStateDecimalSuffix) + 1][ORD(transitionClassZero) + 1].action := nil;
|
||||
transitions[ORD(transitionStateDecimalSuffix) + 1][ORD(transitionClassZero) + 1].next_state := transitionStateEnd;
|
||||
|
||||
transitions[ORD(transitionStateDecimalSuffix) + 1][ORD(transitionClassX) + 1].action := nil;
|
||||
transitions[ORD(transitionStateDecimalSuffix) + 1][ORD(transitionClassX) + 1].next_state := transitionStateEnd
|
||||
end;
|
||||
|
||||
proc 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;
|
||||
|
||||
proc lexer_current(lexer: PLexer) -> LexerToken;
|
||||
var
|
||||
current_class: TransitionClass;
|
||||
current_state: TransitionState;
|
||||
current_transition: Transition;
|
||||
result: LexerToken;
|
||||
index1: CARDINAL;
|
||||
index2: CARDINAL;
|
||||
begin
|
||||
lexer^.current := lexer^.start;
|
||||
current_state := transitionStateStart;
|
||||
|
||||
while current_state <> transitionStateEnd DO
|
||||
index1 := ORD(lexer^.current.iterator^);
|
||||
INC(index1);
|
||||
current_class := classification[index1];
|
||||
|
||||
index1 := ORD(current_state);
|
||||
INC(index1);
|
||||
index2 := ORD(current_class);
|
||||
INC(index2);
|
||||
|
||||
current_transition := transitions[index1][index2];
|
||||
if current_transition.action <> nil then
|
||||
current_transition.action(lexer, ADR(result))
|
||||
end;
|
||||
current_state := current_transition.next_state
|
||||
end;
|
||||
result.start_location := lexer^.start.location;
|
||||
result.end_location := lexer^.current.location;
|
||||
|
||||
return result
|
||||
end;
|
||||
|
||||
proc 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.location.column := 1;
|
||||
lexer^.current.location.line := 1;
|
||||
lexer^.current.iterator := lexer^.buffer
|
||||
end;
|
||||
lexer^.start := lexer^.current;
|
||||
|
||||
result := lexer_current(lexer);
|
||||
return result
|
||||
end;
|
||||
|
||||
proc lexer_destroy(lexer: PLexer);
|
||||
begin
|
||||
DEALLOCATE(lexer^.buffer, lexer^.size)
|
||||
end;
|
||||
|
||||
begin
|
||||
initialize_classification();
|
||||
initialize_transitions()
|
||||
end.
|
||||
200
source/Parser.def
Normal file
200
source/Parser.def
Normal file
@ -0,0 +1,200 @@
|
||||
DEFINITION MODULE Parser;
|
||||
|
||||
FROM Common IMPORT Identifier, PIdentifier, ShortString;
|
||||
FROM Lexer IMPORT PLexer;
|
||||
|
||||
TYPE
|
||||
Parser = RECORD
|
||||
lexer: PLexer
|
||||
END;
|
||||
PParser = POINTER TO Parser;
|
||||
|
||||
AstLiteralKind = (
|
||||
astLiteralKindInteger,
|
||||
astLiteralKindString,
|
||||
astLiteralKindNull,
|
||||
astLiteralKindBoolean
|
||||
);
|
||||
AstLiteral = RECORD
|
||||
CASE kind: AstLiteralKind OF
|
||||
astLiteralKindInteger: integer: INTEGER |
|
||||
astLiteralKindString: string: ShortString |
|
||||
astLiteralKindNull: |
|
||||
astLiteralKindBoolean: boolean: BOOLEAN
|
||||
END
|
||||
END;
|
||||
PAstLiteral = POINTER TO AstLiteral;
|
||||
|
||||
AstUnaryOperator = (
|
||||
astUnaryOperatorReference,
|
||||
astUnaryOperatorNot,
|
||||
astUnaryOperatorMinus
|
||||
);
|
||||
AstBinaryOperator = (
|
||||
astBinaryOperatorSum,
|
||||
astBinaryOperatorSubtraction,
|
||||
astBinaryOperatorMultiplication,
|
||||
astBinaryOperatorDivision,
|
||||
astBinaryOperatorRemainder,
|
||||
astBinaryOperatorEquals,
|
||||
astBinaryOperatorNotEquals,
|
||||
astBinaryOperatorLess,
|
||||
astBinaryOperatorGreater,
|
||||
astBinaryOperatorLessEqual,
|
||||
astBinaryOperatorGreaterEqual,
|
||||
astBinaryOperatorDisjunction,
|
||||
astBinaryOperatorConjunction,
|
||||
astBinaryOperatorExclusiveDisjunction,
|
||||
astBinaryOperatorShiftLeft,
|
||||
astBinaryOperatorShiftRight
|
||||
);
|
||||
|
||||
AstExpressionKind = (
|
||||
astExpressionKindLiteral,
|
||||
astExpressionKindIdentifier,
|
||||
astExpressionKindArrayAccess,
|
||||
astExpressionKindDereference,
|
||||
astExpressionKindFieldAccess,
|
||||
astExpressionKindUnary,
|
||||
astExpressionKindBinary,
|
||||
astExpressionKindCall
|
||||
);
|
||||
AstExpression = RECORD
|
||||
CASE kind: AstExpressionKind OF
|
||||
astExpressionKindLiteral: literal: PAstLiteral |
|
||||
astExpressionKindIdentifier: identifier: Identifier |
|
||||
astExpressionKindDereference: reference: PAstExpression |
|
||||
astExpressionKindArrayAccess:
|
||||
array: PAstExpression;
|
||||
index: PAstExpression |
|
||||
astExpressionKindFieldAccess:
|
||||
aggregate: PAstExpression;
|
||||
field: Identifier |
|
||||
astExpressionKindUnary:
|
||||
unary_operator: AstUnaryOperator;
|
||||
unary_operand: PAstExpression |
|
||||
astExpressionKindBinary:
|
||||
binary_operator: AstBinaryOperator;
|
||||
lhs: PAstExpression;
|
||||
rhs: PAstExpression |
|
||||
astExpressionKindCall:
|
||||
callable: PAstExpression;
|
||||
argument_count: CARDINAL;
|
||||
arguments: PPAstExpression
|
||||
END
|
||||
END;
|
||||
PAstExpression = POINTER TO AstExpression;
|
||||
PPAstExpression = POINTER TO PAstExpression;
|
||||
|
||||
AstStatementKind = (
|
||||
astStatementKindIf,
|
||||
astStatementKindWhile,
|
||||
astStatementKindAssignment,
|
||||
astStatementKindReturn,
|
||||
astStatementKindCall
|
||||
);
|
||||
AstStatement = RECORD
|
||||
CASE kind: AstStatementKind OF
|
||||
astStatementKindIf:
|
||||
if_condition: PAstExpression;
|
||||
if_branch: AstCompoundStatement |
|
||||
astStatementKindWhile:
|
||||
while_condition: PAstExpression;
|
||||
while_body: AstCompoundStatement |
|
||||
astStatementKindAssignment:
|
||||
assignee: PAstExpression;
|
||||
assignment: PAstExpression |
|
||||
astStatementKindReturn: returned: PAstExpression |
|
||||
astStatementKindCall: call: PAstExpression
|
||||
END
|
||||
END;
|
||||
PAstStatement = POINTER TO AstStatement;
|
||||
PPAstStatement = POINTER TO PAstStatement;
|
||||
AstCompoundStatement = RECORD
|
||||
count: CARDINAL;
|
||||
statements: PPAstStatement
|
||||
END;
|
||||
|
||||
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;
|
||||
|
||||
AstTypedDeclaration = RECORD
|
||||
identifier: Identifier;
|
||||
type_expression: PAstTypeExpression
|
||||
END;
|
||||
PAstTypedDeclaration = POINTER TO AstTypedDeclaration;
|
||||
PPAstTypedDeclaration = POINTER TO PAstTypedDeclaration;
|
||||
|
||||
AstVariableDeclaration = RECORD
|
||||
variable_name: Identifier;
|
||||
variable_type: PAstTypeExpression
|
||||
END;
|
||||
PAstVariableDeclaration = POINTER TO AstVariableDeclaration;
|
||||
PPAstVariableDeclaration = POINTER TO PAstVariableDeclaration;
|
||||
|
||||
AstProcedureDeclaration = RECORD
|
||||
name: Identifier;
|
||||
parameter_count: CARDINAL;
|
||||
parameters: PAstTypedDeclaration;
|
||||
return_type: PAstTypeExpression;
|
||||
constants: PPAstConstantDeclaration;
|
||||
variables: PPAstVariableDeclaration;
|
||||
statements: AstCompoundStatement
|
||||
END;
|
||||
PAstProcedureDeclaration = POINTER TO AstProcedureDeclaration;
|
||||
PPAstProcedureDeclaration = POINTER TO PAstProcedureDeclaration;
|
||||
|
||||
AstModule = RECORD
|
||||
main: BOOLEAN;
|
||||
imports: PPAstImportStatement;
|
||||
constants: PPAstConstantDeclaration;
|
||||
types: PPAstTypedDeclaration;
|
||||
variables: PPAstVariableDeclaration;
|
||||
procedures: PPAstProcedureDeclaration;
|
||||
statements: AstCompoundStatement
|
||||
END;
|
||||
PAstModule = POINTER TO AstModule;
|
||||
|
||||
PROCEDURE parse(lexer: PLexer): PAstModule;
|
||||
|
||||
END Parser.
|
||||
1008
source/Parser.elna
Normal file
1008
source/Parser.elna
Normal file
File diff suppressed because it is too large
Load Diff
20
source/Transpiler.def
Normal file
20
source/Transpiler.def
Normal file
@ -0,0 +1,20 @@
|
||||
DEFINITION MODULE Transpiler;
|
||||
|
||||
FROM FIO IMPORT File;
|
||||
|
||||
FROM Common IMPORT ShortString;
|
||||
FROM Lexer IMPORT PLexer, Lexer;
|
||||
FROM Parser IMPORT PAstModule;
|
||||
|
||||
TYPE
|
||||
TranspilerContext = RECORD
|
||||
input_name: ShortString;
|
||||
output: File;
|
||||
definition: File;
|
||||
indentation: CARDINAL
|
||||
END;
|
||||
PTranspilerContext = POINTER TO TranspilerContext;
|
||||
|
||||
PROCEDURE transpile(ast_module: PAstModule; output: File; definition: File; input_name: ShortString);
|
||||
|
||||
END Transpiler.
|
||||
658
source/Transpiler.elna
Normal file
658
source/Transpiler.elna
Normal file
@ -0,0 +1,658 @@
|
||||
module;
|
||||
|
||||
from FIO import WriteNBytes, WriteLine, WriteChar, WriteString;
|
||||
from SYSTEM import ADR, TSIZE;
|
||||
|
||||
from NumberIO import IntToStr;
|
||||
|
||||
from Common import Identifier, PIdentifier, ShortString;
|
||||
from Parser import AstTypeExpressionKind, AstExpressionKind, AstLiteralKind, AstUnaryOperator, AstBinaryOperator,
|
||||
PAstModule, PPAstExpression, PAstExpression, PAstLiteral, PPAstProcedureDeclaration,
|
||||
PAstConstantDeclaration, PPAstConstantDeclaration, PPAstStatement, PAstStatement, AstStatementKind,
|
||||
AstTypedDeclaration, PAstTypedDeclaration, PPAstTypedDeclaration, AstCompoundStatement, PAstProcedureDeclaration,
|
||||
PAstVariableDeclaration, PPAstVariableDeclaration, PAstImportStatement, PPAstImportStatement,
|
||||
PAstTypeExpression, PPAstTypeExpression, AstFieldDeclaration, PAstFieldDeclaration;
|
||||
|
||||
proc indent(context: PTranspilerContext);
|
||||
var
|
||||
count: CARDINAL;
|
||||
begin
|
||||
count := 0;
|
||||
|
||||
while count < context^.indentation do
|
||||
WriteString(context^.output, ' ');
|
||||
INC(count)
|
||||
end
|
||||
end;
|
||||
|
||||
(* Write a semicolon followed by a newline. *)
|
||||
proc write_semicolon(output: File);
|
||||
begin
|
||||
WriteChar(output, ';');
|
||||
WriteLine(output)
|
||||
end;
|
||||
|
||||
proc transpile_import_statement(context: PTranspilerContext, import_statement: PAstImportStatement);
|
||||
var
|
||||
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;
|
||||
|
||||
proc 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;
|
||||
|
||||
proc transpile_constant_declaration(context: PTranspilerContext, declaration: PAstConstantDeclaration);
|
||||
var
|
||||
buffer: [20]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;
|
||||
|
||||
proc transpile_constant_part(context: PTranspilerContext, declarations: PPAstConstantDeclaration, extra_newline: BOOLEAN);
|
||||
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;
|
||||
if extra_newline then
|
||||
WriteLine(context^.output)
|
||||
end
|
||||
end
|
||||
end;
|
||||
|
||||
proc transpile_module(context: PTranspilerContext, result: PAstModule);
|
||||
begin
|
||||
if result^.main = false 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);
|
||||
|
||||
write_semicolon(context^.output);
|
||||
WriteLine(context^.output);
|
||||
|
||||
(* Write the module body. *)
|
||||
|
||||
transpile_import_part(context, result^.imports);
|
||||
transpile_constant_part(context, result^.constants, true);
|
||||
transpile_type_part(context, result^.types);
|
||||
transpile_variable_part(context, result^.variables, true);
|
||||
transpile_procedure_part(context, result^.procedures);
|
||||
transpile_statement_part(context, result^.statements);
|
||||
|
||||
WriteString(context^.output, 'END ');
|
||||
transpile_module_name(context);
|
||||
|
||||
WriteChar(context^.output, '.');
|
||||
WriteLine(context^.output)
|
||||
end;
|
||||
|
||||
proc 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;
|
||||
|
||||
proc 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;
|
||||
|
||||
proc transpile_pointer_type(context: PTranspilerContext, type_expression: PAstTypeExpression);
|
||||
begin
|
||||
WriteString(context^.output, 'POINTER TO ');
|
||||
|
||||
transpile_type_expression(context, type_expression^.target)
|
||||
end;
|
||||
|
||||
proc transpile_array_type(context: PTranspilerContext, type_expression: PAstTypeExpression);
|
||||
var
|
||||
buffer: [20]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;
|
||||
|
||||
proc 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;
|
||||
|
||||
proc 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;
|
||||
|
||||
proc 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;
|
||||
|
||||
proc 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;
|
||||
|
||||
proc transpile_type_declaration(context: PTranspilerContext, declaration: PAstTypedDeclaration);
|
||||
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;
|
||||
|
||||
proc transpile_type_part(context: PTranspilerContext, declarations: PPAstTypedDeclaration);
|
||||
var
|
||||
current_declaration: PPAstTypedDeclaration;
|
||||
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(PAstTypedDeclaration))
|
||||
end;
|
||||
WriteLine(context^.output)
|
||||
end
|
||||
end;
|
||||
|
||||
proc 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;
|
||||
|
||||
proc transpile_variable_part(context: PTranspilerContext, declarations: PPAstVariableDeclaration, extra_newline: BOOLEAN);
|
||||
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;
|
||||
if extra_newline then
|
||||
WriteLine(context^.output)
|
||||
end
|
||||
end
|
||||
end;
|
||||
|
||||
proc transpile_procedure_heading(context: PTranspilerContext, declaration: PAstProcedureDeclaration);
|
||||
var
|
||||
written_bytes: CARDINAL;
|
||||
parameter_index: CARDINAL;
|
||||
current_parameter: PAstTypedDeclaration;
|
||||
begin
|
||||
WriteString(context^.output, 'PROCEDURE ');
|
||||
written_bytes := WriteNBytes(context^.output, ORD(declaration^.name[1]), ADR(declaration^.name[2]));
|
||||
WriteChar(context^.output, '(');
|
||||
|
||||
parameter_index := 0;
|
||||
current_parameter := declaration^.parameters;
|
||||
|
||||
while parameter_index < declaration^.parameter_count do
|
||||
written_bytes := WriteNBytes(context^.output, ORD(current_parameter^.identifier[1]), ADR(current_parameter^.identifier[2]));
|
||||
WriteString(context^.output, ': ');
|
||||
transpile_type_expression(context, current_parameter^.type_expression);
|
||||
|
||||
INC(parameter_index);
|
||||
INC(current_parameter, TSIZE(AstTypedDeclaration));
|
||||
|
||||
if parameter_index <> declaration^.parameter_count then
|
||||
WriteString(context^.output, '; ')
|
||||
end
|
||||
end;
|
||||
|
||||
WriteString(context^.output, ')');
|
||||
|
||||
(* Check for the return type and write it. *)
|
||||
if declaration^.return_type <> nil then
|
||||
WriteString(context^.output, ': ');
|
||||
transpile_type_expression(context, declaration^.return_type)
|
||||
end;
|
||||
write_semicolon(context^.output)
|
||||
end;
|
||||
|
||||
proc transpile_unary_operator(context: PTranspilerContext, operator: AstUnaryOperator);
|
||||
begin
|
||||
if operator = astUnaryOperatorMinus then
|
||||
WriteChar(context^.output, '-')
|
||||
end;
|
||||
if operator = astUnaryOperatorNot then
|
||||
WriteChar(context^.output, '~')
|
||||
end
|
||||
end;
|
||||
|
||||
proc transpile_binary_operator(context: PTranspilerContext, operator: AstBinaryOperator);
|
||||
begin
|
||||
if operator = astBinaryOperatorSum then
|
||||
WriteChar(context^.output, '+')
|
||||
end;
|
||||
if operator = astBinaryOperatorSubtraction then
|
||||
WriteChar(context^.output, '-')
|
||||
end;
|
||||
if operator = astBinaryOperatorMultiplication then
|
||||
WriteChar(context^.output, '*')
|
||||
end;
|
||||
if operator = astBinaryOperatorEquals then
|
||||
WriteChar(context^.output, '=')
|
||||
end;
|
||||
if operator = astBinaryOperatorNotEquals then
|
||||
WriteChar(context^.output, '#')
|
||||
end;
|
||||
if operator = astBinaryOperatorLess then
|
||||
WriteChar(context^.output, '<')
|
||||
end;
|
||||
if operator = astBinaryOperatorGreater then
|
||||
WriteChar(context^.output, '>')
|
||||
end;
|
||||
if operator = astBinaryOperatorLessEqual then
|
||||
WriteString(context^.output, '<=')
|
||||
end;
|
||||
if operator = astBinaryOperatorGreaterEqual then
|
||||
WriteString(context^.output, '>=')
|
||||
end;
|
||||
if operator = astBinaryOperatorDisjunction then
|
||||
WriteString(context^.output, 'OR')
|
||||
end;
|
||||
if operator = astBinaryOperatorConjunction then
|
||||
WriteString(context^.output, 'AND')
|
||||
end
|
||||
end;
|
||||
|
||||
proc transpile_expression(context: PTranspilerContext, expression: PAstExpression);
|
||||
var
|
||||
literal: PAstLiteral;
|
||||
buffer: [20]CHAR;
|
||||
written_bytes: CARDINAL;
|
||||
argument_index: CARDINAL;
|
||||
current_argument: PPAstExpression;
|
||||
begin
|
||||
if expression^.kind = astExpressionKindLiteral then
|
||||
literal := expression^.literal;
|
||||
|
||||
if literal^.kind = astLiteralKindInteger then
|
||||
IntToStr(literal^.integer, 0, buffer);
|
||||
WriteString(context^.output, buffer)
|
||||
end;
|
||||
if literal^.kind = astLiteralKindString then
|
||||
WriteString(context^.output, literal^.string)
|
||||
end;
|
||||
if literal^.kind = astLiteralKindNull then
|
||||
WriteString(context^.output, 'NIL')
|
||||
end;
|
||||
if (literal^.kind = astLiteralKindBoolean) & literal^.boolean then
|
||||
WriteString(context^.output, 'TRUE')
|
||||
end;
|
||||
if (literal^.kind = astLiteralKindBoolean) & (literal^.boolean = false) then
|
||||
WriteString(context^.output, 'FALSE')
|
||||
end
|
||||
end;
|
||||
if expression^.kind = astExpressionKindIdentifier then
|
||||
written_bytes := WriteNBytes(context^.output, ORD(expression^.identifier[1]), ADR(expression^.identifier[2]))
|
||||
end;
|
||||
if expression^.kind = astExpressionKindDereference then
|
||||
transpile_expression(context, expression^.reference);
|
||||
WriteChar(context^.output, '^')
|
||||
end;
|
||||
if expression^.kind = astExpressionKindArrayAccess then
|
||||
transpile_expression(context, expression^.array);
|
||||
WriteChar(context^.output, '[');
|
||||
transpile_expression(context, expression^.index);
|
||||
WriteChar(context^.output, ']')
|
||||
end;
|
||||
if expression^.kind = astExpressionKindFieldAccess then
|
||||
transpile_expression(context, expression^.aggregate);
|
||||
WriteChar(context^.output, '.');
|
||||
written_bytes := WriteNBytes(context^.output, ORD(expression^.field[1]), ADR(expression^.field[2]))
|
||||
end;
|
||||
if expression^.kind = astExpressionKindUnary then
|
||||
transpile_unary_operator(context, expression^.unary_operator);
|
||||
transpile_expression(context, expression^.unary_operand)
|
||||
end;
|
||||
if expression^.kind = astExpressionKindBinary then
|
||||
WriteChar(context^.output, '(');
|
||||
transpile_expression(context, expression^.lhs);
|
||||
WriteChar(context^.output, ' ');
|
||||
transpile_binary_operator(context, expression^.binary_operator);
|
||||
WriteChar(context^.output, ' ');
|
||||
transpile_expression(context, expression^.rhs);
|
||||
WriteChar(context^.output, ')')
|
||||
end;
|
||||
if expression^.kind = astExpressionKindCall then
|
||||
transpile_expression(context, expression^.callable);
|
||||
WriteChar(context^.output, '(');
|
||||
|
||||
current_argument := expression^.arguments;
|
||||
if expression^.argument_count > 0 then
|
||||
transpile_expression(context, current_argument^);
|
||||
|
||||
argument_index := 1;
|
||||
INC(current_argument, TSIZE(PAstExpression));
|
||||
|
||||
while argument_index < expression^.argument_count do
|
||||
WriteString(context^.output, ', ');
|
||||
|
||||
transpile_expression(context, current_argument^);
|
||||
|
||||
INC(current_argument, TSIZE(PAstExpression));
|
||||
INC(argument_index)
|
||||
end
|
||||
end;
|
||||
WriteChar(context^.output, ')')
|
||||
end
|
||||
end;
|
||||
|
||||
proc transpile_if_statement(context: PTranspilerContext, statement: PAstStatement);
|
||||
begin
|
||||
WriteString(context^.output, 'IF ');
|
||||
transpile_expression(context, statement^.if_condition);
|
||||
|
||||
WriteString(context^.output, ' THEN');
|
||||
WriteLine(context^.output);
|
||||
INC(context^.indentation);
|
||||
|
||||
transpile_compound_statement(context, statement^.if_branch);
|
||||
DEC(context^.indentation);
|
||||
indent(context);
|
||||
WriteString(context^.output, 'END')
|
||||
end;
|
||||
|
||||
proc transpile_while_statement(context: PTranspilerContext, statement: PAstStatement);
|
||||
begin
|
||||
WriteString(context^.output, 'WHILE ');
|
||||
transpile_expression(context, statement^.while_condition);
|
||||
|
||||
WriteString(context^.output, ' DO');
|
||||
WriteLine(context^.output);
|
||||
INC(context^.indentation);
|
||||
|
||||
transpile_compound_statement(context, statement^.while_body);
|
||||
DEC(context^.indentation);
|
||||
indent(context);
|
||||
WriteString(context^.output, 'END')
|
||||
end;
|
||||
|
||||
proc transpile_assignment_statement(context: PTranspilerContext, statement: PAstStatement);
|
||||
begin
|
||||
transpile_expression(context, statement^.assignee);
|
||||
WriteString(context^.output, ' := ');
|
||||
transpile_expression(context, statement^.assignment)
|
||||
end;
|
||||
|
||||
proc transpile_return_statement(context: PTranspilerContext, statement: PAstStatement);
|
||||
begin
|
||||
WriteString(context^.output, 'RETURN ');
|
||||
|
||||
transpile_expression(context, statement^.returned)
|
||||
end;
|
||||
|
||||
proc transpile_compound_statement(context: PTranspilerContext, statement: AstCompoundStatement);
|
||||
var
|
||||
current_statement: PPAstStatement;
|
||||
index: CARDINAL;
|
||||
begin
|
||||
index := 0;
|
||||
current_statement := statement.statements;
|
||||
|
||||
while index < statement.count do
|
||||
transpile_statement(context, current_statement^);
|
||||
|
||||
INC(current_statement, TSIZE(PAstStatement));
|
||||
INC(index);
|
||||
|
||||
if index <> statement.count then
|
||||
WriteChar(context^.output, ';')
|
||||
end;
|
||||
WriteLine(context^.output)
|
||||
end
|
||||
end;
|
||||
|
||||
proc transpile_statement(context: PTranspilerContext, statement: PAstStatement);
|
||||
begin
|
||||
indent(context);
|
||||
|
||||
if statement^.kind = astStatementKindIf then
|
||||
transpile_if_statement(context, statement)
|
||||
end;
|
||||
if statement^.kind = astStatementKindWhile then
|
||||
transpile_while_statement(context, statement)
|
||||
end;
|
||||
if statement^.kind = astStatementKindReturn then
|
||||
transpile_return_statement(context, statement)
|
||||
end;
|
||||
if statement^.kind = astStatementKindAssignment then
|
||||
transpile_assignment_statement(context, statement)
|
||||
end;
|
||||
if statement^.kind = astStatementKindCall then
|
||||
transpile_expression(context, statement^.call)
|
||||
end
|
||||
end;
|
||||
|
||||
proc transpile_statement_part(context: PTranspilerContext, compound: AstCompoundStatement);
|
||||
begin
|
||||
if compound.count > 0 then
|
||||
WriteString(context^.output, 'BEGIN');
|
||||
WriteLine(context^.output);
|
||||
|
||||
INC(context^.indentation);
|
||||
transpile_compound_statement(context, compound);
|
||||
DEC(context^.indentation)
|
||||
end
|
||||
end;
|
||||
|
||||
proc transpile_procedure_declaration(context: PTranspilerContext, declaration: PAstProcedureDeclaration);
|
||||
var
|
||||
written_bytes: CARDINAL;
|
||||
begin
|
||||
transpile_procedure_heading(context, declaration);
|
||||
|
||||
transpile_constant_part(context, declaration^.constants, false);
|
||||
transpile_variable_part(context, declaration^.variables, false);
|
||||
transpile_statement_part(context, declaration^.statements);
|
||||
|
||||
WriteString(context^.output, 'END ');
|
||||
written_bytes := WriteNBytes(context^.output, ORD(declaration^.name[1]), ADR(declaration^.name[2]));
|
||||
|
||||
write_semicolon(context^.output)
|
||||
end;
|
||||
|
||||
proc transpile_procedure_part(context: PTranspilerContext, declaration: PPAstProcedureDeclaration);
|
||||
begin
|
||||
while declaration^ <> nil do
|
||||
transpile_procedure_declaration(context, declaration^);
|
||||
WriteLine(context^.output);
|
||||
|
||||
INC(declaration, TSIZE(PAstProcedureDeclaration))
|
||||
end
|
||||
end;
|
||||
|
||||
proc transpile_module_name(context: PTranspilerContext);
|
||||
var
|
||||
counter: CARDINAL;
|
||||
last_slash: CARDINAL;
|
||||
begin
|
||||
counter := 1;
|
||||
last_slash := 0;
|
||||
|
||||
while (context^.input_name[counter] <> '.') & (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] <> '.') & (ORD(context^.input_name[counter]) <> 0) do
|
||||
WriteChar(context^.output, context^.input_name[counter]);
|
||||
INC(counter)
|
||||
end
|
||||
end;
|
||||
|
||||
proc transpile(ast_module: PAstModule, output: File, definition: File, input_name: ShortString);
|
||||
var
|
||||
context: TranspilerContext;
|
||||
begin
|
||||
context.input_name := input_name;
|
||||
context.output := output;
|
||||
context.definition := definition;
|
||||
context.indentation := 0;
|
||||
|
||||
transpile_module(ADR(context), ast_module)
|
||||
end;
|
||||
|
||||
end.
|
||||
1084
source/main.elna
Normal file
1084
source/main.elna
Normal file
File diff suppressed because it is too large
Load Diff
Reference in New Issue
Block a user