Phase 1 bootstrap: Blaise compiler skeleton
Renames the project from 'Clean Pascal' to Blaise (after Blaise Pascal). Adds the Phase 1 compiler pipeline with TDD test suite: - uPasTokeniser: general Pascal tokeniser (ported from fpGUI IDE) - uLexer: compiler-specific adapter — filters whitespace/comments, maps to TTokenKind, unescapes string literals - uAST: typed AST node hierarchy (TProgram, TBlock, TBinaryExpr, etc.) - uParser: recursive-descent parser for the Phase 1 BNF grammar - uCodeGenQBE: QBE IR emitter — WriteLn/Write built-ins, integer variables, arithmetic, string literals - Blaise.pas: compiler driver — parses flags, shells to qbe+cc - FPCUnit test suites for lexer, parser, and code generator
This commit is contained in:
Graeme Geldenhuys
parent
fd79a7db98
commit
3fce5f86de
12
README.adoc
12
README.adoc
|
|
@ -1,4 +1,4 @@
|
|||
= Clean Pascal Compiler
|
||||
= Blaise
|
||||
:toc: left
|
||||
:toclevels: 2
|
||||
:icons: font
|
||||
|
|
@ -138,23 +138,23 @@ pasbuild test
|
|||
|
||||
[source,shell]
|
||||
----
|
||||
pasbuild compile -m clean-pascal-compiler
|
||||
pasbuild compile -m blaise-compiler
|
||||
----
|
||||
|
||||
=== Running the compiler
|
||||
|
||||
Once built, the compiler binary is at `compiler/target/cleanpascal`.
|
||||
Once built, the compiler binary is at `compiler/target/blaise`.
|
||||
|
||||
[source,shell]
|
||||
----
|
||||
# Compile a single file
|
||||
compiler/target/cleanpascal --source Hello.pas --output Hello
|
||||
compiler/target/blaise --source Hello.pas --output Hello
|
||||
|
||||
# Compile via project.xml
|
||||
compiler/target/cleanpascal --project project.xml --config debug --output myapp
|
||||
compiler/target/blaise --project project.xml --config debug --output myapp
|
||||
|
||||
# Emit QBE IR (useful for debugging the compiler itself)
|
||||
compiler/target/cleanpascal --source Hello.pas --emit-ir
|
||||
compiler/target/blaise --source Hello.pas --emit-ir
|
||||
----
|
||||
|
||||
== What Is Dropped From Classic Pascal
|
||||
|
|
|
|||
|
|
@ -1,12 +1,12 @@
|
|||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<project>
|
||||
<name>clean-pascal-compiler</name>
|
||||
<name>blaise-compiler</name>
|
||||
<!-- version inherited from root aggregator -->
|
||||
|
||||
<build>
|
||||
<packaging>application</packaging>
|
||||
<mainSource>CleanPascal.pas</mainSource>
|
||||
<executableName>cleanpascal</executableName>
|
||||
<mainSource>Blaise.pas</mainSource>
|
||||
<executableName>blaise</executableName>
|
||||
</build>
|
||||
|
||||
<test>
|
||||
|
|
|
|||
248
compiler/src/main/pascal/Blaise.pas
Normal file
248
compiler/src/main/pascal/Blaise.pas
Normal file
|
|
@ -0,0 +1,248 @@
|
|||
program Blaise;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
{ Blaise Compiler — main entry point.
|
||||
|
||||
Usage:
|
||||
cleanpascal --source Hello.pas --output hello
|
||||
cleanpascal --source Hello.pas --emit-ir
|
||||
cleanpascal --source Hello.pas --output hello --target linux-x86_64
|
||||
|
||||
The compiler generates QBE IR, then shells out to qbe + cc to produce
|
||||
the final binary. With --emit-ir, the IR is written to stdout and no
|
||||
binary is produced.
|
||||
}
|
||||
|
||||
uses
|
||||
SysUtils, Classes, Process,
|
||||
uLexer, uParser, uCodeGenQBE;
|
||||
|
||||
const
|
||||
Version = '0.1.0-alpha';
|
||||
CompilerName = 'Blaise';
|
||||
|
||||
procedure PrintUsage;
|
||||
begin
|
||||
WriteLn('Blaise Compiler v', Version);
|
||||
WriteLn('');
|
||||
WriteLn('Usage:');
|
||||
WriteLn(' cleanpascal --source <file.pas> --output <binary>');
|
||||
WriteLn(' cleanpascal --source <file.pas> --emit-ir');
|
||||
WriteLn('');
|
||||
WriteLn('Flags:');
|
||||
WriteLn(' --source <path> Pascal source file');
|
||||
WriteLn(' --output <path> Output binary path');
|
||||
WriteLn(' --target <id> linux-x86_64 (default), macos-arm64');
|
||||
WriteLn(' --emit-ir Print QBE IR to stdout and exit');
|
||||
end;
|
||||
|
||||
function ParseArgs(
|
||||
out SourceFile: string;
|
||||
out OutputFile: string;
|
||||
out EmitIR: Boolean): Boolean;
|
||||
var
|
||||
I: Integer;
|
||||
Arg: string;
|
||||
begin
|
||||
Result := False;
|
||||
SourceFile := '';
|
||||
OutputFile := '';
|
||||
EmitIR := False;
|
||||
|
||||
I := 1;
|
||||
while I <= ParamCount do
|
||||
begin
|
||||
Arg := ParamStr(I);
|
||||
if (Arg = '--source') and (I < ParamCount) then
|
||||
begin
|
||||
Inc(I);
|
||||
SourceFile := ParamStr(I);
|
||||
end
|
||||
else if (Arg = '--output') and (I < ParamCount) then
|
||||
begin
|
||||
Inc(I);
|
||||
OutputFile := ParamStr(I);
|
||||
end
|
||||
else if Arg = '--emit-ir' then
|
||||
EmitIR := True
|
||||
else if Arg = '--target' then
|
||||
Inc(I) { consume next arg — target is not used in Phase 1 }
|
||||
else if (Arg = '--help') or (Arg = '-h') then
|
||||
begin
|
||||
PrintUsage;
|
||||
Halt(0);
|
||||
end
|
||||
else
|
||||
begin
|
||||
WriteLn(StdErr, 'Unknown flag: ', Arg);
|
||||
Exit;
|
||||
end;
|
||||
Inc(I);
|
||||
end;
|
||||
|
||||
if SourceFile = '' then
|
||||
begin
|
||||
WriteLn(StdErr, 'Error: --source is required');
|
||||
Exit;
|
||||
end;
|
||||
if (not EmitIR) and (OutputFile = '') then
|
||||
begin
|
||||
WriteLn(StdErr, 'Error: --output is required (or use --emit-ir)');
|
||||
Exit;
|
||||
end;
|
||||
|
||||
Result := True;
|
||||
end;
|
||||
|
||||
function RunProcess(const AExe: string; const AArgs: array of string;
|
||||
out AOutput: string): Integer;
|
||||
var
|
||||
Proc: TProcess;
|
||||
Lines: TStringList;
|
||||
I: Integer;
|
||||
begin
|
||||
Proc := TProcess.Create(nil);
|
||||
try
|
||||
Proc.Executable := AExe;
|
||||
for I := Low(AArgs) to High(AArgs) do
|
||||
Proc.Parameters.Add(AArgs[I]);
|
||||
Proc.Options := [poWaitOnExit, poUsePipes];
|
||||
Proc.Execute;
|
||||
Lines := TStringList.Create;
|
||||
try
|
||||
Lines.LoadFromStream(Proc.Stderr);
|
||||
AOutput := Lines.Text;
|
||||
finally
|
||||
Lines.Free;
|
||||
end;
|
||||
Result := Proc.ExitCode;
|
||||
finally
|
||||
Proc.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure CompileToNative(const AIRFile, AOutputFile: string);
|
||||
var
|
||||
AsmFile: string;
|
||||
Msg: string;
|
||||
ExitCode: Integer;
|
||||
begin
|
||||
AsmFile := ChangeFileExt(AIRFile, '.s');
|
||||
|
||||
ExitCode := RunProcess('qbe', ['-o', AsmFile, AIRFile], Msg);
|
||||
if ExitCode <> 0 then
|
||||
begin
|
||||
WriteLn(StdErr, 'qbe error (exit ', ExitCode, '):');
|
||||
Write(StdErr, Msg);
|
||||
Halt(1);
|
||||
end;
|
||||
|
||||
ExitCode := RunProcess('cc', ['-o', AOutputFile, AsmFile], Msg);
|
||||
if ExitCode <> 0 then
|
||||
begin
|
||||
WriteLn(StdErr, 'cc error (exit ', ExitCode, '):');
|
||||
Write(StdErr, Msg);
|
||||
Halt(1);
|
||||
end;
|
||||
|
||||
DeleteFile(AsmFile);
|
||||
end;
|
||||
|
||||
var
|
||||
SourceFile, OutputFile: string;
|
||||
EmitIR: Boolean;
|
||||
Source: TStringList;
|
||||
Lexer: TLexer;
|
||||
Parser: TParser;
|
||||
Prog: TProgram;
|
||||
CG: TCodeGenQBE;
|
||||
IR: string;
|
||||
IRFile: string;
|
||||
|
||||
begin
|
||||
if not ParseArgs(SourceFile, OutputFile, EmitIR) then
|
||||
begin
|
||||
PrintUsage;
|
||||
Halt(1);
|
||||
end;
|
||||
|
||||
if not FileExists(SourceFile) then
|
||||
begin
|
||||
WriteLn(StdErr, 'Error: source file not found: ', SourceFile);
|
||||
Halt(1);
|
||||
end;
|
||||
|
||||
Source := TStringList.Create;
|
||||
try
|
||||
Source.LoadFromFile(SourceFile);
|
||||
except
|
||||
on E: Exception do
|
||||
begin
|
||||
WriteLn(StdErr, 'Error reading source: ', E.Message);
|
||||
Halt(1);
|
||||
end;
|
||||
end;
|
||||
|
||||
Lexer := nil;
|
||||
Parser := nil;
|
||||
Prog := nil;
|
||||
CG := nil;
|
||||
try
|
||||
try
|
||||
Lexer := TLexer.Create(Source.Text);
|
||||
Parser := TParser.Create(Lexer);
|
||||
Prog := Parser.Parse;
|
||||
except
|
||||
on E: Exception do
|
||||
begin
|
||||
WriteLn(StdErr, 'Parse error: ', E.Message);
|
||||
Halt(1);
|
||||
end;
|
||||
end;
|
||||
|
||||
try
|
||||
CG := TCodeGenQBE.Create;
|
||||
CG.Generate(Prog);
|
||||
IR := CG.GetOutput;
|
||||
except
|
||||
on E: Exception do
|
||||
begin
|
||||
WriteLn(StdErr, 'Code generation error: ', E.Message);
|
||||
Halt(1);
|
||||
end;
|
||||
end;
|
||||
finally
|
||||
CG.Free;
|
||||
Prog.Free;
|
||||
Parser.Free;
|
||||
Lexer.Free;
|
||||
Source.Free;
|
||||
end;
|
||||
|
||||
if EmitIR then
|
||||
begin
|
||||
Write(IR);
|
||||
Halt(0);
|
||||
end;
|
||||
|
||||
IRFile := ChangeFileExt(OutputFile, '.ssa');
|
||||
try
|
||||
Source := TStringList.Create;
|
||||
try
|
||||
Source.Text := IR;
|
||||
Source.SaveToFile(IRFile);
|
||||
finally
|
||||
Source.Free;
|
||||
end;
|
||||
except
|
||||
on E: Exception do
|
||||
begin
|
||||
WriteLn(StdErr, 'Error writing IR: ', E.Message);
|
||||
Halt(1);
|
||||
end;
|
||||
end;
|
||||
|
||||
CompileToNative(IRFile, OutputFile);
|
||||
DeleteFile(IRFile);
|
||||
end.
|
||||
181
compiler/src/main/pascal/uAST.pas
Normal file
181
compiler/src/main/pascal/uAST.pas
Normal file
|
|
@ -0,0 +1,181 @@
|
|||
unit uAST;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, contnrs;
|
||||
|
||||
type
|
||||
{ Base node — all AST nodes carry source position. }
|
||||
TASTNode = class
|
||||
public
|
||||
Line: Integer;
|
||||
Col: Integer;
|
||||
end;
|
||||
|
||||
{ ------------------------------------------------------------------ }
|
||||
{ Expressions }
|
||||
{ ------------------------------------------------------------------ }
|
||||
|
||||
TASTExpr = class(TASTNode);
|
||||
|
||||
TIntLiteral = class(TASTExpr)
|
||||
public
|
||||
Value: Int64;
|
||||
end;
|
||||
|
||||
TStringLiteral = class(TASTExpr)
|
||||
public
|
||||
Value: string;
|
||||
end;
|
||||
|
||||
TIdentExpr = class(TASTExpr)
|
||||
public
|
||||
Name: string;
|
||||
end;
|
||||
|
||||
TBinaryOp = (boAdd, boSub, boMul, boDiv);
|
||||
|
||||
TBinaryExpr = class(TASTExpr)
|
||||
public
|
||||
Op: TBinaryOp;
|
||||
Left: TASTExpr; { owned }
|
||||
Right: TASTExpr; { owned }
|
||||
destructor Destroy; override;
|
||||
end;
|
||||
|
||||
{ ------------------------------------------------------------------ }
|
||||
{ Statements }
|
||||
{ ------------------------------------------------------------------ }
|
||||
|
||||
TASTStmt = class(TASTNode);
|
||||
|
||||
TAssignment = class(TASTStmt)
|
||||
public
|
||||
Name: string;
|
||||
Expr: TASTExpr; { owned }
|
||||
destructor Destroy; override;
|
||||
end;
|
||||
|
||||
TProcCall = class(TASTStmt)
|
||||
public
|
||||
Name: string;
|
||||
Args: TObjectList; { owned TASTExpr items }
|
||||
constructor Create;
|
||||
destructor Destroy; override;
|
||||
end;
|
||||
|
||||
{ ------------------------------------------------------------------ }
|
||||
{ Declarations }
|
||||
{ ------------------------------------------------------------------ }
|
||||
|
||||
TVarDecl = class(TASTNode)
|
||||
public
|
||||
Names: TStringList; { owned — one or more names: x, y: Integer }
|
||||
TypeName: string;
|
||||
constructor Create;
|
||||
destructor Destroy; override;
|
||||
end;
|
||||
|
||||
{ ------------------------------------------------------------------ }
|
||||
{ Block and Program }
|
||||
{ ------------------------------------------------------------------ }
|
||||
|
||||
TBlock = class(TASTNode)
|
||||
public
|
||||
Decls: TObjectList; { owned TVarDecl }
|
||||
Stmts: TObjectList; { owned TASTStmt }
|
||||
constructor Create;
|
||||
destructor Destroy; override;
|
||||
end;
|
||||
|
||||
TProgram = class(TASTNode)
|
||||
public
|
||||
Name: string;
|
||||
Uses: TStringList; { owned — unit names from uses clause }
|
||||
Block: TBlock; { owned }
|
||||
constructor Create;
|
||||
destructor Destroy; override;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
{ TBinaryExpr }
|
||||
|
||||
destructor TBinaryExpr.Destroy;
|
||||
begin
|
||||
Left.Free;
|
||||
Right.Free;
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
{ TAssignment }
|
||||
|
||||
destructor TAssignment.Destroy;
|
||||
begin
|
||||
Expr.Free;
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
{ TProcCall }
|
||||
|
||||
constructor TProcCall.Create;
|
||||
begin
|
||||
inherited Create;
|
||||
Args := TObjectList.Create(True);
|
||||
end;
|
||||
|
||||
destructor TProcCall.Destroy;
|
||||
begin
|
||||
Args.Free;
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
{ TVarDecl }
|
||||
|
||||
constructor TVarDecl.Create;
|
||||
begin
|
||||
inherited Create;
|
||||
Names := TStringList.Create;
|
||||
end;
|
||||
|
||||
destructor TVarDecl.Destroy;
|
||||
begin
|
||||
Names.Free;
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
{ TBlock }
|
||||
|
||||
constructor TBlock.Create;
|
||||
begin
|
||||
inherited Create;
|
||||
Decls := TObjectList.Create(True);
|
||||
Stmts := TObjectList.Create(True);
|
||||
end;
|
||||
|
||||
destructor TBlock.Destroy;
|
||||
begin
|
||||
Decls.Free;
|
||||
Stmts.Free;
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
{ TProgram }
|
||||
|
||||
constructor TProgram.Create;
|
||||
begin
|
||||
inherited Create;
|
||||
Uses := TStringList.Create;
|
||||
end;
|
||||
|
||||
destructor TProgram.Destroy;
|
||||
begin
|
||||
Uses.Free;
|
||||
Block.Free;
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
end.
|
||||
356
compiler/src/main/pascal/uCodeGenQBE.pas
Normal file
356
compiler/src/main/pascal/uCodeGenQBE.pas
Normal file
|
|
@ -0,0 +1,356 @@
|
|||
unit uCodeGenQBE;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
{ Phase 1 QBE IR emitter.
|
||||
String layout: Phase 1 uses raw NUL-terminated bytes (no ARC header).
|
||||
The full refcount+length+capacity header is introduced in Phase 2.
|
||||
WriteLn/Write are built-ins resolved directly to libc printf calls. }
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
SysUtils, StrUtils, Classes, uAST;
|
||||
|
||||
type
|
||||
ECodeGenError = class(Exception);
|
||||
|
||||
TCodeGenQBE = class
|
||||
private
|
||||
FOutput: TStringList;
|
||||
FStrLits: TStringList; { index → raw value; label = $__s<index> }
|
||||
FTempCount: Integer;
|
||||
FVarTypes: TStringList; { name → type ('w'=integer, 'l'=string ptr) }
|
||||
|
||||
function AllocTemp: string;
|
||||
function EmitStrLit(const AValue: string): string;
|
||||
procedure EmitLine(const ALine: string);
|
||||
procedure EmitDataSection;
|
||||
procedure EmitMainHeader;
|
||||
procedure EmitMainFooter;
|
||||
procedure EmitBlock(ABlock: TBlock);
|
||||
procedure EmitVarAllocs(ABlock: TBlock);
|
||||
procedure EmitStmt(AStmt: TASTStmt);
|
||||
procedure EmitAssignment(AAssign: TAssignment);
|
||||
procedure EmitProcCall(ACall: TProcCall);
|
||||
procedure EmitWriteLn(ACall: TProcCall);
|
||||
procedure EmitWrite(ACall: TProcCall; ANewline: Boolean);
|
||||
function EmitExpr(AExpr: TASTExpr): string;
|
||||
function QbeTypeForVar(const AName: string): string;
|
||||
function QbeEscapeString(const AStr: string): string;
|
||||
public
|
||||
constructor Create;
|
||||
destructor Destroy; override;
|
||||
procedure Generate(AProg: TProgram);
|
||||
function GetOutput: string;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
constructor TCodeGenQBE.Create;
|
||||
begin
|
||||
inherited Create;
|
||||
FOutput := TStringList.Create;
|
||||
FStrLits := TStringList.Create;
|
||||
FVarTypes := TStringList.Create;
|
||||
FTempCount := 0;
|
||||
end;
|
||||
|
||||
destructor TCodeGenQBE.Destroy;
|
||||
begin
|
||||
FOutput.Free;
|
||||
FStrLits.Free;
|
||||
FVarTypes.Free;
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
function TCodeGenQBE.AllocTemp: string;
|
||||
begin
|
||||
Result := Format('%%_t%d', [FTempCount]);
|
||||
Inc(FTempCount);
|
||||
end;
|
||||
|
||||
function TCodeGenQBE.EmitStrLit(const AValue: string): string;
|
||||
{ Returns the global label for this string literal, e.g. $__s0 }
|
||||
var
|
||||
Idx: Integer;
|
||||
begin
|
||||
Idx := FStrLits.IndexOf(AValue);
|
||||
if Idx < 0 then
|
||||
Idx := FStrLits.Add(AValue);
|
||||
Result := Format('$__s%d', [Idx]);
|
||||
end;
|
||||
|
||||
procedure TCodeGenQBE.EmitLine(const ALine: string);
|
||||
begin
|
||||
FOutput.Add(ALine);
|
||||
end;
|
||||
|
||||
procedure TCodeGenQBE.EmitDataSection;
|
||||
var
|
||||
I: Integer;
|
||||
begin
|
||||
if FStrLits.Count = 0 then
|
||||
Exit;
|
||||
EmitLine('# String literals');
|
||||
for I := 0 to FStrLits.Count - 1 do
|
||||
EmitLine(Format('data $__s%d = { b "%s", b 0 }',
|
||||
[I, QbeEscapeString(FStrLits[I])]));
|
||||
EmitLine('data $__fmt_s_nl = { b "%s\n", b 0 }');
|
||||
EmitLine('data $__fmt_s = { b "%s", b 0 }');
|
||||
EmitLine('data $__fmt_d_nl = { b "%d\n", b 0 }');
|
||||
EmitLine('data $__fmt_d = { b "%d", b 0 }');
|
||||
EmitLine('data $__fmt_nl = { b "\n", b 0 }');
|
||||
EmitLine('');
|
||||
end;
|
||||
|
||||
procedure TCodeGenQBE.EmitMainHeader;
|
||||
begin
|
||||
EmitLine('export function w $main() {');
|
||||
EmitLine('@start');
|
||||
end;
|
||||
|
||||
procedure TCodeGenQBE.EmitMainFooter;
|
||||
begin
|
||||
EmitLine(' ret 0');
|
||||
EmitLine('}');
|
||||
end;
|
||||
|
||||
procedure TCodeGenQBE.EmitVarAllocs(ABlock: TBlock);
|
||||
var
|
||||
I, J: Integer;
|
||||
Decl: TVarDecl;
|
||||
VarName, Alloc: string;
|
||||
begin
|
||||
for I := 0 to ABlock.Decls.Count - 1 do
|
||||
begin
|
||||
Decl := TVarDecl(ABlock.Decls[I]);
|
||||
for J := 0 to Decl.Names.Count - 1 do
|
||||
begin
|
||||
VarName := Decl.Names[J];
|
||||
if SameText(Decl.TypeName, 'Integer') or
|
||||
SameText(Decl.TypeName, 'Boolean') then
|
||||
begin
|
||||
Alloc := Format(' %%_var_%s =l alloc4 1', [VarName]);
|
||||
FVarTypes.Values[VarName] := 'w';
|
||||
end
|
||||
else if SameText(Decl.TypeName, 'string') then
|
||||
begin
|
||||
Alloc := Format(' %%_var_%s =l alloc8 1', [VarName]);
|
||||
FVarTypes.Values[VarName] := 'l';
|
||||
{ Initialise string pointer to nil (0) }
|
||||
EmitLine(Alloc);
|
||||
EmitLine(Format(' storel 0, %%_var_%s', [VarName]));
|
||||
Continue;
|
||||
end
|
||||
else
|
||||
raise ECodeGenError.CreateFmt(
|
||||
'Unknown type ''%s'' for variable ''%s''', [Decl.TypeName, VarName]);
|
||||
EmitLine(Alloc);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TCodeGenQBE.EmitBlock(ABlock: TBlock);
|
||||
var
|
||||
I: Integer;
|
||||
begin
|
||||
EmitVarAllocs(ABlock);
|
||||
for I := 0 to ABlock.Stmts.Count - 1 do
|
||||
EmitStmt(TASTStmt(ABlock.Stmts[I]));
|
||||
end;
|
||||
|
||||
procedure TCodeGenQBE.EmitStmt(AStmt: TASTStmt);
|
||||
begin
|
||||
if AStmt is TAssignment then
|
||||
EmitAssignment(TAssignment(AStmt))
|
||||
else if AStmt is TProcCall then
|
||||
EmitProcCall(TProcCall(AStmt))
|
||||
else
|
||||
raise ECodeGenError.Create('Unknown statement node type');
|
||||
end;
|
||||
|
||||
procedure TCodeGenQBE.EmitAssignment(AAssign: TAssignment);
|
||||
var
|
||||
ValTemp, QType, StoreInstr: string;
|
||||
begin
|
||||
QType := QbeTypeForVar(AAssign.Name);
|
||||
ValTemp := EmitExpr(AAssign.Expr);
|
||||
if QType = 'w' then
|
||||
StoreInstr := 'storew'
|
||||
else
|
||||
StoreInstr := 'storel';
|
||||
EmitLine(Format(' %s %s, %%_var_%s', [StoreInstr, ValTemp, AAssign.Name]));
|
||||
end;
|
||||
|
||||
procedure TCodeGenQBE.EmitProcCall(ACall: TProcCall);
|
||||
var
|
||||
UCaseName: string;
|
||||
begin
|
||||
UCaseName := UpperCase(ACall.Name);
|
||||
if (UCaseName = 'WRITELN') then
|
||||
EmitWriteLn(ACall)
|
||||
else if UCaseName = 'WRITE' then
|
||||
EmitWrite(ACall, False)
|
||||
else
|
||||
raise ECodeGenError.CreateFmt(
|
||||
'Unknown procedure ''%s'' at line %d', [ACall.Name, ACall.Line]);
|
||||
end;
|
||||
|
||||
procedure TCodeGenQBE.EmitWriteLn(ACall: TProcCall);
|
||||
begin
|
||||
EmitWrite(ACall, True);
|
||||
end;
|
||||
|
||||
procedure TCodeGenQBE.EmitWrite(ACall: TProcCall; ANewline: Boolean);
|
||||
var
|
||||
ArgExpr: TASTExpr;
|
||||
ArgTemp: string;
|
||||
FmtLabel: string;
|
||||
IsString: Boolean;
|
||||
begin
|
||||
if ACall.Args.Count = 0 then
|
||||
begin
|
||||
if ANewline then
|
||||
EmitLine(' call $printf(l $__fmt_nl)');
|
||||
Exit;
|
||||
end;
|
||||
|
||||
if ACall.Args.Count > 1 then
|
||||
raise ECodeGenError.CreateFmt(
|
||||
'Phase 1: Write/WriteLn takes at most 1 argument (line %d)', [ACall.Line]);
|
||||
|
||||
ArgExpr := TASTExpr(ACall.Args[0]);
|
||||
IsString := (ArgExpr is TStringLiteral) or
|
||||
((ArgExpr is TIdentExpr) and
|
||||
(QbeTypeForVar(TIdentExpr(ArgExpr).Name) = 'l'));
|
||||
|
||||
ArgTemp := EmitExpr(ArgExpr);
|
||||
|
||||
if IsString then
|
||||
FmtLabel := IfThen(ANewline, '$__fmt_s_nl', '$__fmt_s')
|
||||
else
|
||||
FmtLabel := IfThen(ANewline, '$__fmt_d_nl', '$__fmt_d');
|
||||
|
||||
if IsString then
|
||||
EmitLine(Format(' call $printf(l %s, ..., l %s)', [FmtLabel, ArgTemp]))
|
||||
else
|
||||
EmitLine(Format(' call $printf(l %s, ..., w %s)', [FmtLabel, ArgTemp]));
|
||||
end;
|
||||
|
||||
function TCodeGenQBE.EmitExpr(AExpr: TASTExpr): string;
|
||||
var
|
||||
T, L, R: string;
|
||||
Op: string;
|
||||
BinExpr: TBinaryExpr;
|
||||
QType: string;
|
||||
begin
|
||||
if AExpr is TIntLiteral then
|
||||
begin
|
||||
T := AllocTemp;
|
||||
EmitLine(Format(' %s =w copy %d', [T, TIntLiteral(AExpr).Value]));
|
||||
Result := T;
|
||||
end
|
||||
else if AExpr is TStringLiteral then
|
||||
begin
|
||||
Result := EmitStrLit(TStringLiteral(AExpr).Value);
|
||||
end
|
||||
else if AExpr is TIdentExpr then
|
||||
begin
|
||||
T := AllocTemp;
|
||||
QType := QbeTypeForVar(TIdentExpr(AExpr).Name);
|
||||
if QType = 'w' then
|
||||
EmitLine(Format(' %s =w loadw %%_var_%s', [T, TIdentExpr(AExpr).Name]))
|
||||
else
|
||||
EmitLine(Format(' %s =l loadl %%_var_%s', [T, TIdentExpr(AExpr).Name]));
|
||||
Result := T;
|
||||
end
|
||||
else if AExpr is TBinaryExpr then
|
||||
begin
|
||||
BinExpr := TBinaryExpr(AExpr);
|
||||
L := EmitExpr(BinExpr.Left);
|
||||
R := EmitExpr(BinExpr.Right);
|
||||
T := AllocTemp;
|
||||
case BinExpr.Op of
|
||||
boAdd: Op := 'add';
|
||||
boSub: Op := 'sub';
|
||||
boMul: Op := 'mul';
|
||||
boDiv: Op := 'div';
|
||||
end;
|
||||
EmitLine(Format(' %s =w %s %s, %s', [T, Op, L, R]));
|
||||
Result := T;
|
||||
end
|
||||
else
|
||||
raise ECodeGenError.Create('Unknown expression node type');
|
||||
end;
|
||||
|
||||
function TCodeGenQBE.QbeTypeForVar(const AName: string): string;
|
||||
begin
|
||||
Result := FVarTypes.Values[AName];
|
||||
if Result = '' then
|
||||
Result := 'w'; { default to integer if unknown (e.g. undeclared) }
|
||||
end;
|
||||
|
||||
function TCodeGenQBE.QbeEscapeString(const AStr: string): string;
|
||||
var
|
||||
I: Integer;
|
||||
C: Char;
|
||||
begin
|
||||
Result := '';
|
||||
for I := 1 to Length(AStr) do
|
||||
begin
|
||||
C := AStr[I];
|
||||
case C of
|
||||
'"': Result := Result + '\"';
|
||||
'\': Result := Result + '\\';
|
||||
#10: Result := Result + '\n';
|
||||
#13: Result := Result + '\r';
|
||||
#9: Result := Result + '\t';
|
||||
else if (Ord(C) < 32) or (Ord(C) > 126) then
|
||||
Result := Result + Format('\%02x', [Ord(C)])
|
||||
else
|
||||
Result := Result + C;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TCodeGenQBE.Generate(AProg: TProgram);
|
||||
var
|
||||
Body: TStringList;
|
||||
SavedOutput: TStringList;
|
||||
begin
|
||||
FOutput.Clear;
|
||||
FStrLits.Clear;
|
||||
FVarTypes.Clear;
|
||||
FTempCount := 0;
|
||||
|
||||
{ Two-pass emit: collect string literals by emitting the body first,
|
||||
then prepend the data section. }
|
||||
Body := TStringList.Create;
|
||||
try
|
||||
SavedOutput := FOutput;
|
||||
FOutput := Body;
|
||||
try
|
||||
EmitMainHeader;
|
||||
EmitBlock(AProg.Block);
|
||||
EmitMainFooter;
|
||||
finally
|
||||
FOutput := SavedOutput;
|
||||
end;
|
||||
|
||||
EmitLine('# Generated by Blaise Compiler (Phase 1)');
|
||||
EmitLine('# Source: ' + AProg.Name);
|
||||
EmitLine('');
|
||||
EmitDataSection;
|
||||
FOutput.AddStrings(Body);
|
||||
finally
|
||||
Body.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TCodeGenQBE.GetOutput: string;
|
||||
begin
|
||||
Result := FOutput.Text;
|
||||
end;
|
||||
|
||||
end.
|
||||
195
compiler/src/main/pascal/uLexer.pas
Normal file
195
compiler/src/main/pascal/uLexer.pas
Normal file
|
|
@ -0,0 +1,195 @@
|
|||
unit uLexer;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
{ Compiler lexer — wraps uPasTokeniser and converts its flat token stream
|
||||
into the compiler's specific token kinds. Skips whitespace, line endings,
|
||||
comments, and compiler directives. Unescapes string literal values. }
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
SysUtils, uPasTokeniser;
|
||||
|
||||
type
|
||||
TTokenKind = (
|
||||
tkEOF,
|
||||
{ Literals }
|
||||
tkIntLit,
|
||||
tkStringLit,
|
||||
{ Keywords }
|
||||
tkProgram,
|
||||
tkUses,
|
||||
tkVar,
|
||||
tkBegin,
|
||||
tkEnd,
|
||||
{ Identifier }
|
||||
tkIdent,
|
||||
{ Arithmetic operators }
|
||||
tkPlus,
|
||||
tkMinus,
|
||||
tkStar,
|
||||
tkSlash,
|
||||
{ Assignment and colon }
|
||||
tkAssign, { := }
|
||||
tkColon, { : }
|
||||
{ Grouping and punctuation }
|
||||
tkLParen,
|
||||
tkRParen,
|
||||
tkComma,
|
||||
tkSemicolon,
|
||||
tkDot
|
||||
);
|
||||
|
||||
TToken = record
|
||||
Kind: TTokenKind;
|
||||
Value: string; { parsed value: ident text, int digits, unescaped string }
|
||||
Line: Integer;
|
||||
Col: Integer;
|
||||
end;
|
||||
|
||||
TLexer = class
|
||||
private
|
||||
FTok: TFpgPascalTokeniser;
|
||||
function MapKeyword(const AUpper: string): TTokenKind;
|
||||
function UnescapeString(const ARaw: string): string;
|
||||
public
|
||||
constructor Create(const ASource: string);
|
||||
destructor Destroy; override;
|
||||
function Next: TToken;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
constructor TLexer.Create(const ASource: string);
|
||||
begin
|
||||
inherited Create;
|
||||
FTok := TFpgPascalTokeniser.Create;
|
||||
FTok.SetSource(ASource);
|
||||
end;
|
||||
|
||||
destructor TLexer.Destroy;
|
||||
begin
|
||||
FTok.Free;
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
function TLexer.MapKeyword(const AUpper: string): TTokenKind;
|
||||
begin
|
||||
if AUpper = 'PROGRAM' then Result := tkProgram
|
||||
else if AUpper = 'USES' then Result := tkUses
|
||||
else if AUpper = 'VAR' then Result := tkVar
|
||||
else if AUpper = 'BEGIN' then Result := tkBegin
|
||||
else if AUpper = 'END' then Result := tkEnd
|
||||
else
|
||||
Result := tkIdent; { keyword outside Phase 1 grammar treated as ident }
|
||||
end;
|
||||
|
||||
function TLexer.UnescapeString(const ARaw: string): string;
|
||||
{ ARaw is the full source span including surrounding quotes.
|
||||
Handles: 'text' with '' → ' escaping.
|
||||
Phase 1 supports only single-quoted string literals; #nn and ^X forms
|
||||
are not yet part of the Clean Pascal spec. }
|
||||
var
|
||||
I, Len: Integer;
|
||||
begin
|
||||
Result := '';
|
||||
Len := Length(ARaw);
|
||||
if (Len >= 2) and (ARaw[1] = '''') then
|
||||
begin
|
||||
I := 2;
|
||||
while I <= Len do
|
||||
begin
|
||||
if ARaw[I] = '''' then
|
||||
begin
|
||||
if (I < Len) and (ARaw[I + 1] = '''') then
|
||||
begin
|
||||
Result := Result + '''';
|
||||
Inc(I, 2);
|
||||
end
|
||||
else
|
||||
Inc(I); { closing quote }
|
||||
end
|
||||
else
|
||||
begin
|
||||
Result := Result + ARaw[I];
|
||||
Inc(I);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TLexer.Next: TToken;
|
||||
var
|
||||
raw: TFpgPasToken;
|
||||
text: string;
|
||||
begin
|
||||
repeat
|
||||
raw := FTok.NextToken;
|
||||
until not (raw.Kind in [fptkWhitespace, fptkLineEnding,
|
||||
fptkComment, fptkDirective]);
|
||||
|
||||
Result.Line := raw.Line;
|
||||
Result.Col := raw.Column;
|
||||
|
||||
case raw.Kind of
|
||||
fptkEOF:
|
||||
begin
|
||||
Result.Kind := tkEOF;
|
||||
Result.Value := '';
|
||||
end;
|
||||
|
||||
fptkKeyword:
|
||||
begin
|
||||
text := FTok.TokenTextUpper;
|
||||
Result.Kind := MapKeyword(text);
|
||||
Result.Value := FTok.TokenText;
|
||||
end;
|
||||
|
||||
fptkIdentifier:
|
||||
begin
|
||||
Result.Kind := tkIdent;
|
||||
Result.Value := FTok.TokenText;
|
||||
end;
|
||||
|
||||
fptkNumber:
|
||||
begin
|
||||
Result.Kind := tkIntLit;
|
||||
Result.Value := FTok.TokenText;
|
||||
end;
|
||||
|
||||
fptkString:
|
||||
begin
|
||||
Result.Kind := tkStringLit;
|
||||
Result.Value := UnescapeString(FTok.TokenText);
|
||||
end;
|
||||
|
||||
fptkSymbol:
|
||||
begin
|
||||
text := FTok.TokenText;
|
||||
if text = ':=' then Result.Kind := tkAssign
|
||||
else if text = ':' then Result.Kind := tkColon
|
||||
else if text = '(' then Result.Kind := tkLParen
|
||||
else if text = ')' then Result.Kind := tkRParen
|
||||
else if text = ',' then Result.Kind := tkComma
|
||||
else if text = ';' then Result.Kind := tkSemicolon
|
||||
else if text = '.' then Result.Kind := tkDot
|
||||
else if text = '+' then Result.Kind := tkPlus
|
||||
else if text = '-' then Result.Kind := tkMinus
|
||||
else if text = '*' then Result.Kind := tkStar
|
||||
else if text = '/' then Result.Kind := tkSlash
|
||||
else
|
||||
raise Exception.CreateFmt(
|
||||
'Unexpected symbol ''%s'' at line %d col %d',
|
||||
[text, raw.Line, raw.Column]);
|
||||
Result.Value := text;
|
||||
end;
|
||||
|
||||
else
|
||||
raise Exception.CreateFmt(
|
||||
'Unexpected token kind %d at line %d col %d',
|
||||
[Ord(raw.Kind), raw.Line, raw.Column]);
|
||||
end;
|
||||
end;
|
||||
|
||||
end.
|
||||
379
compiler/src/main/pascal/uParser.pas
Normal file
379
compiler/src/main/pascal/uParser.pas
Normal file
|
|
@ -0,0 +1,379 @@
|
|||
unit uParser;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
{ Recursive-descent parser for the Phase 1 grammar:
|
||||
Program ::= 'program' Ident ';' [Uses] Block '.'
|
||||
Uses ::= 'uses' Ident {',' Ident} ';'
|
||||
Block ::= ['var' VarBlock] 'begin' StmtList 'end'
|
||||
VarBlock ::= VarDecl {VarDecl}
|
||||
VarDecl ::= IdentList ':' TypeName ';'
|
||||
StmtList ::= Stmt {';' Stmt} [';']
|
||||
Stmt ::= Assignment | ProcCall | empty
|
||||
Assignment ::= Ident ':=' Expr
|
||||
ProcCall ::= Ident ['(' [ExprList] ')']
|
||||
ExprList ::= Expr {',' Expr}
|
||||
Expr ::= Term (('+' | '-') Term)*
|
||||
Term ::= Factor (('*' | '/') Factor)*
|
||||
Factor ::= IntLit | StringLit | Ident | '(' Expr ')'
|
||||
TypeName ::= 'Integer' | 'Boolean' | 'string'
|
||||
}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
SysUtils, uLexer, uAST;
|
||||
|
||||
type
|
||||
EParseError = class(Exception);
|
||||
|
||||
TParser = class
|
||||
private
|
||||
FLexer: TLexer;
|
||||
FCurrent: TToken;
|
||||
|
||||
procedure Advance;
|
||||
procedure Expect(AKind: TTokenKind);
|
||||
function Check(AKind: TTokenKind): Boolean;
|
||||
|
||||
function ParseProgram: TProgram;
|
||||
procedure ParseUses(AProg: TProgram);
|
||||
function ParseBlock: TBlock;
|
||||
procedure ParseVarBlock(ABlock: TBlock);
|
||||
procedure ParseVarDecl(ABlock: TBlock);
|
||||
procedure ParseStmtList(ABlock: TBlock);
|
||||
function ParseStmt: TASTStmt;
|
||||
function ParseExpr: TASTExpr;
|
||||
function ParseTerm: TASTExpr;
|
||||
function ParseFactor: TASTExpr;
|
||||
procedure ParseArgList(ACall: TProcCall);
|
||||
public
|
||||
constructor Create(ALexer: TLexer);
|
||||
function Parse: TProgram;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
constructor TParser.Create(ALexer: TLexer);
|
||||
begin
|
||||
inherited Create;
|
||||
FLexer := ALexer;
|
||||
FCurrent := FLexer.Next;
|
||||
end;
|
||||
|
||||
procedure TParser.Advance;
|
||||
begin
|
||||
FCurrent := FLexer.Next;
|
||||
end;
|
||||
|
||||
procedure TParser.Expect(AKind: TTokenKind);
|
||||
begin
|
||||
if FCurrent.Kind <> AKind then
|
||||
raise EParseError.CreateFmt(
|
||||
'Expected token %d but got %d (''%s'') at line %d col %d',
|
||||
[Ord(AKind), Ord(FCurrent.Kind), FCurrent.Value,
|
||||
FCurrent.Line, FCurrent.Col]);
|
||||
Advance;
|
||||
end;
|
||||
|
||||
function TParser.Check(AKind: TTokenKind): Boolean;
|
||||
begin
|
||||
Result := FCurrent.Kind = AKind;
|
||||
end;
|
||||
|
||||
{ ------------------------------------------------------------------ }
|
||||
|
||||
function TParser.Parse: TProgram;
|
||||
begin
|
||||
Result := ParseProgram;
|
||||
end;
|
||||
|
||||
function TParser.ParseProgram: TProgram;
|
||||
begin
|
||||
Result := TProgram.Create;
|
||||
try
|
||||
Result.Line := FCurrent.Line;
|
||||
Result.Col := FCurrent.Col;
|
||||
|
||||
Expect(tkProgram);
|
||||
|
||||
if not Check(tkIdent) then
|
||||
raise EParseError.CreateFmt('Expected program name at line %d col %d',
|
||||
[FCurrent.Line, FCurrent.Col]);
|
||||
Result.Name := FCurrent.Value;
|
||||
Advance;
|
||||
|
||||
Expect(tkSemicolon);
|
||||
|
||||
if Check(tkUses) then
|
||||
ParseUses(Result);
|
||||
|
||||
Result.Block := ParseBlock;
|
||||
|
||||
Expect(tkDot);
|
||||
|
||||
if not Check(tkEOF) then
|
||||
raise EParseError.CreateFmt(
|
||||
'Unexpected tokens after program end at line %d col %d',
|
||||
[FCurrent.Line, FCurrent.Col]);
|
||||
except
|
||||
Result.Free;
|
||||
raise;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TParser.ParseUses(AProg: TProgram);
|
||||
begin
|
||||
Expect(tkUses);
|
||||
if not Check(tkIdent) then
|
||||
raise EParseError.CreateFmt('Expected unit name after ''uses'' at line %d col %d',
|
||||
[FCurrent.Line, FCurrent.Col]);
|
||||
AProg.Uses.Add(FCurrent.Value);
|
||||
Advance;
|
||||
while Check(tkComma) do
|
||||
begin
|
||||
Advance;
|
||||
if not Check(tkIdent) then
|
||||
raise EParseError.CreateFmt('Expected unit name after '','' at line %d col %d',
|
||||
[FCurrent.Line, FCurrent.Col]);
|
||||
AProg.Uses.Add(FCurrent.Value);
|
||||
Advance;
|
||||
end;
|
||||
Expect(tkSemicolon);
|
||||
end;
|
||||
|
||||
function TParser.ParseBlock: TBlock;
|
||||
begin
|
||||
Result := TBlock.Create;
|
||||
try
|
||||
Result.Line := FCurrent.Line;
|
||||
Result.Col := FCurrent.Col;
|
||||
|
||||
if Check(tkVar) then
|
||||
ParseVarBlock(Result);
|
||||
|
||||
Expect(tkBegin);
|
||||
ParseStmtList(Result);
|
||||
Expect(tkEnd);
|
||||
except
|
||||
Result.Free;
|
||||
raise;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TParser.ParseVarBlock(ABlock: TBlock);
|
||||
begin
|
||||
Expect(tkVar);
|
||||
{ At least one declaration required after 'var' }
|
||||
while Check(tkIdent) do
|
||||
ParseVarDecl(ABlock);
|
||||
end;
|
||||
|
||||
procedure TParser.ParseVarDecl(ABlock: TBlock);
|
||||
var
|
||||
Decl: TVarDecl;
|
||||
begin
|
||||
Decl := TVarDecl.Create;
|
||||
Decl.Line := FCurrent.Line;
|
||||
Decl.Col := FCurrent.Col;
|
||||
try
|
||||
{ IdentList: one or more names separated by commas }
|
||||
if not Check(tkIdent) then
|
||||
raise EParseError.CreateFmt('Expected variable name at line %d col %d',
|
||||
[FCurrent.Line, FCurrent.Col]);
|
||||
Decl.Names.Add(FCurrent.Value);
|
||||
Advance;
|
||||
while Check(tkComma) do
|
||||
begin
|
||||
Advance;
|
||||
if not Check(tkIdent) then
|
||||
raise EParseError.CreateFmt('Expected variable name at line %d col %d',
|
||||
[FCurrent.Line, FCurrent.Col]);
|
||||
Decl.Names.Add(FCurrent.Value);
|
||||
Advance;
|
||||
end;
|
||||
Expect(tkColon);
|
||||
if not Check(tkIdent) then
|
||||
raise EParseError.CreateFmt('Expected type name at line %d col %d',
|
||||
[FCurrent.Line, FCurrent.Col]);
|
||||
Decl.TypeName := FCurrent.Value;
|
||||
Advance;
|
||||
Expect(tkSemicolon);
|
||||
ABlock.Decls.Add(Decl);
|
||||
except
|
||||
Decl.Free;
|
||||
raise;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TParser.ParseStmtList(ABlock: TBlock);
|
||||
var
|
||||
Stmt: TASTStmt;
|
||||
begin
|
||||
{ Parse zero or more statements separated (or terminated) by semicolons }
|
||||
while not (Check(tkEnd) or Check(tkEOF)) do
|
||||
begin
|
||||
Stmt := ParseStmt;
|
||||
if Stmt <> nil then
|
||||
ABlock.Stmts.Add(Stmt);
|
||||
if Check(tkSemicolon) then
|
||||
Advance
|
||||
else
|
||||
Break;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TParser.ParseStmt: TASTStmt;
|
||||
var
|
||||
Name: string;
|
||||
Line, Col: Integer;
|
||||
Call: TProcCall;
|
||||
Assign: TAssignment;
|
||||
begin
|
||||
Result := nil;
|
||||
|
||||
{ Empty statement }
|
||||
if Check(tkEnd) or Check(tkEOF) or Check(tkSemicolon) then
|
||||
Exit;
|
||||
|
||||
if not Check(tkIdent) then
|
||||
raise EParseError.CreateFmt(
|
||||
'Expected statement at line %d col %d',
|
||||
[FCurrent.Line, FCurrent.Col]);
|
||||
|
||||
Name := FCurrent.Value;
|
||||
Line := FCurrent.Line;
|
||||
Col := FCurrent.Col;
|
||||
Advance;
|
||||
|
||||
if Check(tkAssign) then
|
||||
begin
|
||||
{ Assignment }
|
||||
Advance;
|
||||
Assign := TAssignment.Create;
|
||||
Assign.Line := Line;
|
||||
Assign.Col := Col;
|
||||
Assign.Name := Name;
|
||||
Assign.Expr := ParseExpr;
|
||||
Result := Assign;
|
||||
end
|
||||
else
|
||||
begin
|
||||
{ Procedure call — parentheses optional for zero-arg calls }
|
||||
Call := TProcCall.Create;
|
||||
Call.Line := Line;
|
||||
Call.Col := Col;
|
||||
Call.Name := Name;
|
||||
if Check(tkLParen) then
|
||||
begin
|
||||
Advance;
|
||||
if not Check(tkRParen) then
|
||||
ParseArgList(Call);
|
||||
Expect(tkRParen);
|
||||
end;
|
||||
Result := Call;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TParser.ParseArgList(ACall: TProcCall);
|
||||
begin
|
||||
ACall.Args.Add(ParseExpr);
|
||||
while Check(tkComma) do
|
||||
begin
|
||||
Advance;
|
||||
ACall.Args.Add(ParseExpr);
|
||||
end;
|
||||
end;
|
||||
|
||||
{ Expression parsing — standard precedence climbing }
|
||||
|
||||
function TParser.ParseExpr: TASTExpr;
|
||||
var
|
||||
Right: TASTExpr;
|
||||
Op: TBinaryOp;
|
||||
Node: TBinaryExpr;
|
||||
begin
|
||||
Result := ParseTerm;
|
||||
while Check(tkPlus) or Check(tkMinus) do
|
||||
begin
|
||||
if Check(tkPlus) then Op := boAdd else Op := boSub;
|
||||
Advance;
|
||||
Right := ParseTerm;
|
||||
Node := TBinaryExpr.Create;
|
||||
Node.Op := Op;
|
||||
Node.Left := Result;
|
||||
Node.Right := Right;
|
||||
Result := Node;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TParser.ParseTerm: TASTExpr;
|
||||
var
|
||||
Right: TASTExpr;
|
||||
Op: TBinaryOp;
|
||||
Node: TBinaryExpr;
|
||||
begin
|
||||
Result := ParseFactor;
|
||||
while Check(tkStar) or Check(tkSlash) do
|
||||
begin
|
||||
if Check(tkStar) then Op := boMul else Op := boDiv;
|
||||
Advance;
|
||||
Right := ParseFactor;
|
||||
Node := TBinaryExpr.Create;
|
||||
Node.Op := Op;
|
||||
Node.Left := Result;
|
||||
Node.Right := Right;
|
||||
Result := Node;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TParser.ParseFactor: TASTExpr;
|
||||
var
|
||||
IntNode: TIntLiteral;
|
||||
StrNode: TStringLiteral;
|
||||
IdNode: TIdentExpr;
|
||||
Inner: TASTExpr;
|
||||
begin
|
||||
case FCurrent.Kind of
|
||||
tkIntLit:
|
||||
begin
|
||||
IntNode := TIntLiteral.Create;
|
||||
IntNode.Line := FCurrent.Line;
|
||||
IntNode.Col := FCurrent.Col;
|
||||
IntNode.Value := StrToInt64(FCurrent.Value);
|
||||
Advance;
|
||||
Result := IntNode;
|
||||
end;
|
||||
tkStringLit:
|
||||
begin
|
||||
StrNode := TStringLiteral.Create;
|
||||
StrNode.Line := FCurrent.Line;
|
||||
StrNode.Col := FCurrent.Col;
|
||||
StrNode.Value := FCurrent.Value;
|
||||
Advance;
|
||||
Result := StrNode;
|
||||
end;
|
||||
tkIdent:
|
||||
begin
|
||||
IdNode := TIdentExpr.Create;
|
||||
IdNode.Line := FCurrent.Line;
|
||||
IdNode.Col := FCurrent.Col;
|
||||
IdNode.Name := FCurrent.Value;
|
||||
Advance;
|
||||
Result := IdNode;
|
||||
end;
|
||||
tkLParen:
|
||||
begin
|
||||
Advance;
|
||||
Inner := ParseExpr;
|
||||
Expect(tkRParen);
|
||||
Result := Inner;
|
||||
end;
|
||||
else
|
||||
raise EParseError.CreateFmt(
|
||||
'Expected expression at line %d col %d',
|
||||
[FCurrent.Line, FCurrent.Col]);
|
||||
end;
|
||||
end;
|
||||
|
||||
end.
|
||||
586
compiler/src/main/pascal/uPasTokeniser.pas
Normal file
586
compiler/src/main/pascal/uPasTokeniser.pas
Normal file
|
|
@ -0,0 +1,586 @@
|
|||
{
|
||||
Clean Pascal Compiler — General Pascal Tokeniser
|
||||
|
||||
Lightweight Object Pascal tokeniser. Operates on a string buffer and
|
||||
yields tokens one at a time via NextToken. No exceptions on malformed
|
||||
source — unrecognised characters produce fptkSymbol tokens of length 1,
|
||||
and unterminated strings or comments consume to end-of-source.
|
||||
|
||||
Does NOT evaluate compiler directives or IFDEF branches — everything
|
||||
is tokenised literally.
|
||||
|
||||
Ported from the fpGUI IDE tokeniser (same author).
|
||||
}
|
||||
unit uPasTokeniser;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils;
|
||||
|
||||
type
|
||||
TFpgPasTokenKind = (
|
||||
fptkEOF,
|
||||
fptkWhitespace,
|
||||
fptkLineEnding,
|
||||
fptkIdentifier,
|
||||
fptkKeyword,
|
||||
fptkNumber,
|
||||
fptkString,
|
||||
fptkComment,
|
||||
fptkDirective,
|
||||
fptkSymbol
|
||||
);
|
||||
|
||||
TFpgPasToken = record
|
||||
Kind: TFpgPasTokenKind;
|
||||
Line: Integer; { 1-based line number }
|
||||
Column: Integer; { 1-based column }
|
||||
Len: Integer; { character length in source }
|
||||
TextStart: Integer; { 1-based index into source string }
|
||||
end;
|
||||
|
||||
{ TFpgPascalTokeniser }
|
||||
|
||||
TFpgPascalTokeniser = class(TObject)
|
||||
private
|
||||
FSource: string;
|
||||
FPos: Integer;
|
||||
FLine: Integer;
|
||||
FLineStart: Integer; { FPos value at start of current line }
|
||||
FToken: TFpgPasToken;
|
||||
function Peek: Char; inline;
|
||||
function PeekAt(AOffset: Integer): Char; inline;
|
||||
procedure Advance; inline;
|
||||
procedure AdvanceLine;
|
||||
procedure ReadWhitespace;
|
||||
procedure ReadLineEnding;
|
||||
procedure ReadIdentifierOrKeyword;
|
||||
procedure ReadNumber;
|
||||
procedure ReadString;
|
||||
procedure ReadBraceCommentOrDirective;
|
||||
procedure ReadParenStarCommentOrDirective;
|
||||
procedure ReadLineComment;
|
||||
procedure ReadSymbol;
|
||||
public
|
||||
constructor Create;
|
||||
procedure SetSource(const ASource: string);
|
||||
function NextToken: TFpgPasToken;
|
||||
function TokenText: string;
|
||||
function TokenTextUpper: string;
|
||||
property Token: TFpgPasToken read FToken;
|
||||
property Source: string read FSource;
|
||||
end;
|
||||
|
||||
{ Returns True if AText is a Pascal keyword (case-insensitive). }
|
||||
function PasIsKeyword(const AText: string): Boolean;
|
||||
|
||||
|
||||
implementation
|
||||
|
||||
const
|
||||
{ Sorted keyword list for binary search }
|
||||
KeywordCount = 79;
|
||||
Keywords: array[0..KeywordCount - 1] of string = (
|
||||
'ABSOLUTE', 'AND', 'ARRAY', 'AS', 'ASM',
|
||||
'BEGIN', 'BITPACKED',
|
||||
'CASE', 'CLASS', 'CONST', 'CONSTREF', 'CONSTRUCTOR', 'CONTAINS',
|
||||
'DESTRUCTOR', 'DISPINTERFACE', 'DIV', 'DO', 'DOWNTO',
|
||||
'ELSE', 'END', 'EXCEPT', 'EXPORTS',
|
||||
'FALSE', 'FILE', 'FINALIZATION', 'FINALLY', 'FOR', 'FUNCTION',
|
||||
'GENERIC', 'GOTO',
|
||||
'IF', 'IMPLEMENTATION', 'IN', 'INHERITED', 'INITIALIZATION',
|
||||
'INLINE', 'INTERFACE', 'IS',
|
||||
'LABEL', 'LIBRARY',
|
||||
'MOD',
|
||||
'NIL', 'NOT',
|
||||
'OBJCCATEGORY', 'OBJCCLASS', 'OBJCPROTOCOL', 'OBJECT', 'OF',
|
||||
'OPERATOR', 'OR', 'OTHERWISE',
|
||||
'PACKAGE', 'PACKED', 'PROCEDURE', 'PROGRAM', 'PROPERTY',
|
||||
'RAISE', 'RECORD', 'REPEAT', 'REQUIRES', 'RESOURCESTRING',
|
||||
'SELF', 'SET', 'SHL', 'SHR', 'SPECIALIZE',
|
||||
'THEN', 'THREADVAR', 'TO', 'TRUE', 'TRY', 'TYPE',
|
||||
'UNIT', 'UNTIL', 'USES',
|
||||
'VAR',
|
||||
'WHILE', 'WITH',
|
||||
'XOR'
|
||||
);
|
||||
|
||||
function BinarySearchKeyword(const AText: string): Boolean;
|
||||
var
|
||||
Lo, Hi, Mid, Cmp: Integer;
|
||||
begin
|
||||
Result := False;
|
||||
Lo := 0;
|
||||
Hi := KeywordCount - 1;
|
||||
while Lo <= Hi do
|
||||
begin
|
||||
Mid := (Lo + Hi) shr 1;
|
||||
Cmp := CompareStr(AText, Keywords[Mid]);
|
||||
if Cmp < 0 then
|
||||
Hi := Mid - 1
|
||||
else if Cmp > 0 then
|
||||
Lo := Mid + 1
|
||||
else
|
||||
Exit(True);
|
||||
end;
|
||||
end;
|
||||
|
||||
function PasIsKeyword(const AText: string): Boolean;
|
||||
begin
|
||||
if AText = '' then
|
||||
Exit(False);
|
||||
Result := BinarySearchKeyword(UpCase(AText));
|
||||
end;
|
||||
|
||||
{ TFpgPascalTokeniser }
|
||||
|
||||
constructor TFpgPascalTokeniser.Create;
|
||||
begin
|
||||
inherited Create;
|
||||
FSource := '';
|
||||
FPos := 1;
|
||||
FLine := 1;
|
||||
FLineStart := 1;
|
||||
end;
|
||||
|
||||
procedure TFpgPascalTokeniser.SetSource(const ASource: string);
|
||||
begin
|
||||
FSource := ASource;
|
||||
FPos := 1;
|
||||
FLine := 1;
|
||||
FLineStart := 1;
|
||||
FToken.Kind := fptkEOF;
|
||||
FToken.Line := 1;
|
||||
FToken.Column := 1;
|
||||
FToken.Len := 0;
|
||||
FToken.TextStart := 1;
|
||||
end;
|
||||
|
||||
function TFpgPascalTokeniser.Peek: Char;
|
||||
begin
|
||||
if FPos <= Length(FSource) then
|
||||
Result := FSource[FPos]
|
||||
else
|
||||
Result := #0;
|
||||
end;
|
||||
|
||||
function TFpgPascalTokeniser.PeekAt(AOffset: Integer): Char;
|
||||
var
|
||||
p: Integer;
|
||||
begin
|
||||
p := FPos + AOffset;
|
||||
if (p >= 1) and (p <= Length(FSource)) then
|
||||
Result := FSource[p]
|
||||
else
|
||||
Result := #0;
|
||||
end;
|
||||
|
||||
procedure TFpgPascalTokeniser.Advance;
|
||||
begin
|
||||
Inc(FPos);
|
||||
end;
|
||||
|
||||
procedure TFpgPascalTokeniser.AdvanceLine;
|
||||
begin
|
||||
Inc(FLine);
|
||||
FLineStart := FPos;
|
||||
end;
|
||||
|
||||
procedure TFpgPascalTokeniser.ReadWhitespace;
|
||||
begin
|
||||
FToken.Kind := fptkWhitespace;
|
||||
while (FPos <= Length(FSource)) and (FSource[FPos] in [' ', #9]) do
|
||||
Advance;
|
||||
FToken.Len := FPos - FToken.TextStart;
|
||||
end;
|
||||
|
||||
procedure TFpgPascalTokeniser.ReadLineEnding;
|
||||
begin
|
||||
FToken.Kind := fptkLineEnding;
|
||||
if (FSource[FPos] = #13) and (PeekAt(1) = #10) then
|
||||
Advance; { consume CR of CRLF }
|
||||
Advance; { consume LF (or lone CR) }
|
||||
FToken.Len := FPos - FToken.TextStart;
|
||||
AdvanceLine;
|
||||
end;
|
||||
|
||||
procedure TFpgPascalTokeniser.ReadIdentifierOrKeyword;
|
||||
begin
|
||||
while (FPos <= Length(FSource)) and
|
||||
(FSource[FPos] in ['A'..'Z', 'a'..'z', '0'..'9', '_']) do
|
||||
Advance;
|
||||
FToken.Len := FPos - FToken.TextStart;
|
||||
if BinarySearchKeyword(UpCase(TokenText)) then
|
||||
FToken.Kind := fptkKeyword
|
||||
else
|
||||
FToken.Kind := fptkIdentifier;
|
||||
end;
|
||||
|
||||
procedure TFpgPascalTokeniser.ReadNumber;
|
||||
var
|
||||
c: Char;
|
||||
begin
|
||||
FToken.Kind := fptkNumber;
|
||||
c := FSource[FPos];
|
||||
|
||||
if c = '$' then
|
||||
begin
|
||||
{ Hex: $[0-9A-Fa-f]+ }
|
||||
Advance;
|
||||
while (FPos <= Length(FSource)) and
|
||||
(FSource[FPos] in ['0'..'9', 'A'..'F', 'a'..'f']) do
|
||||
Advance;
|
||||
FToken.Len := FPos - FToken.TextStart;
|
||||
Exit;
|
||||
end;
|
||||
|
||||
if c = '%' then
|
||||
begin
|
||||
{ Binary: %[01]+ }
|
||||
Advance;
|
||||
while (FPos <= Length(FSource)) and (FSource[FPos] in ['0', '1']) do
|
||||
Advance;
|
||||
FToken.Len := FPos - FToken.TextStart;
|
||||
Exit;
|
||||
end;
|
||||
|
||||
if c = '&' then
|
||||
begin
|
||||
{ Octal: &[0-7]+ }
|
||||
Advance;
|
||||
while (FPos <= Length(FSource)) and (FSource[FPos] in ['0'..'7']) do
|
||||
Advance;
|
||||
FToken.Len := FPos - FToken.TextStart;
|
||||
Exit;
|
||||
end;
|
||||
|
||||
{ Decimal integer or float }
|
||||
while (FPos <= Length(FSource)) and (FSource[FPos] in ['0'..'9']) do
|
||||
Advance;
|
||||
|
||||
{ Check for decimal point (but not '..') }
|
||||
if (FPos <= Length(FSource)) and (FSource[FPos] = '.') and
|
||||
(PeekAt(1) <> '.') then
|
||||
begin
|
||||
Advance; { consume '.' }
|
||||
while (FPos <= Length(FSource)) and (FSource[FPos] in ['0'..'9']) do
|
||||
Advance;
|
||||
end;
|
||||
|
||||
{ Check for exponent }
|
||||
if (FPos <= Length(FSource)) and (FSource[FPos] in ['e', 'E']) then
|
||||
begin
|
||||
Advance;
|
||||
if (FPos <= Length(FSource)) and (FSource[FPos] in ['+', '-']) then
|
||||
Advance;
|
||||
while (FPos <= Length(FSource)) and (FSource[FPos] in ['0'..'9']) do
|
||||
Advance;
|
||||
end;
|
||||
|
||||
FToken.Len := FPos - FToken.TextStart;
|
||||
end;
|
||||
|
||||
procedure TFpgPascalTokeniser.ReadString;
|
||||
var
|
||||
c: Char;
|
||||
begin
|
||||
{ Pascal string literals can be composed of:
|
||||
- 'quoted text' (with '' for embedded quotes)
|
||||
- #nn (decimal char code)
|
||||
- #$nn (hex char code)
|
||||
- ^A (control char)
|
||||
These can be concatenated without operators: 'abc'#13#10'def' }
|
||||
FToken.Kind := fptkString;
|
||||
|
||||
repeat
|
||||
c := Peek;
|
||||
if c = '''' then
|
||||
begin
|
||||
Advance; { opening quote }
|
||||
while FPos <= Length(FSource) do
|
||||
begin
|
||||
if FSource[FPos] = '''' then
|
||||
begin
|
||||
Advance;
|
||||
{ Embedded quote? '' }
|
||||
if (FPos <= Length(FSource)) and (FSource[FPos] = '''') then
|
||||
Advance
|
||||
else
|
||||
Break; { closing quote }
|
||||
end
|
||||
else if FSource[FPos] in [#10, #13] then
|
||||
Break { unterminated string at line end }
|
||||
else
|
||||
Advance;
|
||||
end;
|
||||
end
|
||||
else if c = '#' then
|
||||
begin
|
||||
Advance; { consume # }
|
||||
if (FPos <= Length(FSource)) and (FSource[FPos] = '$') then
|
||||
begin
|
||||
Advance; { hex char code }
|
||||
while (FPos <= Length(FSource)) and
|
||||
(FSource[FPos] in ['0'..'9', 'A'..'F', 'a'..'f']) do
|
||||
Advance;
|
||||
end
|
||||
else
|
||||
begin
|
||||
while (FPos <= Length(FSource)) and (FSource[FPos] in ['0'..'9']) do
|
||||
Advance;
|
||||
end;
|
||||
end
|
||||
else if c = '^' then
|
||||
begin
|
||||
Advance; { consume ^ }
|
||||
if (FPos <= Length(FSource)) and (FSource[FPos] in ['A'..'Z', 'a'..'z']) then
|
||||
Advance;
|
||||
end
|
||||
else
|
||||
Break; { not a string continuation }
|
||||
until False;
|
||||
|
||||
FToken.Len := FPos - FToken.TextStart;
|
||||
end;
|
||||
|
||||
procedure TFpgPascalTokeniser.ReadBraceCommentOrDirective;
|
||||
begin
|
||||
// Already at open-brace. Check next char for '$'.
|
||||
if PeekAt(1) = '$' then
|
||||
FToken.Kind := fptkDirective
|
||||
else
|
||||
FToken.Kind := fptkComment;
|
||||
|
||||
Advance; // consume open-brace
|
||||
while FPos <= Length(FSource) do
|
||||
begin
|
||||
if FSource[FPos] = '}' then
|
||||
begin
|
||||
Advance;
|
||||
Break;
|
||||
end
|
||||
else if FSource[FPos] = #13 then
|
||||
begin
|
||||
Advance;
|
||||
if (FPos <= Length(FSource)) and (FSource[FPos] = #10) then
|
||||
Advance;
|
||||
AdvanceLine;
|
||||
end
|
||||
else if FSource[FPos] = #10 then
|
||||
begin
|
||||
Advance;
|
||||
AdvanceLine;
|
||||
end
|
||||
else
|
||||
Advance;
|
||||
end;
|
||||
FToken.Len := FPos - FToken.TextStart;
|
||||
end;
|
||||
|
||||
procedure TFpgPascalTokeniser.ReadParenStarCommentOrDirective;
|
||||
begin
|
||||
{ Already at '('. Next is '*'. Check char after '*' for '$'. }
|
||||
if PeekAt(2) = '$' then
|
||||
FToken.Kind := fptkDirective
|
||||
else
|
||||
FToken.Kind := fptkComment;
|
||||
|
||||
Advance; { consume '(' }
|
||||
Advance; { consume '*' }
|
||||
while FPos <= Length(FSource) do
|
||||
begin
|
||||
if (FSource[FPos] = '*') and (PeekAt(1) = ')') then
|
||||
begin
|
||||
Advance; { consume '*' }
|
||||
Advance; { consume ')' }
|
||||
Break;
|
||||
end
|
||||
else if FSource[FPos] = #13 then
|
||||
begin
|
||||
Advance;
|
||||
if (FPos <= Length(FSource)) and (FSource[FPos] = #10) then
|
||||
Advance;
|
||||
AdvanceLine;
|
||||
end
|
||||
else if FSource[FPos] = #10 then
|
||||
begin
|
||||
Advance;
|
||||
AdvanceLine;
|
||||
end
|
||||
else
|
||||
Advance;
|
||||
end;
|
||||
FToken.Len := FPos - FToken.TextStart;
|
||||
end;
|
||||
|
||||
procedure TFpgPascalTokeniser.ReadLineComment;
|
||||
begin
|
||||
FToken.Kind := fptkComment;
|
||||
{ Consume everything until end of line or end of source }
|
||||
while (FPos <= Length(FSource)) and
|
||||
not (FSource[FPos] in [#10, #13]) do
|
||||
Advance;
|
||||
FToken.Len := FPos - FToken.TextStart;
|
||||
end;
|
||||
|
||||
procedure TFpgPascalTokeniser.ReadSymbol;
|
||||
var
|
||||
c, c2: Char;
|
||||
begin
|
||||
FToken.Kind := fptkSymbol;
|
||||
c := FSource[FPos];
|
||||
c2 := PeekAt(1);
|
||||
Advance;
|
||||
|
||||
case c of
|
||||
':': if c2 = '=' then Advance; // :=
|
||||
'<': if c2 in ['>', '='] then Advance; // <> or <=
|
||||
'>': if c2 in ['<', '='] then Advance; // >< or >=
|
||||
'.': if c2 = '.' then Advance; // ..
|
||||
'*': if c2 = '*' then Advance; // **
|
||||
'@': if c2 = '@' then Advance; // @@
|
||||
'+': if c2 = '=' then Advance; // +=
|
||||
'-': if c2 = '=' then Advance; // -=
|
||||
'/': if c2 = '=' then Advance; // /= (// handled separately)
|
||||
end;
|
||||
|
||||
// Special: *= (if * was not followed by *)
|
||||
if (c = '*') and (c2 <> '*') and (c2 = '=') then
|
||||
Advance;
|
||||
|
||||
FToken.Len := FPos - FToken.TextStart;
|
||||
end;
|
||||
|
||||
function TFpgPascalTokeniser.NextToken: TFpgPasToken;
|
||||
var
|
||||
c, c2: Char;
|
||||
begin
|
||||
if FPos > Length(FSource) then
|
||||
begin
|
||||
FToken.Kind := fptkEOF;
|
||||
FToken.Line := FLine;
|
||||
FToken.Column := FPos - FLineStart + 1;
|
||||
FToken.Len := 0;
|
||||
FToken.TextStart := FPos;
|
||||
Result := FToken;
|
||||
Exit;
|
||||
end;
|
||||
|
||||
{ Record token start position }
|
||||
FToken.TextStart := FPos;
|
||||
FToken.Line := FLine;
|
||||
FToken.Column := FPos - FLineStart + 1;
|
||||
|
||||
c := FSource[FPos];
|
||||
|
||||
{ Whitespace (not line endings) }
|
||||
if c in [' ', #9] then
|
||||
begin
|
||||
ReadWhitespace;
|
||||
Result := FToken;
|
||||
Exit;
|
||||
end;
|
||||
|
||||
{ Line endings }
|
||||
if c in [#13, #10] then
|
||||
begin
|
||||
ReadLineEnding;
|
||||
Result := FToken;
|
||||
Exit;
|
||||
end;
|
||||
|
||||
{ Identifiers and keywords }
|
||||
if c in ['A'..'Z', 'a'..'z', '_'] then
|
||||
begin
|
||||
ReadIdentifierOrKeyword;
|
||||
Result := FToken;
|
||||
Exit;
|
||||
end;
|
||||
|
||||
{ Numbers: digits or $ (hex) or % (binary) or & (octal) }
|
||||
if c in ['0'..'9'] then
|
||||
begin
|
||||
ReadNumber;
|
||||
Result := FToken;
|
||||
Exit;
|
||||
end;
|
||||
if (c = '$') and (PeekAt(1) in ['0'..'9', 'A'..'F', 'a'..'f']) then
|
||||
begin
|
||||
ReadNumber;
|
||||
Result := FToken;
|
||||
Exit;
|
||||
end;
|
||||
if (c = '%') and (PeekAt(1) in ['0', '1']) then
|
||||
begin
|
||||
ReadNumber;
|
||||
Result := FToken;
|
||||
Exit;
|
||||
end;
|
||||
if (c = '&') and (PeekAt(1) in ['0'..'7']) then
|
||||
begin
|
||||
ReadNumber;
|
||||
Result := FToken;
|
||||
Exit;
|
||||
end;
|
||||
|
||||
{ Strings: ' or # or ^ }
|
||||
if c in ['''', '#'] then
|
||||
begin
|
||||
ReadString;
|
||||
Result := FToken;
|
||||
Exit;
|
||||
end;
|
||||
if (c = '^') and (PeekAt(1) in ['A'..'Z', 'a'..'z']) then
|
||||
begin
|
||||
ReadString;
|
||||
Result := FToken;
|
||||
Exit;
|
||||
end;
|
||||
|
||||
{ Comments and directives }
|
||||
if c = '{' then
|
||||
begin
|
||||
ReadBraceCommentOrDirective;
|
||||
Result := FToken;
|
||||
Exit;
|
||||
end;
|
||||
|
||||
c2 := PeekAt(1);
|
||||
|
||||
if (c = '(') and (c2 = '*') then
|
||||
begin
|
||||
ReadParenStarCommentOrDirective;
|
||||
Result := FToken;
|
||||
Exit;
|
||||
end;
|
||||
|
||||
if (c = '/') and (c2 = '/') then
|
||||
begin
|
||||
ReadLineComment;
|
||||
Result := FToken;
|
||||
Exit;
|
||||
end;
|
||||
|
||||
{ Symbols and operators }
|
||||
ReadSymbol;
|
||||
Result := FToken;
|
||||
end;
|
||||
|
||||
function TFpgPascalTokeniser.TokenText: string;
|
||||
begin
|
||||
if (FToken.TextStart >= 1) and (FToken.Len > 0) and
|
||||
(FToken.TextStart + FToken.Len - 1 <= Length(FSource)) then
|
||||
Result := Copy(FSource, FToken.TextStart, FToken.Len)
|
||||
else
|
||||
Result := '';
|
||||
end;
|
||||
|
||||
function TFpgPascalTokeniser.TokenTextUpper: string;
|
||||
begin
|
||||
Result := UpCase(TokenText);
|
||||
end;
|
||||
|
||||
end.
|
||||
29
compiler/src/test/pascal/TestRunner.pas
Normal file
29
compiler/src/test/pascal/TestRunner.pas
Normal file
|
|
@ -0,0 +1,29 @@
|
|||
program TestRunner;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
uses
|
||||
{$IFDEF UNIX}
|
||||
cthreads,
|
||||
{$ENDIF}
|
||||
Classes,
|
||||
fpcunit,
|
||||
testregistry,
|
||||
consoletestrunner,
|
||||
cp.test.lexer,
|
||||
cp.test.parser,
|
||||
cp.test.codegen;
|
||||
|
||||
var
|
||||
Application: TTestRunner;
|
||||
|
||||
begin
|
||||
Application := TTestRunner.Create(nil);
|
||||
try
|
||||
Application.Initialize;
|
||||
Application.Title := 'Blaise Compiler Unit Tests';
|
||||
Application.Run;
|
||||
finally
|
||||
Application.Free;
|
||||
end;
|
||||
end.
|
||||
209
compiler/src/test/pascal/cp.test.codegen.pas
Normal file
209
compiler/src/test/pascal/cp.test.codegen.pas
Normal file
|
|
@ -0,0 +1,209 @@
|
|||
unit cp.test.codegen;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, fpcunit, testregistry,
|
||||
uLexer, uParser, uAST, uCodeGenQBE;
|
||||
|
||||
type
|
||||
TCodeGenTests = class(TTestCase)
|
||||
private
|
||||
function GenerateIR(const ASrc: string): string;
|
||||
function IRContains(const AIR, AFragment: string): Boolean;
|
||||
published
|
||||
{ Data sections }
|
||||
procedure TestHelloWorld_HasStrLitData;
|
||||
procedure TestHelloWorld_HasFormatString;
|
||||
|
||||
{ Main function structure }
|
||||
procedure TestOutput_HasMainFunction;
|
||||
procedure TestOutput_HasRetZero;
|
||||
|
||||
{ WriteLn }
|
||||
procedure TestWriteLn_NoArgs_CallsFormatNL;
|
||||
procedure TestWriteLn_StringLit_CallsPrintf;
|
||||
procedure TestWriteLn_IntExpr_CallsPrintfInt;
|
||||
|
||||
{ Variables and assignment }
|
||||
procedure TestIntVar_HasAlloc;
|
||||
procedure TestAssignment_HasStorew;
|
||||
procedure TestAssignment_LoadAndStore;
|
||||
|
||||
{ Arithmetic }
|
||||
procedure TestAdd_EmitsAddInstruction;
|
||||
procedure TestMul_EmitsMulInstruction;
|
||||
|
||||
{ Header comment }
|
||||
procedure TestOutput_HasSourceComment;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
function TCodeGenTests.GenerateIR(const ASrc: string): string;
|
||||
var
|
||||
L: TLexer;
|
||||
P: TParser;
|
||||
Pr: TProgram;
|
||||
CG: TCodeGenQBE;
|
||||
begin
|
||||
L := TLexer.Create(ASrc);
|
||||
P := TParser.Create(L);
|
||||
Pr := P.Parse;
|
||||
CG := TCodeGenQBE.Create;
|
||||
try
|
||||
CG.Generate(Pr);
|
||||
Result := CG.GetOutput;
|
||||
finally
|
||||
CG.Free;
|
||||
Pr.Free;
|
||||
P.Free;
|
||||
L.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TCodeGenTests.IRContains(const AIR, AFragment: string): Boolean;
|
||||
begin
|
||||
Result := Pos(AFragment, AIR) > 0;
|
||||
end;
|
||||
|
||||
{ Data sections }
|
||||
|
||||
procedure TCodeGenTests.TestHelloWorld_HasStrLitData;
|
||||
var
|
||||
IR: string;
|
||||
begin
|
||||
IR := GenerateIR('program P; begin WriteLn(''Hello'') end.');
|
||||
AssertTrue('Has str data',
|
||||
IRContains(IR, 'data $__s0'));
|
||||
AssertTrue('Contains Hello',
|
||||
IRContains(IR, '"Hello"'));
|
||||
end;
|
||||
|
||||
procedure TCodeGenTests.TestHelloWorld_HasFormatString;
|
||||
var
|
||||
IR: string;
|
||||
begin
|
||||
IR := GenerateIR('program P; begin WriteLn(''Hello'') end.');
|
||||
AssertTrue('Has fmt_s_nl',
|
||||
IRContains(IR, '$__fmt_s_nl'));
|
||||
end;
|
||||
|
||||
{ Main function structure }
|
||||
|
||||
procedure TCodeGenTests.TestOutput_HasMainFunction;
|
||||
var
|
||||
IR: string;
|
||||
begin
|
||||
IR := GenerateIR('program P; begin end.');
|
||||
AssertTrue('Has export function $main',
|
||||
IRContains(IR, 'export function w $main()'));
|
||||
end;
|
||||
|
||||
procedure TCodeGenTests.TestOutput_HasRetZero;
|
||||
var
|
||||
IR: string;
|
||||
begin
|
||||
IR := GenerateIR('program P; begin end.');
|
||||
AssertTrue('Has ret 0', IRContains(IR, 'ret 0'));
|
||||
end;
|
||||
|
||||
{ WriteLn }
|
||||
|
||||
procedure TCodeGenTests.TestWriteLn_NoArgs_CallsFormatNL;
|
||||
var
|
||||
IR: string;
|
||||
begin
|
||||
IR := GenerateIR('program P; begin WriteLn() end.');
|
||||
AssertTrue('Calls printf with fmt_nl',
|
||||
IRContains(IR, 'call $printf(l $__fmt_nl)'));
|
||||
end;
|
||||
|
||||
procedure TCodeGenTests.TestWriteLn_StringLit_CallsPrintf;
|
||||
var
|
||||
IR: string;
|
||||
begin
|
||||
IR := GenerateIR('program P; begin WriteLn(''Hi'') end.');
|
||||
AssertTrue('Calls printf with s_nl format',
|
||||
IRContains(IR, '$__fmt_s_nl'));
|
||||
AssertTrue('Passes string pointer',
|
||||
IRContains(IR, '..., l $__s0'));
|
||||
end;
|
||||
|
||||
procedure TCodeGenTests.TestWriteLn_IntExpr_CallsPrintfInt;
|
||||
var
|
||||
IR: string;
|
||||
begin
|
||||
IR := GenerateIR('program P; begin WriteLn(42) end.');
|
||||
AssertTrue('Uses int format',
|
||||
IRContains(IR, '$__fmt_d_nl'));
|
||||
end;
|
||||
|
||||
{ Variables and assignment }
|
||||
|
||||
procedure TCodeGenTests.TestIntVar_HasAlloc;
|
||||
var
|
||||
IR: string;
|
||||
begin
|
||||
IR := GenerateIR('program P; var x: Integer; begin end.');
|
||||
AssertTrue('Has alloc for x',
|
||||
IRContains(IR, '%_var_x =l alloc4 1'));
|
||||
end;
|
||||
|
||||
procedure TCodeGenTests.TestAssignment_HasStorew;
|
||||
var
|
||||
IR: string;
|
||||
begin
|
||||
IR := GenerateIR(
|
||||
'program P; var n: Integer; begin n := 7 end.');
|
||||
AssertTrue('Has storew', IRContains(IR, 'storew'));
|
||||
AssertTrue('Stores to n', IRContains(IR, 'storew %_t0, %_var_n'));
|
||||
end;
|
||||
|
||||
procedure TCodeGenTests.TestAssignment_LoadAndStore;
|
||||
var
|
||||
IR: string;
|
||||
begin
|
||||
IR := GenerateIR(
|
||||
'program P; var x, y: Integer; begin x := 1; y := x end.');
|
||||
AssertTrue('Loads x', IRContains(IR, 'loadw %_var_x'));
|
||||
AssertTrue('Stores y', IRContains(IR, '%_var_y'));
|
||||
end;
|
||||
|
||||
{ Arithmetic }
|
||||
|
||||
procedure TCodeGenTests.TestAdd_EmitsAddInstruction;
|
||||
var
|
||||
IR: string;
|
||||
begin
|
||||
IR := GenerateIR(
|
||||
'program P; var n: Integer; begin n := 3 + 4 end.');
|
||||
AssertTrue('Has add', IRContains(IR, '=w add'));
|
||||
end;
|
||||
|
||||
procedure TCodeGenTests.TestMul_EmitsMulInstruction;
|
||||
var
|
||||
IR: string;
|
||||
begin
|
||||
IR := GenerateIR(
|
||||
'program P; var n: Integer; begin n := 2 * 5 end.');
|
||||
AssertTrue('Has mul', IRContains(IR, '=w mul'));
|
||||
end;
|
||||
|
||||
{ Header comment }
|
||||
|
||||
procedure TCodeGenTests.TestOutput_HasSourceComment;
|
||||
var
|
||||
IR: string;
|
||||
begin
|
||||
IR := GenerateIR('program MyProg; begin end.');
|
||||
AssertTrue('Has source comment',
|
||||
IRContains(IR, '# Generated by Blaise Compiler'));
|
||||
end;
|
||||
|
||||
initialization
|
||||
RegisterTest(TCodeGenTests);
|
||||
|
||||
end.
|
||||
475
compiler/src/test/pascal/cp.test.lexer.pas
Normal file
475
compiler/src/test/pascal/cp.test.lexer.pas
Normal file
|
|
@ -0,0 +1,475 @@
|
|||
unit cp.test.lexer;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, fpcunit, testregistry,
|
||||
uLexer;
|
||||
|
||||
type
|
||||
TLexerTests = class(TTestCase)
|
||||
private
|
||||
FLexer: TLexer;
|
||||
procedure SetLexer(const ASource: string);
|
||||
protected
|
||||
procedure TearDown; override;
|
||||
published
|
||||
{ EOF and whitespace }
|
||||
procedure TestEmptySource_ReturnsEOF;
|
||||
procedure TestWhitespaceOnly_ReturnsEOF;
|
||||
|
||||
{ Comment skipping }
|
||||
procedure TestLineComment_Skipped;
|
||||
procedure TestBlockComment_Skipped;
|
||||
procedure TestBlockComment_MultiLine_Skipped;
|
||||
|
||||
{ Keywords }
|
||||
procedure TestKeyword_Program;
|
||||
procedure TestKeyword_Uses;
|
||||
procedure TestKeyword_Var;
|
||||
procedure TestKeyword_Begin;
|
||||
procedure TestKeyword_End;
|
||||
procedure TestKeywords_CaseInsensitive;
|
||||
procedure TestIdent_NotKeyword_Prefix;
|
||||
|
||||
{ Identifiers }
|
||||
procedure TestIdent_Simple;
|
||||
procedure TestIdent_WithUnderscore;
|
||||
procedure TestIdent_WithDigits;
|
||||
|
||||
{ Integer literals }
|
||||
procedure TestIntLit_SingleDigit;
|
||||
procedure TestIntLit_MultiDigit;
|
||||
|
||||
{ String literals }
|
||||
procedure TestStringLit_Simple;
|
||||
procedure TestStringLit_Empty;
|
||||
procedure TestStringLit_EmbeddedQuote;
|
||||
|
||||
{ Operators and punctuation }
|
||||
procedure TestOp_Plus;
|
||||
procedure TestOp_Minus;
|
||||
procedure TestOp_Star;
|
||||
procedure TestOp_Slash;
|
||||
procedure TestOp_Assign;
|
||||
procedure TestOp_Colon;
|
||||
procedure TestOp_LParen;
|
||||
procedure TestOp_RParen;
|
||||
procedure TestOp_Comma;
|
||||
procedure TestOp_Semicolon;
|
||||
procedure TestOp_Dot;
|
||||
|
||||
{ Position tracking }
|
||||
procedure TestLineTracking_SecondLine;
|
||||
procedure TestColTracking_AfterSpaces;
|
||||
|
||||
{ Token sequences }
|
||||
procedure TestSeq_VarDecl;
|
||||
procedure TestSeq_Assignment;
|
||||
procedure TestSeq_ProcCall;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
procedure TLexerTests.SetLexer(const ASource: string);
|
||||
begin
|
||||
FreeAndNil(FLexer);
|
||||
FLexer := TLexer.Create(ASource);
|
||||
end;
|
||||
|
||||
procedure TLexerTests.TearDown;
|
||||
begin
|
||||
FreeAndNil(FLexer);
|
||||
end;
|
||||
|
||||
{ EOF and whitespace }
|
||||
|
||||
procedure TLexerTests.TestEmptySource_ReturnsEOF;
|
||||
var
|
||||
tok: TToken;
|
||||
begin
|
||||
SetLexer('');
|
||||
tok := FLexer.Next;
|
||||
AssertEquals('Kind', Ord(tkEOF), Ord(tok.Kind));
|
||||
end;
|
||||
|
||||
procedure TLexerTests.TestWhitespaceOnly_ReturnsEOF;
|
||||
var
|
||||
tok: TToken;
|
||||
begin
|
||||
SetLexer(' ' + LineEnding + ' ');
|
||||
tok := FLexer.Next;
|
||||
AssertEquals('Kind', Ord(tkEOF), Ord(tok.Kind));
|
||||
end;
|
||||
|
||||
{ Comment skipping }
|
||||
|
||||
procedure TLexerTests.TestLineComment_Skipped;
|
||||
var
|
||||
tok: TToken;
|
||||
begin
|
||||
SetLexer('// comment' + LineEnding + 'begin');
|
||||
tok := FLexer.Next;
|
||||
AssertEquals('Kind after //', Ord(tkBegin), Ord(tok.Kind));
|
||||
end;
|
||||
|
||||
procedure TLexerTests.TestBlockComment_Skipped;
|
||||
var
|
||||
tok: TToken;
|
||||
begin
|
||||
SetLexer('{ comment } begin');
|
||||
tok := FLexer.Next;
|
||||
AssertEquals('Kind after {}', Ord(tkBegin), Ord(tok.Kind));
|
||||
end;
|
||||
|
||||
procedure TLexerTests.TestBlockComment_MultiLine_Skipped;
|
||||
var
|
||||
tok: TToken;
|
||||
begin
|
||||
SetLexer('{ line one' + LineEnding + ' line two }' + LineEnding + 'end');
|
||||
tok := FLexer.Next;
|
||||
AssertEquals('Kind after multiline {}', Ord(tkEnd), Ord(tok.Kind));
|
||||
end;
|
||||
|
||||
{ Keywords }
|
||||
|
||||
procedure TLexerTests.TestKeyword_Program;
|
||||
var
|
||||
tok: TToken;
|
||||
begin
|
||||
SetLexer('program');
|
||||
tok := FLexer.Next;
|
||||
AssertEquals('Kind', Ord(tkProgram), Ord(tok.Kind));
|
||||
AssertEquals('Value', 'program', tok.Value);
|
||||
end;
|
||||
|
||||
procedure TLexerTests.TestKeyword_Uses;
|
||||
var
|
||||
tok: TToken;
|
||||
begin
|
||||
SetLexer('uses');
|
||||
tok := FLexer.Next;
|
||||
AssertEquals('Kind', Ord(tkUses), Ord(tok.Kind));
|
||||
end;
|
||||
|
||||
procedure TLexerTests.TestKeyword_Var;
|
||||
var
|
||||
tok: TToken;
|
||||
begin
|
||||
SetLexer('var');
|
||||
tok := FLexer.Next;
|
||||
AssertEquals('Kind', Ord(tkVar), Ord(tok.Kind));
|
||||
end;
|
||||
|
||||
procedure TLexerTests.TestKeyword_Begin;
|
||||
var
|
||||
tok: TToken;
|
||||
begin
|
||||
SetLexer('begin');
|
||||
tok := FLexer.Next;
|
||||
AssertEquals('Kind', Ord(tkBegin), Ord(tok.Kind));
|
||||
end;
|
||||
|
||||
procedure TLexerTests.TestKeyword_End;
|
||||
var
|
||||
tok: TToken;
|
||||
begin
|
||||
SetLexer('end');
|
||||
tok := FLexer.Next;
|
||||
AssertEquals('Kind', Ord(tkEnd), Ord(tok.Kind));
|
||||
end;
|
||||
|
||||
procedure TLexerTests.TestKeywords_CaseInsensitive;
|
||||
var
|
||||
tok: TToken;
|
||||
begin
|
||||
SetLexer('BEGIN');
|
||||
tok := FLexer.Next;
|
||||
AssertEquals('Uppercase BEGIN', Ord(tkBegin), Ord(tok.Kind));
|
||||
|
||||
SetLexer('End');
|
||||
tok := FLexer.Next;
|
||||
AssertEquals('Mixed End', Ord(tkEnd), Ord(tok.Kind));
|
||||
|
||||
SetLexer('PROGRAM');
|
||||
tok := FLexer.Next;
|
||||
AssertEquals('Uppercase PROGRAM', Ord(tkProgram), Ord(tok.Kind));
|
||||
end;
|
||||
|
||||
procedure TLexerTests.TestIdent_NotKeyword_Prefix;
|
||||
var
|
||||
tok: TToken;
|
||||
begin
|
||||
{ "beginning" starts with "begin" but is not a keyword }
|
||||
SetLexer('beginning');
|
||||
tok := FLexer.Next;
|
||||
AssertEquals('Kind', Ord(tkIdent), Ord(tok.Kind));
|
||||
AssertEquals('Value', 'beginning', tok.Value);
|
||||
end;
|
||||
|
||||
{ Identifiers }
|
||||
|
||||
procedure TLexerTests.TestIdent_Simple;
|
||||
var
|
||||
tok: TToken;
|
||||
begin
|
||||
SetLexer('Hello');
|
||||
tok := FLexer.Next;
|
||||
AssertEquals('Kind', Ord(tkIdent), Ord(tok.Kind));
|
||||
AssertEquals('Value', 'Hello', tok.Value);
|
||||
end;
|
||||
|
||||
procedure TLexerTests.TestIdent_WithUnderscore;
|
||||
var
|
||||
tok: TToken;
|
||||
begin
|
||||
SetLexer('_myVar');
|
||||
tok := FLexer.Next;
|
||||
AssertEquals('Kind', Ord(tkIdent), Ord(tok.Kind));
|
||||
AssertEquals('Value', '_myVar', tok.Value);
|
||||
end;
|
||||
|
||||
procedure TLexerTests.TestIdent_WithDigits;
|
||||
var
|
||||
tok: TToken;
|
||||
begin
|
||||
SetLexer('item2');
|
||||
tok := FLexer.Next;
|
||||
AssertEquals('Kind', Ord(tkIdent), Ord(tok.Kind));
|
||||
AssertEquals('Value', 'item2', tok.Value);
|
||||
end;
|
||||
|
||||
{ Integer literals }
|
||||
|
||||
procedure TLexerTests.TestIntLit_SingleDigit;
|
||||
var
|
||||
tok: TToken;
|
||||
begin
|
||||
SetLexer('7');
|
||||
tok := FLexer.Next;
|
||||
AssertEquals('Kind', Ord(tkIntLit), Ord(tok.Kind));
|
||||
AssertEquals('Value', '7', tok.Value);
|
||||
end;
|
||||
|
||||
procedure TLexerTests.TestIntLit_MultiDigit;
|
||||
var
|
||||
tok: TToken;
|
||||
begin
|
||||
SetLexer('42');
|
||||
tok := FLexer.Next;
|
||||
AssertEquals('Kind', Ord(tkIntLit), Ord(tok.Kind));
|
||||
AssertEquals('Value', '42', tok.Value);
|
||||
end;
|
||||
|
||||
{ String literals }
|
||||
|
||||
procedure TLexerTests.TestStringLit_Simple;
|
||||
var
|
||||
tok: TToken;
|
||||
begin
|
||||
SetLexer('''hello''');
|
||||
tok := FLexer.Next;
|
||||
AssertEquals('Kind', Ord(tkStringLit), Ord(tok.Kind));
|
||||
AssertEquals('Value', 'hello', tok.Value);
|
||||
end;
|
||||
|
||||
procedure TLexerTests.TestStringLit_Empty;
|
||||
var
|
||||
tok: TToken;
|
||||
begin
|
||||
SetLexer('''''');
|
||||
tok := FLexer.Next;
|
||||
AssertEquals('Kind', Ord(tkStringLit), Ord(tok.Kind));
|
||||
AssertEquals('Value', '', tok.Value);
|
||||
end;
|
||||
|
||||
procedure TLexerTests.TestStringLit_EmbeddedQuote;
|
||||
var
|
||||
tok: TToken;
|
||||
begin
|
||||
{ Pascal ''it''''s'' represents it's }
|
||||
SetLexer('''it''''s''');
|
||||
tok := FLexer.Next;
|
||||
AssertEquals('Kind', Ord(tkStringLit), Ord(tok.Kind));
|
||||
AssertEquals('Value', 'it''s', tok.Value);
|
||||
end;
|
||||
|
||||
{ Operators and punctuation }
|
||||
|
||||
procedure TLexerTests.TestOp_Plus;
|
||||
var
|
||||
tok: TToken;
|
||||
begin
|
||||
SetLexer('+');
|
||||
tok := FLexer.Next;
|
||||
AssertEquals('Kind', Ord(tkPlus), Ord(tok.Kind));
|
||||
end;
|
||||
|
||||
procedure TLexerTests.TestOp_Minus;
|
||||
var
|
||||
tok: TToken;
|
||||
begin
|
||||
SetLexer('-');
|
||||
tok := FLexer.Next;
|
||||
AssertEquals('Kind', Ord(tkMinus), Ord(tok.Kind));
|
||||
end;
|
||||
|
||||
procedure TLexerTests.TestOp_Star;
|
||||
var
|
||||
tok: TToken;
|
||||
begin
|
||||
SetLexer('*');
|
||||
tok := FLexer.Next;
|
||||
AssertEquals('Kind', Ord(tkStar), Ord(tok.Kind));
|
||||
end;
|
||||
|
||||
procedure TLexerTests.TestOp_Slash;
|
||||
var
|
||||
tok: TToken;
|
||||
begin
|
||||
SetLexer('/');
|
||||
tok := FLexer.Next;
|
||||
AssertEquals('Kind', Ord(tkSlash), Ord(tok.Kind));
|
||||
end;
|
||||
|
||||
procedure TLexerTests.TestOp_Assign;
|
||||
var
|
||||
tok: TToken;
|
||||
begin
|
||||
SetLexer(':=');
|
||||
tok := FLexer.Next;
|
||||
AssertEquals('Kind', Ord(tkAssign), Ord(tok.Kind));
|
||||
AssertEquals('Value', ':=', tok.Value);
|
||||
end;
|
||||
|
||||
procedure TLexerTests.TestOp_Colon;
|
||||
var
|
||||
tok: TToken;
|
||||
begin
|
||||
SetLexer(':');
|
||||
tok := FLexer.Next;
|
||||
AssertEquals('Kind', Ord(tkColon), Ord(tok.Kind));
|
||||
end;
|
||||
|
||||
procedure TLexerTests.TestOp_LParen;
|
||||
var
|
||||
tok: TToken;
|
||||
begin
|
||||
SetLexer('(');
|
||||
tok := FLexer.Next;
|
||||
AssertEquals('Kind', Ord(tkLParen), Ord(tok.Kind));
|
||||
end;
|
||||
|
||||
procedure TLexerTests.TestOp_RParen;
|
||||
var
|
||||
tok: TToken;
|
||||
begin
|
||||
SetLexer(')');
|
||||
tok := FLexer.Next;
|
||||
AssertEquals('Kind', Ord(tkRParen), Ord(tok.Kind));
|
||||
end;
|
||||
|
||||
procedure TLexerTests.TestOp_Comma;
|
||||
var
|
||||
tok: TToken;
|
||||
begin
|
||||
SetLexer(',');
|
||||
tok := FLexer.Next;
|
||||
AssertEquals('Kind', Ord(tkComma), Ord(tok.Kind));
|
||||
end;
|
||||
|
||||
procedure TLexerTests.TestOp_Semicolon;
|
||||
var
|
||||
tok: TToken;
|
||||
begin
|
||||
SetLexer(';');
|
||||
tok := FLexer.Next;
|
||||
AssertEquals('Kind', Ord(tkSemicolon), Ord(tok.Kind));
|
||||
end;
|
||||
|
||||
procedure TLexerTests.TestOp_Dot;
|
||||
var
|
||||
tok: TToken;
|
||||
begin
|
||||
SetLexer('.');
|
||||
tok := FLexer.Next;
|
||||
AssertEquals('Kind', Ord(tkDot), Ord(tok.Kind));
|
||||
end;
|
||||
|
||||
{ Position tracking }
|
||||
|
||||
procedure TLexerTests.TestLineTracking_SecondLine;
|
||||
var
|
||||
tok: TToken;
|
||||
begin
|
||||
SetLexer('begin' + LineEnding + 'end');
|
||||
tok := FLexer.Next;
|
||||
AssertEquals('begin line', 1, tok.Line);
|
||||
tok := FLexer.Next;
|
||||
AssertEquals('end line', 2, tok.Line);
|
||||
end;
|
||||
|
||||
procedure TLexerTests.TestColTracking_AfterSpaces;
|
||||
var
|
||||
tok: TToken;
|
||||
begin
|
||||
SetLexer(' begin');
|
||||
tok := FLexer.Next;
|
||||
AssertEquals('begin col', 3, tok.Col);
|
||||
end;
|
||||
|
||||
{ Token sequences }
|
||||
|
||||
procedure TLexerTests.TestSeq_VarDecl;
|
||||
var
|
||||
t: array[0..3] of TToken;
|
||||
i: Integer;
|
||||
begin
|
||||
SetLexer('x : Integer');
|
||||
for i := 0 to 3 do
|
||||
t[i] := FLexer.Next;
|
||||
AssertEquals('x kind', Ord(tkIdent), Ord(t[0].Kind));
|
||||
AssertEquals('x value', 'x', t[0].Value);
|
||||
AssertEquals(': kind', Ord(tkColon), Ord(t[1].Kind));
|
||||
AssertEquals('Integer kind', Ord(tkIdent), Ord(t[2].Kind));
|
||||
AssertEquals('Integer value', 'Integer', t[2].Value);
|
||||
AssertEquals('EOF', Ord(tkEOF), Ord(t[3].Kind));
|
||||
end;
|
||||
|
||||
procedure TLexerTests.TestSeq_Assignment;
|
||||
var
|
||||
t: array[0..3] of TToken;
|
||||
i: Integer;
|
||||
begin
|
||||
SetLexer('x := 42');
|
||||
for i := 0 to 3 do
|
||||
t[i] := FLexer.Next;
|
||||
AssertEquals('x', Ord(tkIdent), Ord(t[0].Kind));
|
||||
AssertEquals(':=', Ord(tkAssign), Ord(t[1].Kind));
|
||||
AssertEquals('42 kind', Ord(tkIntLit), Ord(t[2].Kind));
|
||||
AssertEquals('42 value', '42', t[2].Value);
|
||||
AssertEquals('EOF', Ord(tkEOF), Ord(t[3].Kind));
|
||||
end;
|
||||
|
||||
procedure TLexerTests.TestSeq_ProcCall;
|
||||
var
|
||||
t: array[0..4] of TToken;
|
||||
i: Integer;
|
||||
begin
|
||||
SetLexer('WriteLn(''hi'')');
|
||||
for i := 0 to 4 do
|
||||
t[i] := FLexer.Next;
|
||||
AssertEquals('WriteLn kind', Ord(tkIdent), Ord(t[0].Kind));
|
||||
AssertEquals('( kind', Ord(tkLParen), Ord(t[1].Kind));
|
||||
AssertEquals('str kind', Ord(tkStringLit), Ord(t[2].Kind));
|
||||
AssertEquals('str value', 'hi', t[2].Value);
|
||||
AssertEquals(') kind', Ord(tkRParen), Ord(t[3].Kind));
|
||||
AssertEquals('EOF', Ord(tkEOF), Ord(t[4].Kind));
|
||||
end;
|
||||
|
||||
initialization
|
||||
RegisterTest(TLexerTests);
|
||||
|
||||
end.
|
||||
425
compiler/src/test/pascal/cp.test.parser.pas
Normal file
425
compiler/src/test/pascal/cp.test.parser.pas
Normal file
|
|
@ -0,0 +1,425 @@
|
|||
unit cp.test.parser;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, fpcunit, testregistry,
|
||||
uLexer, uParser, uAST;
|
||||
|
||||
type
|
||||
TParserTests = class(TTestCase)
|
||||
private
|
||||
function ParseSource(const ASrc: string): TProgram;
|
||||
published
|
||||
{ Program structure }
|
||||
procedure TestMinimalProgram;
|
||||
procedure TestProgramName;
|
||||
procedure TestProgramWithUses;
|
||||
procedure TestProgramWithMultipleUses;
|
||||
|
||||
{ Var block }
|
||||
procedure TestSingleVarDecl;
|
||||
procedure TestMultipleVarDecls;
|
||||
procedure TestMultiNameVarDecl;
|
||||
|
||||
{ Statements }
|
||||
procedure TestEmptyBeginEnd;
|
||||
procedure TestAssignment_IntLit;
|
||||
procedure TestAssignment_StringLit;
|
||||
procedure TestProcCall_NoArgs;
|
||||
procedure TestProcCall_NoParens;
|
||||
procedure TestProcCall_OneStringArg;
|
||||
procedure TestProcCall_OneIntArg;
|
||||
|
||||
{ Expressions }
|
||||
procedure TestExpr_Addition;
|
||||
procedure TestExpr_Subtraction;
|
||||
procedure TestExpr_Multiplication;
|
||||
procedure TestExpr_Precedence_MulBeforeAdd;
|
||||
procedure TestExpr_Parenthesised;
|
||||
procedure TestExpr_IdentInExpr;
|
||||
|
||||
{ Error cases }
|
||||
procedure TestError_MissingProgramKeyword;
|
||||
procedure TestError_MissingDot;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
function TParserTests.ParseSource(const ASrc: string): TProgram;
|
||||
var
|
||||
L: TLexer;
|
||||
P: TParser;
|
||||
begin
|
||||
L := TLexer.Create(ASrc);
|
||||
P := TParser.Create(L);
|
||||
try
|
||||
Result := P.Parse;
|
||||
finally
|
||||
P.Free;
|
||||
L.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
{ Program structure }
|
||||
|
||||
procedure TParserTests.TestMinimalProgram;
|
||||
var
|
||||
Prog: TProgram;
|
||||
begin
|
||||
Prog := ParseSource('program Empty; begin end.');
|
||||
try
|
||||
AssertNotNull('TProgram', Prog);
|
||||
AssertNotNull('Block', Prog.Block);
|
||||
AssertEquals('No decls', 0, Prog.Block.Decls.Count);
|
||||
AssertEquals('No stmts', 0, Prog.Block.Stmts.Count);
|
||||
finally
|
||||
Prog.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TParserTests.TestProgramName;
|
||||
var
|
||||
Prog: TProgram;
|
||||
begin
|
||||
Prog := ParseSource('program MyApp; begin end.');
|
||||
try
|
||||
AssertEquals('Name', 'MyApp', Prog.Name);
|
||||
finally
|
||||
Prog.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TParserTests.TestProgramWithUses;
|
||||
var
|
||||
Prog: TProgram;
|
||||
begin
|
||||
Prog := ParseSource('program P; uses System; begin end.');
|
||||
try
|
||||
AssertEquals('Uses count', 1, Prog.Uses.Count);
|
||||
AssertEquals('Unit name', 'System', Prog.Uses[0]);
|
||||
finally
|
||||
Prog.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TParserTests.TestProgramWithMultipleUses;
|
||||
var
|
||||
Prog: TProgram;
|
||||
begin
|
||||
Prog := ParseSource('program P; uses System, SysUtils; begin end.');
|
||||
try
|
||||
AssertEquals('Uses count', 2, Prog.Uses.Count);
|
||||
AssertEquals('First', 'System', Prog.Uses[0]);
|
||||
AssertEquals('Second', 'SysUtils', Prog.Uses[1]);
|
||||
finally
|
||||
Prog.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
{ Var block }
|
||||
|
||||
procedure TParserTests.TestSingleVarDecl;
|
||||
var
|
||||
Prog: TProgram;
|
||||
Decl: TVarDecl;
|
||||
begin
|
||||
Prog := ParseSource('program P; var x: Integer; begin end.');
|
||||
try
|
||||
AssertEquals('1 decl', 1, Prog.Block.Decls.Count);
|
||||
Decl := TVarDecl(Prog.Block.Decls[0]);
|
||||
AssertEquals('1 name', 1, Decl.Names.Count);
|
||||
AssertEquals('Name', 'x', Decl.Names[0]);
|
||||
AssertEquals('Type', 'Integer', Decl.TypeName);
|
||||
finally
|
||||
Prog.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TParserTests.TestMultipleVarDecls;
|
||||
var
|
||||
Prog: TProgram;
|
||||
begin
|
||||
Prog := ParseSource(
|
||||
'program P; var x: Integer; s: string; begin end.');
|
||||
try
|
||||
AssertEquals('2 decls', 2, Prog.Block.Decls.Count);
|
||||
AssertEquals('First type', 'Integer',
|
||||
TVarDecl(Prog.Block.Decls[0]).TypeName);
|
||||
AssertEquals('Second type', 'string',
|
||||
TVarDecl(Prog.Block.Decls[1]).TypeName);
|
||||
finally
|
||||
Prog.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TParserTests.TestMultiNameVarDecl;
|
||||
var
|
||||
Prog: TProgram;
|
||||
Decl: TVarDecl;
|
||||
begin
|
||||
Prog := ParseSource('program P; var x, y: Integer; begin end.');
|
||||
try
|
||||
AssertEquals('1 decl group', 1, Prog.Block.Decls.Count);
|
||||
Decl := TVarDecl(Prog.Block.Decls[0]);
|
||||
AssertEquals('2 names', 2, Decl.Names.Count);
|
||||
AssertEquals('First', 'x', Decl.Names[0]);
|
||||
AssertEquals('Second', 'y', Decl.Names[1]);
|
||||
finally
|
||||
Prog.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
{ Statements }
|
||||
|
||||
procedure TParserTests.TestEmptyBeginEnd;
|
||||
var
|
||||
Prog: TProgram;
|
||||
begin
|
||||
Prog := ParseSource('program P; begin end.');
|
||||
try
|
||||
AssertEquals('No stmts', 0, Prog.Block.Stmts.Count);
|
||||
finally
|
||||
Prog.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TParserTests.TestAssignment_IntLit;
|
||||
var
|
||||
Prog: TProgram;
|
||||
Assign: TAssignment;
|
||||
Lit: TIntLiteral;
|
||||
begin
|
||||
Prog := ParseSource('program P; var n: Integer; begin n := 42 end.');
|
||||
try
|
||||
AssertEquals('1 stmt', 1, Prog.Block.Stmts.Count);
|
||||
AssertTrue('Is TAssignment',
|
||||
Prog.Block.Stmts[0] is TAssignment);
|
||||
Assign := TAssignment(Prog.Block.Stmts[0]);
|
||||
AssertEquals('Name', 'n', Assign.Name);
|
||||
AssertTrue('Expr is TIntLiteral', Assign.Expr is TIntLiteral);
|
||||
Lit := TIntLiteral(Assign.Expr);
|
||||
AssertEquals('Value', 42, Lit.Value);
|
||||
finally
|
||||
Prog.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TParserTests.TestAssignment_StringLit;
|
||||
var
|
||||
Prog: TProgram;
|
||||
Assign: TAssignment;
|
||||
begin
|
||||
Prog := ParseSource(
|
||||
'program P; var s: string; begin s := ''hello'' end.');
|
||||
try
|
||||
Assign := TAssignment(Prog.Block.Stmts[0]);
|
||||
AssertTrue('Expr is TStringLiteral', Assign.Expr is TStringLiteral);
|
||||
AssertEquals('Value', 'hello',
|
||||
TStringLiteral(Assign.Expr).Value);
|
||||
finally
|
||||
Prog.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TParserTests.TestProcCall_NoArgs;
|
||||
var
|
||||
Prog: TProgram;
|
||||
Call: TProcCall;
|
||||
begin
|
||||
Prog := ParseSource('program P; begin WriteLn() end.');
|
||||
try
|
||||
AssertTrue('Is TProcCall',
|
||||
Prog.Block.Stmts[0] is TProcCall);
|
||||
Call := TProcCall(Prog.Block.Stmts[0]);
|
||||
AssertEquals('Name', 'WriteLn', Call.Name);
|
||||
AssertEquals('0 args', 0, Call.Args.Count);
|
||||
finally
|
||||
Prog.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TParserTests.TestProcCall_NoParens;
|
||||
var
|
||||
Prog: TProgram;
|
||||
Call: TProcCall;
|
||||
begin
|
||||
Prog := ParseSource('program P; begin WriteLn end.');
|
||||
try
|
||||
Call := TProcCall(Prog.Block.Stmts[0]);
|
||||
AssertEquals('Name', 'WriteLn', Call.Name);
|
||||
AssertEquals('0 args', 0, Call.Args.Count);
|
||||
finally
|
||||
Prog.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TParserTests.TestProcCall_OneStringArg;
|
||||
var
|
||||
Prog: TProgram;
|
||||
Call: TProcCall;
|
||||
begin
|
||||
Prog := ParseSource('program P; begin WriteLn(''Hello'') end.');
|
||||
try
|
||||
Call := TProcCall(Prog.Block.Stmts[0]);
|
||||
AssertEquals('1 arg', 1, Call.Args.Count);
|
||||
AssertTrue('Arg is TStringLiteral',
|
||||
Call.Args[0] is TStringLiteral);
|
||||
AssertEquals('Value', 'Hello',
|
||||
TStringLiteral(Call.Args[0]).Value);
|
||||
finally
|
||||
Prog.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TParserTests.TestProcCall_OneIntArg;
|
||||
var
|
||||
Prog: TProgram;
|
||||
Call: TProcCall;
|
||||
begin
|
||||
Prog := ParseSource('program P; begin WriteLn(99) end.');
|
||||
try
|
||||
Call := TProcCall(Prog.Block.Stmts[0]);
|
||||
AssertEquals('1 arg', 1, Call.Args.Count);
|
||||
AssertTrue('Arg is TIntLiteral', Call.Args[0] is TIntLiteral);
|
||||
AssertEquals('Value', 99, TIntLiteral(Call.Args[0]).Value);
|
||||
finally
|
||||
Prog.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
{ Expressions }
|
||||
|
||||
procedure TParserTests.TestExpr_Addition;
|
||||
var
|
||||
Prog: TProgram;
|
||||
Bin: TBinaryExpr;
|
||||
begin
|
||||
Prog := ParseSource(
|
||||
'program P; var n: Integer; begin n := 1 + 2 end.');
|
||||
try
|
||||
Bin := TBinaryExpr(TAssignment(Prog.Block.Stmts[0]).Expr);
|
||||
AssertEquals('Op', Ord(boAdd), Ord(Bin.Op));
|
||||
AssertEquals('Left', 1, TIntLiteral(Bin.Left).Value);
|
||||
AssertEquals('Right', 2, TIntLiteral(Bin.Right).Value);
|
||||
finally
|
||||
Prog.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TParserTests.TestExpr_Subtraction;
|
||||
var
|
||||
Prog: TProgram;
|
||||
Bin: TBinaryExpr;
|
||||
begin
|
||||
Prog := ParseSource(
|
||||
'program P; var n: Integer; begin n := 10 - 3 end.');
|
||||
try
|
||||
Bin := TBinaryExpr(TAssignment(Prog.Block.Stmts[0]).Expr);
|
||||
AssertEquals('Op', Ord(boSub), Ord(Bin.Op));
|
||||
finally
|
||||
Prog.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TParserTests.TestExpr_Multiplication;
|
||||
var
|
||||
Prog: TProgram;
|
||||
Bin: TBinaryExpr;
|
||||
begin
|
||||
Prog := ParseSource(
|
||||
'program P; var n: Integer; begin n := 3 * 4 end.');
|
||||
try
|
||||
Bin := TBinaryExpr(TAssignment(Prog.Block.Stmts[0]).Expr);
|
||||
AssertEquals('Op', Ord(boMul), Ord(Bin.Op));
|
||||
finally
|
||||
Prog.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TParserTests.TestExpr_Precedence_MulBeforeAdd;
|
||||
var
|
||||
Prog: TProgram;
|
||||
Outer: TBinaryExpr;
|
||||
Inner: TBinaryExpr;
|
||||
begin
|
||||
{ 1 + 2 * 3 should parse as 1 + (2 * 3) }
|
||||
Prog := ParseSource(
|
||||
'program P; var n: Integer; begin n := 1 + 2 * 3 end.');
|
||||
try
|
||||
Outer := TBinaryExpr(TAssignment(Prog.Block.Stmts[0]).Expr);
|
||||
AssertEquals('Outer op is Add', Ord(boAdd), Ord(Outer.Op));
|
||||
AssertTrue('Right is TBinaryExpr', Outer.Right is TBinaryExpr);
|
||||
Inner := TBinaryExpr(Outer.Right);
|
||||
AssertEquals('Inner op is Mul', Ord(boMul), Ord(Inner.Op));
|
||||
finally
|
||||
Prog.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TParserTests.TestExpr_Parenthesised;
|
||||
var
|
||||
Prog: TProgram;
|
||||
Outer: TBinaryExpr;
|
||||
Inner: TBinaryExpr;
|
||||
begin
|
||||
{ (1 + 2) * 3 — outer should be Mul, left child is Add }
|
||||
Prog := ParseSource(
|
||||
'program P; var n: Integer; begin n := (1 + 2) * 3 end.');
|
||||
try
|
||||
Outer := TBinaryExpr(TAssignment(Prog.Block.Stmts[0]).Expr);
|
||||
AssertEquals('Outer op is Mul', Ord(boMul), Ord(Outer.Op));
|
||||
AssertTrue('Left is TBinaryExpr', Outer.Left is TBinaryExpr);
|
||||
Inner := TBinaryExpr(Outer.Left);
|
||||
AssertEquals('Inner op is Add', Ord(boAdd), Ord(Inner.Op));
|
||||
finally
|
||||
Prog.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TParserTests.TestExpr_IdentInExpr;
|
||||
var
|
||||
Prog: TProgram;
|
||||
Assign: TAssignment;
|
||||
Bin: TBinaryExpr;
|
||||
begin
|
||||
Prog := ParseSource(
|
||||
'program P; var x, y: Integer; begin y := x + 1 end.');
|
||||
try
|
||||
Assign := TAssignment(Prog.Block.Stmts[0]);
|
||||
Bin := TBinaryExpr(Assign.Expr);
|
||||
AssertTrue('Left is TIdentExpr', Bin.Left is TIdentExpr);
|
||||
AssertEquals('Ident name', 'x', TIdentExpr(Bin.Left).Name);
|
||||
finally
|
||||
Prog.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
{ Error cases }
|
||||
|
||||
procedure TParserTests.TestError_MissingProgramKeyword;
|
||||
begin
|
||||
try
|
||||
ParseSource('begin end.').Free;
|
||||
Fail('Expected EParseError');
|
||||
except
|
||||
on E: EParseError do ; { expected }
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TParserTests.TestError_MissingDot;
|
||||
begin
|
||||
try
|
||||
ParseSource('program P; begin end').Free;
|
||||
Fail('Expected EParseError');
|
||||
except
|
||||
on E: EParseError do ; { expected }
|
||||
end;
|
||||
end;
|
||||
|
||||
initialization
|
||||
RegisterTest(TParserTests);
|
||||
|
||||
end.
|
||||
|
|
@ -1,4 +1,4 @@
|
|||
= Modern Object Pascal Compiler — Clean Pascal
|
||||
= Blaise — Modern Object Pascal Compiler
|
||||
:doctype: article
|
||||
:toc: left
|
||||
:toclevels: 3
|
||||
|
|
@ -250,14 +250,14 @@ PasBuild invokes the compiler binary as:
|
|||
|
||||
[source,shell]
|
||||
----
|
||||
cleanpascal --project project.xml --config debug --output bin/hello
|
||||
blaise --project project.xml --config debug --output bin/hello
|
||||
----
|
||||
|
||||
Or for single-file compilation during bootstrap:
|
||||
|
||||
[source,shell]
|
||||
----
|
||||
cleanpascal --source Hello.pas --output bin/hello --target linux-x86_64
|
||||
blaise --source Hello.pas --output bin/hello --target linux-x86_64
|
||||
----
|
||||
|
||||
Supported flags:
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<project>
|
||||
<name>clean-pascal</name>
|
||||
<name>blaise</name>
|
||||
<version>0.1.0-SNAPSHOT</version>
|
||||
<author>Graeme Geldenhuys</author>
|
||||
<license>BSD-3-Clause</license>
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<project>
|
||||
<name>clean-pascal-rtl</name>
|
||||
<name>blaise-rtl</name>
|
||||
<!-- version inherited from root aggregator -->
|
||||
|
||||
<build>
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<project>
|
||||
<name>clean-pascal-migration</name>
|
||||
<name>blaise-migration</name>
|
||||
<!-- version inherited from root aggregator -->
|
||||
|
||||
<build>
|
||||
|
|
|
|||
Loading…
Reference in a new issue