belka/elna
1
0
Fork 0
Code Issues 4 Pull Requests Releases Activity

Transpile procedures and statements

Browse Source
This commit is contained in:
Eugen Wissner 2025-05-29 00:24:52 +02:00
parent 24651e7c48
commit 192e7e40c8
Signed by: belka
GPG Key ID: A27FDC1E8EE902C0
3 changed files with 521 additions and 250 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
Rakefile
View File

@ -100,13 +100,15 @@ task :backport do
source = File.read source_path
target = source
.gsub(/^(var|type|const)/) { |match| match.upcase }
.gsub(/^(var|type|const|begin)/) { |match| match.upcase }
.gsub(/^[[:alnum:]]* ?module/) { |match| match.upcase }
.gsub(/(record| pointer to )/) { |match| match.upcase }
.gsub(/\brecord\b/) { |match| match.upcase }
.gsub(/proc(\(| )/, 'PROCEDURE\1')
.gsub(/([[:space:]]*)end;/, '\1END;')
.gsub(/([[:space:]]*)end(;?)$/, '\1END\2')
.gsub(/^([[:space:]]*)(while|return|if)\b/) { |match| match.upcase }
.gsub(/^from ([[:alnum:]]+) import/, 'FROM \1 IMPORT')
.gsub(/ \^([[:alnum:]])/, ' POINTER TO \1')
.gsub(/(then|do)$/) { |match| match.upcase }
target_path = Pathname.new('boot/stage1/source') + source_path.basename
File.write target_path, target

309
source/Lexer.elna
View File

@ -70,8 +70,8 @@ var
Classification: ARRAY[1..128] OF TransitionClass;
Transitions: ARRAY[0..15] OF ARRAY[0..21] OF Transition;
PROCEDURE InitializeClassification();
BEGIN
proc InitializeClassification();
begin
Classification[1] := transitionClassEof; (* NUL *)
Classification[2] := transitionClassInvalid; (* SOH *)
Classification[3] := transitionClassInvalid; (* STX *)
@ -202,195 +202,265 @@ BEGIN
Classification[128] := transitionClassInvalid (* DEL *)
END InitializeClassification;
PROCEDURE CompareKeyword(Keyword: ARRAY OF CHAR; TokenStart: PLexerBuffer; TokenEnd: PLexerBuffer): BOOLEAN;
VAR
proc CompareKeyword(Keyword: ARRAY OF CHAR; TokenStart: PLexerBuffer; TokenEnd: PLexerBuffer): BOOLEAN;
var
Result: BOOLEAN;
Index: CARDINAL;
BEGIN
begin
Index := 0;
Result := TRUE;
WHILE (Index < Length(Keyword)) AND (TokenStart <> TokenEnd) AND Result DO
while (Index < Length(Keyword)) AND (TokenStart <> TokenEnd) AND Result DO
Result := (Keyword[Index] = TokenStart^) OR (Lower(Keyword[Index]) = TokenStart^);
INC(TokenStart);
INC(Index)
END;
RETURN (Index = Length(Keyword)) AND (TokenStart = TokenEnd) AND Result
end;
Result := (Index = Length(Keyword)) AND (TokenStart = TokenEnd) AND Result;
return Result
END CompareKeyword;
(* Reached the end of file. *)
PROCEDURE TransitionActionEof(ALexer: PLexer; AToken: PLexerToken);
BEGIN
proc 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
proc 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
proc TransitionActionFinalize(ALexer: PLexer; AToken: PLexerToken);
begin
if ALexer^.Start^ = ':' then
AToken^.Kind := lexerKindColon
ELSIF ALexer^.Start^ = '>' THEN
end;
if ALexer^.Start^ = '>' then
AToken^.Kind := lexerKindGreaterThan
ELSIF ALexer^.Start^ = '<' THEN
end;
if ALexer^.Start^ = '<' then
AToken^.Kind := lexerKindLessThan
ELSIF ALexer^.Start^ = '(' THEN
end;
if ALexer^.Start^ = '(' then
AToken^.Kind := lexerKindLeftParen
ELSIF ALexer^.Start^ = '-' THEN
end;
if ALexer^.Start^ = '-' then
AToken^.Kind := lexerKindLeftParen
ELSIF ALexer^.Start^ = '.' THEN
end;
if ALexer^.Start^ = '.' then
AToken^.Kind := lexerKindDot
END
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
proc TransitionActionComposite(ALexer: PLexer; AToken: PLexerToken);
begin
if ALexer^.Start^ = '<' then
if ALexer^.Current^ = '>' then
AToken^.Kind := lexerKindNotEqual
ELSIF ALexer^.Current^ = '=' THEN
end;
if ALexer^.Current^ = '=' then
AToken^.Kind := lexerKindLessEqual
END
ELSIF (ALexer^.Start^ = '>') AND (ALexer^.Current^ = '=') THEN
end
end;
if (ALexer^.Start^ = '>') AND (ALexer^.Current^ = '=') then
AToken^.Kind := lexerKindGreaterEqual
ELSIF (ALexer^.Start^ = '.') AND (ALexer^.Current^ = '.') THEN
end;
if (ALexer^.Start^ = '.') AND (ALexer^.Current^ = '.') then
AToken^.Kind := lexerKindRange
ELSIF (ALexer^.Start^ = ':') AND (ALexer^.Current^ = '=') THEN
end;
if (ALexer^.Start^ = ':') AND (ALexer^.Current^ = '=') then
AToken^.Kind := lexerKindAssignment
END;
end;
INC(ALexer^.Current)
END TransitionActionComposite;
(* Skip a space. *)
PROCEDURE TransitionActionSkip(ALexer: PLexer; AToken: PLexerToken);
BEGIN
proc 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
(* Delimited string action. *)
proc TransitionActionDelimited(ALexer: PLexer; AToken: PLexerToken);
begin
if ALexer^.Start^ = '(' then
AToken^.Kind := lexerKindComment
ELSIF ALexer^.Start^ = '"' THEN
end;
if ALexer^.Start^ = '"' then
AToken^.Kind := lexerKindCharacter
ELSIF ALexer^.Start^ = "'" THEN
end;
if ALexer^.Start^ = "'" then
AToken^.Kind := lexerKindString
END;
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
proc TransitionActionKeyId(ALexer: PLexer; AToken: PLexerToken);
begin
AToken^.Kind := lexerKindIdentifier;
if CompareKeyword('PROGRAM', ALexer^.Start, ALexer^.Current) then
AToken^.Kind := lexerKindProgram
ELSIF CompareKeyword('IMPORT', ALexer^.Start, ALexer^.Current) THEN
end;
if CompareKeyword('IMPORT', ALexer^.Start, ALexer^.Current) then
AToken^.Kind := lexerKindImport
ELSIF CompareKeyword('CONST', ALexer^.Start, ALexer^.Current) THEN
end;
if CompareKeyword('CONST', ALexer^.Start, ALexer^.Current) then
AToken^.Kind := lexerKindConst
ELSIF CompareKeyword('VAR', ALexer^.Start, ALexer^.Current) THEN
end;
if CompareKeyword('VAR', ALexer^.Start, ALexer^.Current) then
AToken^.Kind := lexerKindVar
ELSIF CompareKeyword('IF', ALexer^.Start, ALexer^.Current) THEN
end;
if CompareKeyword('IF', ALexer^.Start, ALexer^.Current) then
AToken^.Kind := lexerKindIf
ELSIF CompareKeyword('THEN', ALexer^.Start, ALexer^.Current) THEN
end;
if CompareKeyword('THEN', ALexer^.Start, ALexer^.Current) then
AToken^.Kind := lexerKindThen
ELSIF CompareKeyword('ELSIF', ALexer^.Start, ALexer^.Current) THEN
end;
if CompareKeyword('ELSIF', ALexer^.Start, ALexer^.Current) then
AToken^.Kind := lexerKindElsif
ELSIF CompareKeyword('ELSE', ALexer^.Start, ALexer^.Current) THEN
end;
if CompareKeyword('ELSE', ALexer^.Start, ALexer^.Current) then
AToken^.Kind := lexerKindElse
ELSIF CompareKeyword('WHILE', ALexer^.Start, ALexer^.Current) THEN
end;
if CompareKeyword('WHILE', ALexer^.Start, ALexer^.Current) then
AToken^.Kind := lexerKindWhile
ELSIF CompareKeyword('DO', ALexer^.Start, ALexer^.Current) THEN
end;
if CompareKeyword('DO', ALexer^.Start, ALexer^.Current) then
AToken^.Kind := lexerKindDo
ELSIF CompareKeyword('PROCEDURE', ALexer^.Start, ALexer^.Current) OR CompareKeyword('proc', ALexer^.Start, ALexer^.Current) THEN
end;
if CompareKeyword('proc', ALexer^.Start, ALexer^.Current) then
AToken^.Kind := lexerKindProc
ELSIF CompareKeyword('BEGIN', ALexer^.Start, ALexer^.Current) THEN
end;
if CompareKeyword('BEGIN', ALexer^.Start, ALexer^.Current) then
AToken^.Kind := lexerKindBegin
ELSIF CompareKeyword('END', ALexer^.Start, ALexer^.Current) THEN
end;
if CompareKeyword('END', ALexer^.Start, ALexer^.Current) then
AToken^.Kind := lexerKindEnd
ELSIF CompareKeyword('TYPE', ALexer^.Start, ALexer^.Current) THEN
end;
if CompareKeyword('TYPE', ALexer^.Start, ALexer^.Current) then
AToken^.Kind := lexerKindType
ELSIF CompareKeyword('RECORD', ALexer^.Start, ALexer^.Current) THEN
end;
if CompareKeyword('RECORD', ALexer^.Start, ALexer^.Current) then
AToken^.Kind := lexerKindRecord
ELSIF CompareKeyword('UNION', ALexer^.Start, ALexer^.Current) THEN
end;
if CompareKeyword('UNION', ALexer^.Start, ALexer^.Current) then
AToken^.Kind := lexerKindUnion
ELSIF CompareKeyword('NIL', ALexer^.Start, ALexer^.Current) THEN
end;
if CompareKeyword('NIL', ALexer^.Start, ALexer^.Current) then
AToken^.Kind := lexerKindNull
ELSIF CompareKeyword('AND', ALexer^.Start, ALexer^.Current) THEN
end;
if CompareKeyword('AND', ALexer^.Start, ALexer^.Current) then
AToken^.Kind := lexerKindAnd
ELSIF CompareKeyword('OR', ALexer^.Start, ALexer^.Current) THEN
end;
if CompareKeyword('OR', ALexer^.Start, ALexer^.Current) then
AToken^.Kind := lexerKindOr
ELSIF CompareKeyword('RETURN', ALexer^.Start, ALexer^.Current) THEN
end;
if CompareKeyword('RETURN', ALexer^.Start, ALexer^.Current) then
AToken^.Kind := lexerKindReturn
ELSIF CompareKeyword('DEFINITION', ALexer^.Start, ALexer^.Current) THEN
end;
if CompareKeyword('DEFINITION', ALexer^.Start, ALexer^.Current) then
AToken^.Kind := lexerKindDefinition
ELSIF CompareKeyword('TO', ALexer^.Start, ALexer^.Current) THEN
end;
if CompareKeyword('TO', ALexer^.Start, ALexer^.Current) then
AToken^.Kind := lexerKindTo
ELSIF CompareKeyword('CASE', ALexer^.Start, ALexer^.Current) THEN
end;
if CompareKeyword('CASE', ALexer^.Start, ALexer^.Current) then
AToken^.Kind := lexerKindCase
ELSIF CompareKeyword('OF', ALexer^.Start, ALexer^.Current) THEN
end;
if CompareKeyword('OF', ALexer^.Start, ALexer^.Current) then
AToken^.Kind := lexerKindOf
ELSIF CompareKeyword('FROM', ALexer^.Start, ALexer^.Current) THEN
end;
if CompareKeyword('FROM', ALexer^.Start, ALexer^.Current) then
AToken^.Kind := lexerKindFrom
ELSIF CompareKeyword('MODULE', ALexer^.Start, ALexer^.Current) THEN
end;
if CompareKeyword('MODULE', ALexer^.Start, ALexer^.Current) then
AToken^.Kind := lexerKindModule
ELSIF CompareKeyword('IMPLEMENTATION', ALexer^.Start, ALexer^.Current) THEN
end;
if CompareKeyword('IMPLEMENTATION', ALexer^.Start, ALexer^.Current) then
AToken^.Kind := lexerKindImplementation
ELSIF CompareKeyword('POINTER', ALexer^.Start, ALexer^.Current) THEN
end;
if CompareKeyword('POINTER', ALexer^.Start, ALexer^.Current) then
AToken^.Kind := lexerKindPointer
ELSIF CompareKeyword('ARRAY', ALexer^.Start, ALexer^.Current) THEN
end;
if CompareKeyword('ARRAY', ALexer^.Start, ALexer^.Current) then
AToken^.Kind := lexerKindArray
ELSIF CompareKeyword('TRUE', ALexer^.Start, ALexer^.Current) THEN
end;
if CompareKeyword('TRUE', ALexer^.Start, ALexer^.Current) then
AToken^.Kind := lexerKindBoolean;
AToken^.booleanKind := TRUE
ELSIF CompareKeyword('FALSE', ALexer^.Start, ALexer^.Current) THEN
end;
if CompareKeyword('FALSE', ALexer^.Start, ALexer^.Current) then
AToken^.Kind := lexerKindBoolean;
AToken^.booleanKind := FALSE
ELSE
AToken^.Kind := lexerKindIdentifier
END;
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;
proc TransitionActionSingle(ALexer: PLexer; AToken: PLexerToken);
begin
if ALexer^.Current^ = '&' then
AToken^.Kind := lexerKindAnd
end;
if ALexer^.Current^ = ';' then
AToken^.Kind := lexerKindSemicolon
end;
if ALexer^.Current^ = ',' then
AToken^.Kind := lexerKindComma
end;
if ALexer^.Current^ = ',' then
AToken^.Kind := lexerKindComma
end;
if ALexer^.Current^ = ')' then
AToken^.Kind := lexerKindRightParen
end;
if ALexer^.Current^ = '[' then
AToken^.Kind := lexerKindLeftSquare
end;
if ALexer^.Current^ = ']' then
AToken^.Kind := lexerKindRightSquare
end;
if ALexer^.Current^ = '^' then
AToken^.Kind := lexerKindHat
end;
if ALexer^.Current^ = '=' then
AToken^.Kind := lexerKindEqual
end;
if ALexer^.Current^ = '+' then
AToken^.Kind := lexerKindPlus
end;
if ALexer^.Current^ = '/' then
AToken^.Kind := lexerKindDivision
end;
if ALexer^.Current^ = '%' then
AToken^.Kind := lexerKindRemainder
end;
if ALexer^.Current^ = '@' then
AToken^.Kind := lexerKindAt
end;
if ALexer^.Current^ = '|' then
AToken^.Kind := lexerKindPipe
end;
INC(ALexer^.Current)
END TransitionActionSingle;
(* Handle an integer literal. *)
PROCEDURE TransitionActionInteger(ALexer: PLexer; AToken: PLexerToken);
BEGIN
proc TransitionActionInteger(ALexer: PLexer; AToken: PLexerToken);
begin
AToken^.Kind := lexerKindInteger
END TransitionActionInteger;
PROCEDURE SetDefaultTransition(CurrentState: TransitionState; DefaultAction: TransitionAction; NextState: TransitionState);
VAR DefaultTransition: Transition;
BEGIN
proc SetDefaultTransition(CurrentState: TransitionState; DefaultAction: TransitionAction; NextState: TransitionState);
var
DefaultTransition: Transition;
begin
DefaultTransition.Action := DefaultAction;
DefaultTransition.NextState := NextState;
@ -415,7 +485,7 @@ BEGIN
Transitions[ORD(CurrentState)][ORD(transitionClassDoubleQuote)] := DefaultTransition;
Transitions[ORD(CurrentState)][ORD(transitionClassGreater)] := DefaultTransition;
Transitions[ORD(CurrentState)][ORD(transitionClassLess)] := DefaultTransition;
Transitions[ORD(CurrentState)][ORD(transitionClassOther)] := DefaultTransition;
Transitions[ORD(CurrentState)][ORD(transitionClassOther)] := DefaultTransition
END SetDefaultTransition;
(*
@ -434,8 +504,8 @@ END SetDefaultTransition;
* For the meaning of actions see labels in the lex_next function, which
* handles each action.
*)
PROCEDURE InitializeTransitions();
BEGIN
proc InitializeTransitions();
begin
(* Start state. *)
Transitions[ORD(transitionStateStart)][ORD(transitionClassInvalid)].Action := NIL;
Transitions[ORD(transitionStateStart)][ORD(transitionClassInvalid)].NextState := transitionStateEnd;
@ -672,8 +742,8 @@ BEGIN
Transitions[ORD(transitionStateDecimalSuffix)][ORD(transitionClassX)].NextState := transitionStateEnd
END InitializeTransitions;
PROCEDURE LexerInitialize(ALexer: PLexer; Input: File);
BEGIN
proc LexerInitialize(ALexer: PLexer; Input: File);
begin
ALexer^.Input := Input;
ALexer^.Length := 0;
@ -682,41 +752,44 @@ BEGIN
ALexer^.Size := ChunkSize
END LexerInitialize;
PROCEDURE LexerCurrent(ALexer: PLexer): LexerToken;
VAR
proc LexerCurrent(ALexer: PLexer): LexerToken;
var
CurrentClass: TransitionClass;
CurrentState: TransitionState;
CurrentTransition: Transition;
Result: LexerToken;
BEGIN
begin
ALexer^.Current := ALexer^.Start;
CurrentState := transitionStateStart;
WHILE CurrentState <> transitionStateEnd DO
while CurrentState <> transitionStateEnd DO
CurrentClass := Classification[ORD(ALexer^.Current^) + 1];
CurrentTransition := Transitions[ORD(CurrentState)][ORD(CurrentClass)];
IF CurrentTransition.Action <> NIL THEN
if CurrentTransition.Action <> NIL then
CurrentTransition.Action(ALexer, ADR(Result))
END;
end;
CurrentState := CurrentTransition.NextState
END;
RETURN Result
end;
return Result
END LexerCurrent;
PROCEDURE LexerLex(ALexer: PLexer): LexerToken;
BEGIN
IF ALexer^.Length = 0 THEN
proc LexerLex(ALexer: PLexer): LexerToken;
var
Result: LexerToken;
begin
if ALexer^.Length = 0 then
ALexer^.Length := ReadNBytes(ALexer^.Input, ChunkSize, ALexer^.Buffer);
ALexer^.Current := ALexer^.Buffer
END;
end;
ALexer^.Start := ALexer^.Current;
RETURN LexerCurrent(ALexer)
Result := LexerCurrent(ALexer);
return Result
END LexerLex;
PROCEDURE LexerDestroy(ALexer: PLexer);
BEGIN
proc LexerDestroy(ALexer: PLexer);
begin
DEALLOCATE(ALexer^.Buffer, ALexer^.Size)
END LexerDestroy;

454
source/Transpiler.elna
View File

@ -13,31 +13,31 @@ type
end;
(* Calls LexerLex() but skips the comments. *)
PROCEDURE TranspilerLex(ALexer: PLexer): LexerToken;
VAR
proc TranspilerLex(ALexer: PLexer): LexerToken;
var
Result: LexerToken;
BEGIN
begin
Result := LexerLex(ALexer);
WHILE Result.Kind = lexerKindComment DO
while Result.Kind = lexerKindComment do
Result := LexerLex(ALexer)
END;
end;
RETURN Result
return Result
END TranspilerLex;
(* Write a semicolon followed by a newline. *)
PROCEDURE WriteSemicolon();
BEGIN
proc WriteSemicolon();
begin
WriteString(';');
WriteLn()
END WriteSemicolon;
PROCEDURE TranspileImport(AContext: PTranspilerContext; ALexer: PLexer);
VAR
proc TranspileImport(AContext: PTranspilerContext; ALexer: PLexer);
var
Token: LexerToken;
WrittenBytes: CARDINAL;
BEGIN
begin
WriteString('FROM ');
Token := TranspilerLex(ALexer);
@ -50,34 +50,34 @@ BEGIN
WrittenBytes := WriteNBytes(StdOut, ADDRESS(ALexer^.Current - ALexer^.Start), ALexer^.Start);
Token := TranspilerLex(ALexer);
WHILE Token.Kind <> lexerKindSemicolon DO
while Token.Kind <> lexerKindSemicolon do
WriteString(', ');
Token := TranspilerLex(ALexer);
WrittenBytes := WriteNBytes(StdOut, ADDRESS(ALexer^.Current - ALexer^.Start), ALexer^.Start);
Token := TranspilerLex(ALexer)
END;
end;
WriteSemicolon();
Token := TranspilerLex(ALexer)
END TranspileImport;
PROCEDURE TranspileImportPart(AContext: PTranspilerContext; ALexer: PLexer);
VAR
proc TranspileImportPart(AContext: PTranspilerContext; ALexer: PLexer);
var
Token: LexerToken;
BEGIN
begin
Token := LexerCurrent(ALexer);
WHILE Token.Kind = lexerKindFrom DO
while Token.Kind = lexerKindFrom do
TranspileImport(AContext, ALexer);
Token := LexerCurrent(ALexer)
END;
end;
WriteLn()
END TranspileImportPart;
PROCEDURE TranspileConstant(AContext: PTranspilerContext; ALexer: PLexer);
VAR
proc TranspileConstant(AContext: PTranspilerContext; ALexer: PLexer);
var
Token: LexerToken;
WrittenBytes: CARDINAL;
BEGIN
begin
WriteString(' ');
Token := LexerCurrent(ALexer);
WrittenBytes := WriteNBytes(StdOut, ADDRESS(ALexer^.Current - ALexer^.Start), ALexer^.Start);
@ -92,39 +92,42 @@ BEGIN
WriteSemicolon()
END TranspileConstant;
PROCEDURE TranspileConstantPart(AContext: PTranspilerContext; ALexer: PLexer);
VAR
proc TranspileConstantPart(AContext: PTranspilerContext; ALexer: PLexer): BOOLEAN;
var
Token: LexerToken;
BEGIN
Result: BOOLEAN;
begin
Token := LexerCurrent(ALexer);
Result := Token.Kind = lexerKindConst;
IF Token.Kind = lexerKindConst THEN
if Result then
WriteString('CONST');
WriteLn();
Token := TranspilerLex(ALexer);
WHILE Token.Kind = lexerKindIdentifier DO
while Token.Kind = lexerKindIdentifier do
TranspileConstant(AContext, ALexer);
Token := TranspilerLex(ALexer)
END;
WriteLn()
END
end
end;
return Result
END TranspileConstantPart;
PROCEDURE TranspileModule(AContext: PTranspilerContext; ALexer: PLexer);
VAR
proc TranspileModule(AContext: PTranspilerContext; ALexer: PLexer);
var
Token: LexerToken;
WrittenBytes: CARDINAL;
BEGIN
begin
Token := TranspilerLex(ALexer);
IF Token.Kind = lexerKindDefinition THEN
if Token.Kind = lexerKindDefinition then
WriteString('DEFINITION ');
Token := TranspilerLex(ALexer);
ELSIF Token.Kind = lexerKindImplementation THEN
Token := TranspilerLex(ALexer)
end;
if Token.Kind = lexerKindImplementation then
WriteString('IMPLEMENTATION ');
Token := TranspilerLex(ALexer)
END;
end;
WriteString('MODULE ');
(* Write the module name and end the line with a semicolon and newline. *)
@ -138,28 +141,32 @@ BEGIN
(* Write the module body. *)
Token := TranspilerLex(ALexer);
TranspileImportPart(AContext, ALexer);
TranspileConstantPart(AContext, ALexer);
if TranspileConstantPart(AContext, ALexer) then
WriteLn()
end;
TranspileTypePart(AContext, ALexer);
TranspileVariablePart(AContext, ALexer);
if TranspileVariablePart(AContext, ALexer) then
WriteLn()
end;
TranspileProcedurePart(AContext, ALexer);
Token := LexerCurrent(ALexer);
WHILE Token.Kind <> lexerKindEof DO
while Token.Kind <> lexerKindEof do
WrittenBytes := WriteNBytes(StdOut, ADDRESS(ALexer^.Current - ALexer^.Start), ALexer^.Start);
WriteLn();
Token := TranspilerLex(ALexer)
END
end
END TranspileModule;
PROCEDURE TranspileTypeFields(AContext: PTranspilerContext; ALexer: PLexer);
VAR
proc TranspileTypeFields(AContext: PTranspilerContext; ALexer: PLexer);
var
Token: LexerToken;
WrittenBytes: CARDINAL;
BEGIN
begin
Token := TranspilerLex(ALexer);
WHILE Token.Kind <> lexerKindEnd DO
while Token.Kind <> lexerKindEnd do
WriteString(' ');
WrittenBytes := WriteNBytes(StdOut, ADDRESS(ALexer^.Current - ALexer^.Start), ALexer^.Start);
Token := TranspilerLex(ALexer);
@ -167,47 +174,46 @@ BEGIN
TranspileTypeExpression(AContext, ALexer);
Token := TranspilerLex(ALexer);
IF Token.Kind = lexerKindSemicolon THEN
if Token.Kind = lexerKindSemicolon then
Token := TranspilerLex(ALexer);
WriteSemicolon()
ELSE
WriteLn()
END
END
Write(';')
end;
WriteLn()
end
END TranspileTypeFields;
PROCEDURE TranspileRecordType(AContext: PTranspilerContext; ALexer: PLexer);
VAR
proc TranspileRecordType(AContext: PTranspilerContext; ALexer: PLexer);
var
Token: LexerToken;
BEGIN
begin
WriteString('RECORD');
WriteLn();
TranspileTypeFields(AContext, ALexer);
WriteString(' END')
END TranspileRecordType;
PROCEDURE TranspilePointerType(AContext: PTranspilerContext; ALexer: PLexer);
VAR
proc TranspilePointerType(AContext: PTranspilerContext; ALexer: PLexer);
var
Token: LexerToken;
WrittenBytes: CARDINAL;
BEGIN
begin
Token := LexerCurrent(ALexer);
WriteString('POINTER TO ');
IF Token.Kind = lexerKindPointer THEN
if Token.Kind = lexerKindPointer then
Token := TranspilerLex(ALexer)
END;
end;
TranspileTypeExpression(AContext, ALexer)
END TranspilePointerType;
PROCEDURE TranspileArrayType(AContext: PTranspilerContext; ALexer: PLexer);
VAR
proc TranspileArrayType(AContext: PTranspilerContext; ALexer: PLexer);
var
Token: LexerToken;
WrittenBytes: CARDINAL;
BEGIN
begin
WriteString('ARRAY');
Token := TranspilerLex(ALexer);
IF Token.Kind <> lexerKindOf THEN
if Token.Kind <> lexerKindOf then
Write('[');
Token := TranspilerLex(ALexer);
WrittenBytes := WriteNBytes(StdOut, ADDRESS(ALexer^.Current - ALexer^.Start), ALexer^.Start);
@ -218,16 +224,16 @@ BEGIN
Token := TranspilerLex(ALexer);
Write(']');
Token := TranspilerLex(ALexer)
END;
end;
WriteString(' OF ');
TranspileTypeExpression(AContext, ALexer)
END TranspileArrayType;
PROCEDURE TranspileEnumerationType(AContext: PTranspilerContext; ALexer: PLexer);
VAR
proc TranspileEnumerationType(AContext: PTranspilerContext; ALexer: PLexer);
var
Token: LexerToken;
WrittenBytes: CARDINAL;
BEGIN
begin
WriteString('(');
WriteLn();
WriteString(' ');
@ -237,7 +243,7 @@ BEGIN
Token := TranspilerLex(ALexer);
WHILE Token.Kind = lexerKindComma DO
while Token.Kind = lexerKindComma do
Write(',');
WriteLn();
WriteString(' ');
@ -245,64 +251,69 @@ BEGIN
WrittenBytes := WriteNBytes(StdOut, ADDRESS(ALexer^.Current - ALexer^.Start), ALexer^.Start);
Token := TranspilerLex(ALexer)
END;
end;
WriteLn();
WriteString(' )')
END TranspileEnumerationType;
PROCEDURE TranspileUnionType(AContext: PTranspilerContext; ALexer: PLexer);
VAR
proc TranspileUnionType(AContext: PTranspilerContext; ALexer: PLexer);
var
Token: LexerToken;
END TranspileUnionType;
PROCEDURE TranspileProcedureType(AContext: PTranspilerContext; ALexer: PLexer);
VAR
proc TranspileProcedureType(AContext: PTranspilerContext; ALexer: PLexer);
var
Token: LexerToken;
WrittenBytes: CARDINAL;
BEGIN
begin
Token := TranspilerLex(ALexer);
WriteString('PROCEDURE(');
Token := TranspilerLex(ALexer);
WHILE Token.Kind <> lexerKindRightParen DO
while Token.Kind <> lexerKindRightParen do
WrittenBytes := WriteNBytes(StdOut, ADDRESS(ALexer^.Current - ALexer^.Start), ALexer^.Start);
Token := TranspilerLex(ALexer);
IF Token.Kind = lexerKindComma THEN
if Token.Kind = lexerKindComma then
Token := TranspilerLex(ALexer);
WriteString(', ')
END
END;
end
end;
Write(')')
END TranspileProcedureType;
PROCEDURE TranspileTypeExpression(AContext: PTranspilerContext; ALexer: PLexer);
VAR
proc TranspileTypeExpression(AContext: PTranspilerContext; ALexer: PLexer);
var
Token: LexerToken;
WrittenBytes: CARDINAL;
BEGIN
begin
Token := TranspilerLex(ALexer);
IF Token.Kind = lexerKindRecord THEN
if Token.Kind = lexerKindRecord then
TranspileRecordType(AContext, ALexer)
ELSIF Token.Kind = lexerKindLeftParen THEN
end;
if Token.Kind = lexerKindLeftParen then
TranspileEnumerationType(AContext, ALexer)
ELSIF Token.Kind = lexerKindArray THEN
end;
if Token.Kind = lexerKindArray then
TranspileArrayType(AContext, ALexer)
ELSIF (Token.Kind = lexerKindPointer) OR (Token.Kind = lexerKindHat) THEN
end;
if (Token.Kind = lexerKindPointer) OR (Token.Kind = lexerKindHat) then
TranspilePointerType(AContext, ALexer)
ELSIF Token.Kind = lexerKindProc THEN
end;
if Token.Kind = lexerKindProc then
TranspileProcedureType(AContext, ALexer)
ELSE
end;
if Token.Kind = lexerKindIdentifier then
WrittenBytes := WriteNBytes(StdOut, ADDRESS(ALexer^.Current - ALexer^.Start), ALexer^.Start)
END
end
END TranspileTypeExpression;
PROCEDURE TranspileTypeDeclaration(AContext: PTranspilerContext; ALexer: PLexer);
VAR
proc TranspileTypeDeclaration(AContext: PTranspilerContext; ALexer: PLexer);
var
Token: LexerToken;
WrittenBytes: CARDINAL;
BEGIN
begin
WriteString(' ');
Token := LexerCurrent(ALexer);
WrittenBytes := WriteNBytes(StdOut, ADDRESS(ALexer^.Current - ALexer^.Start), ALexer^.Start);
@ -314,30 +325,30 @@ BEGIN
WriteSemicolon();
END TranspileTypeDeclaration;
PROCEDURE TranspileTypePart(AContext: PTranspilerContext; ALexer: PLexer);
VAR
proc TranspileTypePart(AContext: PTranspilerContext; ALexer: PLexer);
var
Token: LexerToken;
BEGIN
begin
Token := LexerCurrent(ALexer);
IF Token.Kind = lexerKindType THEN
if Token.Kind = lexerKindType then
WriteString('TYPE');
WriteLn();
Token := TranspilerLex(ALexer);
WHILE Token.Kind = lexerKindIdentifier DO
while Token.Kind = lexerKindIdentifier do
TranspileTypeDeclaration(AContext, ALexer);
Token := TranspilerLex(ALexer)
END;
end;
WriteLn()
END
end
END TranspileTypePart;
PROCEDURE TranspileVariableDeclaration(AContext: PTranspilerContext; ALexer: PLexer);
VAR
proc TranspileVariableDeclaration(AContext: PTranspilerContext; ALexer: PLexer);
var
Token: LexerToken;
WrittenBytes: CARDINAL;
BEGIN
begin
WriteString(' ');
Token := LexerCurrent(ALexer);
WrittenBytes := WriteNBytes(StdOut, ADDRESS(ALexer^.Current - ALexer^.Start), ALexer^.Start);
@ -349,30 +360,32 @@ BEGIN
WriteSemicolon()
END TranspileVariableDeclaration;
PROCEDURE TranspileVariablePart(AContext: PTranspilerContext; ALexer: PLexer);
VAR
proc TranspileVariablePart(AContext: PTranspilerContext; ALexer: PLexer): BOOLEAN;
var
Token: LexerToken;
BEGIN
Result: BOOLEAN;
begin
Token := LexerCurrent(ALexer);
Result := Token.Kind = lexerKindVar;
IF Token.Kind = lexerKindVar THEN
if Result then
WriteString('VAR');
WriteLn();
Token := TranspilerLex(ALexer);
WHILE Token.Kind = lexerKindIdentifier DO
while Token.Kind = lexerKindIdentifier do
TranspileVariableDeclaration(AContext, ALexer);
Token := TranspilerLex(ALexer)
END;
WriteLn()
END
end
end;
return Result
END TranspileVariablePart;
PROCEDURE TranspileProcedureDeclaration(AContext: PTranspilerContext; ALexer: PLexer);
VAR
proc TranspileProcedureHeading(AContext: PTranspilerContext; ALexer: PLexer);
var
Token: LexerToken;
WrittenBytes: CARDINAL;
BEGIN
begin
WriteString('PROCEDURE ');
Token := TranspilerLex(ALexer);
@ -382,52 +395,235 @@ BEGIN
Write('(');
Token := TranspilerLex(ALexer);
WHILE Token.Kind <> lexerKindRightParen DO
while Token.Kind <> lexerKindRightParen do
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);
TranspileTypeExpression(AContext, ALexer);
Token := TranspilerLex(ALexer);
IF Token.Kind = lexerKindSemicolon THEN
if Token.Kind = lexerKindSemicolon then
WriteString('; ');
Token := TranspilerLex(ALexer)
END
END;
end
end;
WriteString(')');
Token := TranspilerLex(ALexer);
(* Check for the return type and write it. *)
IF Token.Kind = lexerKindColon THEN
if Token.Kind = lexerKindColon then
WriteString(': ');
Token := TranspilerLex(ALexer);
WrittenBytes := WriteNBytes(StdOut, ADDRESS(ALexer^.Current - ALexer^.Start), ALexer^.Start);
Token := TranspilerLex(ALexer)
END;
end;
Token := TranspilerLex(ALexer);
WriteSemicolon()
END TranspileProcedureDeclaration;
END TranspileProcedureHeading;
PROCEDURE TranspileProcedurePart(AContext: PTranspilerContext; ALexer: PLexer);
VAR
proc TranspileIfStatement(AContext: PTranspilerContext; ALexer: PLexer);
var
Token: LexerToken;
BEGIN
WrittenBytes: CARDINAL;
begin
WriteString(' IF ');
Token := TranspilerLex(ALexer);
while Token.Kind <> lexerKindThen do
WrittenBytes := WriteNBytes(StdOut, ADDRESS(ALexer^.Current - ALexer^.Start), ALexer^.Start);
Write(' ');
Token := TranspilerLex(ALexer)
end;
WriteString('THEN');
WriteLn();
TranspileStatements(AContext, ALexer);
WriteString(' END');
Token := TranspilerLex(ALexer)
END TranspileIfStatement;
proc TranspileWhileStatement(AContext: PTranspilerContext; ALexer: PLexer);
var
Token: LexerToken;
WrittenBytes: CARDINAL;
begin
WriteString(' WHILE ');
Token := TranspilerLex(ALexer);
while Token.Kind <> lexerKindDo do
WrittenBytes := WriteNBytes(StdOut, ADDRESS(ALexer^.Current - ALexer^.Start), ALexer^.Start);
Write(' ');
Token := TranspilerLex(ALexer)
end;
WriteString('DO');
WriteLn();
TranspileStatements(AContext, ALexer);
WriteString(' END');
Token := TranspilerLex(ALexer)
END TranspileWhileStatement;
proc TranspileAssignmentStatement(AContext: PTranspilerContext; ALexer: PLexer);
var
Token: LexerToken;
WrittenBytes: CARDINAL;
begin
WriteString(' := ');
Token := TranspilerLex(ALexer);
while (Token.Kind <> lexerKindSemicolon) AND (Token.Kind <> lexerKindEnd) do
WrittenBytes := WriteNBytes(StdOut, ADDRESS(ALexer^.Current - ALexer^.Start), ALexer^.Start);
Write(' ');
Token := TranspilerLex(ALexer)
end
END TranspileAssignmentStatement;
proc TranspileCallStatement(AContext: PTranspilerContext; ALexer: PLexer);
var
Token: LexerToken;
WrittenBytes: CARDINAL;
begin
WriteString('(');
Token := TranspilerLex(ALexer);
while (Token.Kind <> lexerKindSemicolon) AND (Token.Kind <> lexerKindEnd) do
WrittenBytes := WriteNBytes(StdOut, ADDRESS(ALexer^.Current - ALexer^.Start), ALexer^.Start);
Token := TranspilerLex(ALexer)
end
END TranspileCallStatement;
proc TranspileReturnStatement(AContext: PTranspilerContext; ALexer: PLexer);
var
Token: LexerToken;
WrittenBytes: CARDINAL;
begin
WriteString(' RETURN ');
Token := TranspilerLex(ALexer);
WrittenBytes := WriteNBytes(StdOut, ADDRESS(ALexer^.Current - ALexer^.Start), ALexer^.Start);
Token := TranspilerLex(ALexer)
END TranspileReturnStatement;
proc TranspileStatement(AContext: PTranspilerContext; ALexer: PLexer);
var
Token: LexerToken;
WrittenBytes: CARDINAL;
begin
Token := TranspilerLex(ALexer);
if Token.Kind = lexerKindIf then
TranspileIfStatement(AContext, ALexer)
end;
if Token.Kind = lexerKindWhile then
TranspileWhileStatement(AContext, ALexer)
end;
if Token.Kind = lexerKindReturn then
TranspileReturnStatement(AContext, ALexer)
end;
if Token.Kind = lexerKindIdentifier then
WriteString(' ');
WrittenBytes := WriteNBytes(StdOut, ADDRESS(ALexer^.Current - ALexer^.Start), ALexer^.Start);
Token := TranspilerLex(ALexer);
while Token.Kind = lexerKindLeftSquare do
Write('[');
Token := TranspilerLex(ALexer);
while Token.Kind <> lexerKindRightSquare do
WrittenBytes := WriteNBytes(StdOut, ADDRESS(ALexer^.Current - ALexer^.Start), ALexer^.Start);
Token := TranspilerLex(ALexer)
end;
Write(']');
Token := TranspilerLex(ALexer);
end;
if Token.Kind = lexerKindHat then
Write('^');
Token := TranspilerLex(ALexer)
end;
if Token.Kind = lexerKindDot then
Write('.');
Token := TranspilerLex(ALexer);
WrittenBytes := WriteNBytes(StdOut, ADDRESS(ALexer^.Current - ALexer^.Start), ALexer^.Start);
Token := TranspilerLex(ALexer);
end;
if Token.Kind = lexerKindHat then
Write('^');
Token := TranspilerLex(ALexer)
end;
if Token.Kind = lexerKindAssignment then
TranspileAssignmentStatement(AContext, ALexer)
end;
if Token.Kind = lexerKindLeftParen then
TranspileCallStatement(AContext, ALexer)
end
end
END TranspileStatement;
proc TranspileStatements(AContext: PTranspilerContext; ALexer: PLexer);
var
Token: LexerToken;
begin
Token := LexerCurrent(ALexer);
IF Token.Kind = lexerKindProc THEN
TranspileProcedureDeclaration(AContext, ALexer)
END
while Token.Kind <> lexerKindEnd do
TranspileStatement(AContext, ALexer);
Token := LexerCurrent(ALexer);
if Token.Kind = lexerKindSemicolon then
Write(';')
end;
WriteLn()
end
END TranspileStatements;
proc TranspileStatementPart(AContext: PTranspilerContext; ALexer: PLexer);
var
Token: LexerToken;
begin
Token := LexerCurrent(ALexer);
if Token.Kind = lexerKindBegin then
WriteString('BEGIN');
WriteLn();
TranspileStatements(AContext, ALexer)
end
END TranspileStatementPart;
proc TranspileProcedureDeclaration(AContext: PTranspilerContext; ALexer: PLexer);
var
Token: LexerToken;
SeenPart: BOOLEAN;
WrittenBytes: CARDINAL;
begin
TranspileProcedureHeading(AContext, ALexer);
SeenPart := TranspileConstantPart(AContext, ALexer);
SeenPart := TranspileVariablePart(AContext, ALexer);
TranspileStatementPart(AContext, ALexer);
WriteString('END ');
Token := TranspilerLex(ALexer);
WrittenBytes := WriteNBytes(StdOut, ADDRESS(ALexer^.Current - ALexer^.Start), ALexer^.Start);
Token := TranspilerLex(ALexer);
WriteSemicolon();
Token := TranspilerLex(ALexer)
END TranspileProcedureDeclaration;
proc TranspileProcedurePart(AContext: PTranspilerContext; ALexer: PLexer);
var
Token: LexerToken;
begin
Token := LexerCurrent(ALexer);
while Token.Kind = lexerKindProc do
TranspileProcedureDeclaration(AContext, ALexer);
Token := LexerCurrent(ALexer);
WriteLn()
end
END TranspileProcedurePart;
PROCEDURE Transpile(ALexer: PLexer);
VAR
proc Transpile(ALexer: PLexer);
var
Token: LexerToken;
WrittenBytes: CARDINAL;
Context: TranspilerContext;
BEGIN
begin
TranspileModule(ADR(Context), ALexer)
END Transpile;