Transpile procedures and statements

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

View File

@ -100,13 +100,15 @@ task :backport do
source = File.read source_path source = File.read source_path
target = source target = source
.gsub(/^(var|type|const)/) { |match| match.upcase } .gsub(/^(var|type|const|begin)/) { |match| match.upcase }
.gsub(/^[[:alnum:]]* ?module/) { |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(/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(/^from ([[:alnum:]]+) import/, 'FROM \1 IMPORT')
.gsub(/ \^([[:alnum:]])/, ' POINTER TO \1') .gsub(/ \^([[:alnum:]])/, ' POINTER TO \1')
.gsub(/(then|do)$/) { |match| match.upcase }
target_path = Pathname.new('boot/stage1/source') + source_path.basename target_path = Pathname.new('boot/stage1/source') + source_path.basename
File.write target_path, target File.write target_path, target

View File

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

View File

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