diff --git a/Rakefile b/Rakefile index bbe15fb..82260a3 100644 --- a/Rakefile +++ b/Rakefile @@ -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 diff --git a/source/Lexer.elna b/source/Lexer.elna index 52fa345..cd4f99a 100644 --- a/source/Lexer.elna +++ b/source/Lexer.elna @@ -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; diff --git a/source/Transpiler.elna b/source/Transpiler.elna index 9ffd25a..080b790 100644 --- a/source/Transpiler.elna +++ b/source/Transpiler.elna @@ -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;