administrator/blaise
1
0
Fork 0
Code Issues Pull requests Actions Packages Projects Releases Wiki Activity

feat(parser): resolve unit-qualified symbols UnitName.Symbol

Browse source 
A reference written `Unit.Symbol` (a procedure/function call, variable, or
constant qualified by a used unit) previously failed to resolve: the parser
built it as a record/field or method-call chain rooted at the unit name, and
the analyser then rejected the unit name as an undeclared variable.

Collapse the qualifier in the parser instead.  Each `uses` clause feeds a
name list (plus the implicit System), consulted purely as syntax — no symbol
or type lookup — to recognise a leading run that spells a used unit followed
by a trailing `.Symbol`.  On a match the unit prefix is dropped, leaving the
bare symbol, which the existing uses-chain resolution and codegen already
handle.  Producing canonical TProcCall / TFuncCallExpr / TIdentExpr nodes
keeps the change entirely in the front end.

The unit name may be dotted to any depth (System.SysUtils.Foo, A.B.C.D.Sym):
an on-demand lookahead buffer scans the whole dotted chain, exposed through
scalar peek accessors (kind/value/line/col) so no transient TToken records —
which carry a managed string — are produced on the matcher's hot path.  The
required trailing `.Symbol` is what distinguishes a qualifier from a
same-prefixed record/field chain, so `My.Pkg := 4` (record `My`, field `Pkg`,
with `My.Pkg` also a used unit) is left untouched.

Known limitation: in the rare case where a dotted unit's first component is
also an in-scope variable (`var My` + `uses My.Pkg`, then `My.Pkg.Foo`), FPC
resolves the variable; the parser has no scope and resolves the unit.  Single-
identifier units cannot collide this way (a variable sharing a unit's name is
a duplicate-identifier error).

Tests: cp.test.parser asserts the canonical-node collapse at one, two, and
three component depths, plus the two negative cases (non-unit receiver stays a
method call; no-trailing-symbol stays a field write).  cp.test.e2e.useschain
compiles and runs qualified System calls and qualified cross-unit calls/vars
through single and dotted unit names.
This commit is contained in:
Andrew Haines 2026-06-24 17:40:18 -04:00 committed by Graeme Geldenhuys
parent dc3b7a1c2e
commit 3c092babc6
3 changed files with 391 additions and 1 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

205
compiler/src/main/pascal/uParser.pas
View file

@ -50,7 +50,25 @@ type
FCurrent: TToken;
FLookahead: TToken; { one-token lookahead }
FLookahead2: TToken; { two-token lookahead for generic disambiguation }
FAhead: array of TToken; { tokens beyond FLookahead2 (FIFO), filled on
demand by PeekTok for unbounded lookahead }
FUsedUnits: TStringList; { unit names from every 'uses' clause, plus implicit
'System'. Consulted purely as a syntactic name list
to recognise 'UnitName.Symbol' — no symbol lookup. }
function IsUsedUnit(const AName: string): Boolean;
function IsUnitPrefix(const AName: string): Boolean;
{ Unbounded lookahead, exposed as scalar accessors (0 = FCurrent). A
TToken-returning peek is deliberately avoided — TToken carries a managed
string, and returning it by value would create transient managed records
in the hot matcher path. }
procedure EnsureAhead(N: Integer);
function PeekKindAt(N: Integer): TTokenKind;
function PeekValueAt(N: Integer): string;
function PeekLineAt(N: Integer): Integer;
function PeekColAt(N: Integer): Integer;
function TryCollapseUnitQualifier(var AName: string;
var ALine, ACol: Integer): Boolean;
procedure Advance;
function PeekKind(): TTokenKind;
function PeekKind2(): TTokenKind; { two tokens ahead }
@ -122,6 +140,7 @@ type
procedure ParseMethodCallArgList(ACall: TMethodCallStmt);
public
constructor Create(ALexer: TLexer);
destructor Destroy; override;
function Parse: TProgram;
function ParseUnit: TUnit;
{ True iff the primed first token is `unit` — caller forks to
@ -135,16 +154,37 @@ constructor TParser.Create(ALexer: TLexer);
begin
inherited Create();
FLexer := ALexer;
FUsedUnits := TStringList.Create();
{ 'System' is implicitly used by every compilation unit. }
FUsedUnits.Add('System');
FCurrent := FLexer.Next();
FLookahead := FLexer.Next();
FLookahead2 := FLexer.Next();
end;
destructor TParser.Destroy;
begin
FUsedUnits.Free();
inherited Destroy();
end;
procedure TParser.Advance;
var
I: Integer;
begin
FCurrent := FLookahead;
FLookahead := FLookahead2;
FLookahead2 := FLexer.Next();
{ Drain the on-demand lookahead buffer first (tokens PeekTok pre-read), so
consumption order is preserved; fall back to the lexer when it is empty. }
if Length(FAhead) > 0 then
begin
FLookahead2 := FAhead[0];
for I := 1 to High(FAhead) do
FAhead[I - 1] := FAhead[I];
SetLength(FAhead, Length(FAhead) - 1);
end
else
FLookahead2 := FLexer.Next();
end;
function TParser.PeekKind(): TTokenKind;
@ -157,6 +197,153 @@ begin
Result := FLookahead2.Kind;
end;
{ Ensure the on-demand lookahead buffer holds enough tokens that conceptual
index N (>= 3) maps to FAhead[N - 3]. Tokens are pulled from the lexer and
held (FIFO) until consumed by Advance. Lets the unit-qualifier matcher
inspect a whole dotted chain of any depth before consuming any of it. }
procedure TParser.EnsureAhead(N: Integer);
var
T: TToken;
begin
while Length(FAhead) < (N - 2) do
begin
T := FLexer.Next();
SetLength(FAhead, Length(FAhead) + 1);
FAhead[High(FAhead)] := T;
end;
end;
{ Kind of the token N positions ahead of FCurrent (0=FCurrent, 1=FLookahead,
2=FLookahead2, 3+ from FAhead). }
function TParser.PeekKindAt(N: Integer): TTokenKind;
begin
case N of
0: Exit(FCurrent.Kind);
1: Exit(FLookahead.Kind);
2: Exit(FLookahead2.Kind);
end;
EnsureAhead(N);
Result := FAhead[N - 3].Kind;
end;
{ Value text of the token N positions ahead. }
function TParser.PeekValueAt(N: Integer): string;
begin
case N of
0: Exit(FCurrent.Value);
1: Exit(FLookahead.Value);
2: Exit(FLookahead2.Value);
end;
EnsureAhead(N);
Result := FAhead[N - 3].Value;
end;
function TParser.PeekLineAt(N: Integer): Integer;
begin
case N of
0: Exit(FCurrent.Line);
1: Exit(FLookahead.Line);
2: Exit(FLookahead2.Line);
end;
EnsureAhead(N);
Result := FAhead[N - 3].Line;
end;
function TParser.PeekColAt(N: Integer): Integer;
begin
case N of
0: Exit(FCurrent.Col);
1: Exit(FLookahead.Col);
2: Exit(FLookahead2.Col);
end;
EnsureAhead(N);
Result := FAhead[N - 3].Col;
end;
{ Case-insensitive membership test against the parsed 'uses' names. }
function TParser.IsUsedUnit(const AName: string): Boolean;
var
I: Integer;
begin
for I := 0 to FUsedUnits.Count - 1 do
if SameText(FUsedUnits.Strings[I], AName) then
Exit(True);
Result := False;
end;
{ True iff AName is a used unit OR a dotted prefix of one (some used unit equals
AName or begins with 'AName.'). Lets the matcher stop extending a candidate
the moment it can no longer complete any unit name. }
function TParser.IsUnitPrefix(const AName: string): Boolean;
var
I: Integer;
U: string;
begin
for I := 0 to FUsedUnits.Count - 1 do
begin
U := FUsedUnits.Strings[I];
if SameText(U, AName) then Exit(True);
{ U begins with 'AName.' — StrHead is 0-based (Blaise strings are 0-indexed). }
if (Length(U) > Length(AName) + 1) and
SameText(StrHead(U, Length(AName) + 1), AName + '.') then Exit(True);
end;
Result := False;
end;
{ Recognise a unit-qualified reference 'Unit.Symbol' where Unit is the LONGEST
dotted prefix (starting at AName) that exactly names a used unit and is
followed by a trailing '.Symbol'. The 'uses' name list bounds how far to
scan, so any unit-name depth works (System.SysUtils.Foo, A.B.C.D.Sym, ...).
Cursor on entry: AName has just been consumed, so FCurrent is the '.' before
the first extra component. Component idents after AName therefore sit at peek
indices 1, 3, 5, ... with the separating dots at 0, 2, 4, ...
On a match the unit name and its trailing dot are consumed, AName/ALine/ACol
become the bare Symbol (cursor left just past it), and the caller proceeds as
if it had read an unqualified reference. On no match NOTHING is consumed, so
a same-prefixed record/field chain (My.Pkg := x) is left intact — the required
trailing '.Symbol' is what distinguishes the two. }
function TParser.TryCollapseUnitQualifier(var AName: string;
var ALine, ACol: Integer): Boolean;
var
Cand: string;
Comps, BestComps, J, DotIdx, IdentIdx: Integer;
begin
Result := False;
Cand := AName;
Comps := 0;
if IsUsedUnit(Cand) then BestComps := 0 else BestComps := -1;
{ Greedily absorb '.ident' components while the candidate stays a viable unit
prefix; remember the longest position that is an exact used-unit match. }
J := 1;
while True do
begin
DotIdx := 2 * (J - 1);
IdentIdx := 2 * J - 1;
if (PeekKindAt(DotIdx) <> tkDot) or (PeekKindAt(IdentIdx) <> tkIdent) then
Break;
if not IsUnitPrefix(Cand + '.' + PeekValueAt(IdentIdx)) then
Break;
Cand := Cand + '.' + PeekValueAt(IdentIdx);
Comps := J;
if IsUsedUnit(Cand) then BestComps := Comps;
Inc(J);
end;
if BestComps < 0 then Exit; { AName does not lead to a used unit }
{ A trailing '.Symbol' must follow the matched unit, else this is a bare unit
reference or a same-prefixed value chain — leave it for the normal parser. }
DotIdx := 2 * BestComps;
IdentIdx := 2 * BestComps + 1;
if (PeekKindAt(DotIdx) <> tkDot) or (PeekKindAt(IdentIdx) <> tkIdent) then
Exit;
AName := PeekValueAt(IdentIdx);
ALine := PeekLineAt(IdentIdx);
ACol := PeekColAt(IdentIdx);
for J := 1 to IdentIdx + 1 do Advance(); { consume unit name, dot, symbol }
Result := True;
end;
function TParser.ReadConstBoundText: string;
var
Depth: Integer;
@ -618,6 +805,7 @@ begin
Advance();
end;
AList.Add(UName);
FUsedUnits.Add(UName);
while Check(tkComma) do
begin
Advance();
@ -636,6 +824,7 @@ begin
Advance();
end;
AList.Add(UName);
FUsedUnits.Add(UName);
end;
Expect(tkSemicolon);
end;
@ -2671,6 +2860,13 @@ begin
Col := FCurrent.Col;
Advance();
{ Unit-qualified statement target 'Unit.Symbol' (Unit may be dotted to any
depth). Collapse to the bare symbol so the rest of the statement parser
treats it as an unqualified procedure call or assignment target resolved
through the uses chain. No-op (consumes nothing) for a same-prefixed
record/field chain — see TryCollapseUnitQualifier. }
TryCollapseUnitQualifier(Name, Line, Col);
if Check(tkLBracket) then
begin
{ Subscript on the statement LHS. Three shapes:
@ -4444,6 +4640,13 @@ begin
Line := FCurrent.Line;
Col := FCurrent.Col;
Advance();
{ Unit-qualified reference 'Unit.Symbol' (Unit may be dotted to any
depth). Collapse to the bare Symbol and reposition the origin to it,
so everything below resolves Symbol through the uses chain as an
unqualified reference — a free call when '(' follows, otherwise a
plain identifier / indexed / chained / generic access. No-op for a
same-prefixed record/field chain. }
TryCollapseUnitQualifier(Name, Line, Col);
{ Generic constructor: TypeName<Args>.Method or diamond TypeName<>.Method
Heuristic: '<' followed by IDENT followed by '>' or ',' is treated as
generic type args. '<>' (empty) is the diamond operator — type args

89
compiler/src/test/pascal/cp.test.e2e.useschain.pas
View file

@ -29,6 +29,10 @@ type
procedure TestRun_ImplicitSystem_NoUsesClause_WriteLnInt;
procedure TestRun_ImplicitSystem_NoUsesClause_IntToStr;
procedure TestRun_ImplicitSystem_NoUsesClause_Length;
{ Unit-qualified symbol references 'UnitName.Symbol'. }
procedure TestRun_QualifiedSystem_CallExprAndStmt;
procedure TestRun_QualifiedUnit_CallAndVar;
procedure TestRun_DottedQualifiedUnit_CallAndVar;
end;
implementation
@ -98,6 +102,91 @@ begin
AssertEquals('Length(''hello'')', '5' + LE, Output);
end;
procedure TE2EUsesChainTests.TestRun_QualifiedSystem_CallExprAndStmt;
const
Src = '''
program P;
begin
System.WriteLn(System.Length('hello'))
end.
''';
var Output: string; RCode: Integer;
begin
if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit; end;
{ 'System.WriteLn' (qualified call statement) and 'System.Length(...)'
(qualified call expression) both resolve via the implicit System unit. }
AssertTrue(CompileAndRun(Src, Output, RCode));
AssertEquals('exit 0', 0, RCode);
AssertEquals('Length(''hello'') = 5', '5' + LE, Output);
end;
procedure TE2EUsesChainTests.TestRun_QualifiedUnit_CallAndVar;
const
UnitSrc = '''
unit qsym;
interface
function Add3(N: Integer): Integer;
var
GBase: Integer;
implementation
function Add3(N: Integer): Integer;
begin
Result := N + 3
end;
end.
''';
DrvSrc = '''
program P;
uses qsym;
begin
qsym.GBase := 10;
WriteLn(qsym.Add3(qsym.GBase))
end.
''';
var Output: string; RCode: Integer;
begin
if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit; end;
{ Qualified assignment target (qsym.GBase :=), qualified var read
(qsym.GBase), and qualified function call (qsym.Add3) across a used unit. }
AssertTrue('compile+link+run',
CompileAndRunWithUnit('qsym', UnitSrc, DrvSrc, Output, RCode));
AssertEquals('exit 0', 0, RCode);
AssertEquals('Add3(10) = 13', '13' + LE, Output);
end;
procedure TE2EUsesChainTests.TestRun_DottedQualifiedUnit_CallAndVar;
const
UnitSrc = '''
unit My.Pkg;
interface
function Add3(N: Integer): Integer;
var
GBase: Integer;
implementation
function Add3(N: Integer): Integer;
begin
Result := N + 3
end;
end.
''';
DrvSrc = '''
program P;
uses My.Pkg;
begin
My.Pkg.GBase := 10;
WriteLn(My.Pkg.Add3(My.Pkg.GBase))
end.
''';
var Output: string; RCode: Integer;
begin
if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit; end;
{ Same as above but through a two-part dotted unit name 'My.Pkg'. }
AssertTrue('compile+link+run',
CompileAndRunWithUnit('My.Pkg', UnitSrc, DrvSrc, Output, RCode));
AssertEquals('exit 0', 0, RCode);
AssertEquals('Add3(10) = 13', '13' + LE, Output);
end;
initialization
RegisterTest(TE2EUsesChainTests);

98
compiler/src/test/pascal/cp.test.parser.pas
View file

@ -34,6 +34,14 @@ type
procedure TestQualifiedTypeName;
procedure TestQualifiedTypeName_DottedUnit;
{ Unit-qualified symbols 'UnitName.Symbol' collapse to the bare symbol
(resolved later through the uses chain), at any unit-name depth. }
procedure TestUnitQualifiedProcCall_Collapses;
procedure TestUnitQualifiedRef_Collapses;
procedure TestDottedUnitQualifiedProcCall_Collapses;
procedure TestNonUnitQualifier_StaysMethodCall;
procedure TestUnitQualifierNoTrailingSymbol_StaysFieldWrite;
{ Statements }
procedure TestEmptyBeginEnd;
procedure TestAssignment_IntLit;
@ -205,6 +213,96 @@ begin
end;
end;
procedure TParserTests.TestUnitQualifiedProcCall_Collapses;
var
Prog: TProgram;
Call: TProcCall;
begin
{ 'MyUnit.DoIt()' with MyUnit in the uses clause collapses to a bare free
call 'DoIt()' — the qualifier is dropped by the parser. }
Prog := ParseSource('program P; uses MyUnit; begin MyUnit.DoIt() end.');
try
AssertTrue('collapsed to TProcCall',
Prog.Block.Stmts.Items[0] is TProcCall);
Call := TProcCall(Prog.Block.Stmts.Items[0]);
AssertEquals('bare symbol name', 'DoIt', Call.Name);
finally
Prog.Free();
end;
end;
procedure TParserTests.TestUnitQualifiedRef_Collapses;
var
Prog: TProgram;
Assign: TAssignment;
begin
{ 'MyUnit.Val' in expression position collapses to a bare identifier. }
Prog := ParseSource(
'program P; uses MyUnit; var x: Integer; begin x := MyUnit.Val end.');
try
Assign := TAssignment(Prog.Block.Stmts.Items[0]);
AssertTrue('RHS collapsed to TIdentExpr', Assign.Expr is TIdentExpr);
AssertEquals('bare symbol name', 'Val', TIdentExpr(Assign.Expr).Name);
finally
Prog.Free();
end;
end;
procedure TParserTests.TestDottedUnitQualifiedProcCall_Collapses;
var
Prog: TProgram;
Call: TProcCall;
begin
{ The unit qualifier may be dotted to any depth (here three components). }
Prog := ParseSource('program P; uses A.B.C; begin A.B.C.DoIt() end.');
try
AssertTrue('collapsed to TProcCall',
Prog.Block.Stmts.Items[0] is TProcCall);
Call := TProcCall(Prog.Block.Stmts.Items[0]);
AssertEquals('bare symbol name', 'DoIt', Call.Name);
finally
Prog.Free();
end;
end;
procedure TParserTests.TestNonUnitQualifier_StaysMethodCall;
var
Prog: TProgram;
begin
{ 'r.DoIt()' where 'r' is NOT a used unit stays an object method call —
the parser must not collapse a plain receiver. }
Prog := ParseSource('program P; begin r.DoIt() end.');
try
AssertTrue('stays a method call on the receiver',
Prog.Block.Stmts.Items[0] is TMethodCallStmt);
AssertEquals('receiver kept', 'r',
TMethodCallStmt(Prog.Block.Stmts.Items[0]).ObjectName);
finally
Prog.Free();
end;
end;
procedure TParserTests.TestUnitQualifierNoTrailingSymbol_StaysFieldWrite;
var
Prog: TProgram;
Fld: TFieldAssignment;
begin
{ 'My.Pkg := 4' where 'My.Pkg' is a used unit but no '.Symbol' follows is a
record field write, NOT a unit qualifier — the trailing symbol is what
distinguishes the two, so this must stay a TFieldAssignment. }
Prog := ParseSource(
'program P; uses My.Pkg; var My: Integer; begin My.Pkg := 4 end.');
try
AssertTrue('stays a field assignment',
Prog.Block.Stmts.Items[0] is TFieldAssignment);
Fld := TFieldAssignment(Prog.Block.Stmts.Items[0]);
AssertEquals('record name kept', 'My', Fld.RecordName);
AssertEquals('field name kept', 'Pkg', Fld.FieldName);
finally
Prog.Free();
end;
end;
procedure TParserTests.TestMultipleVarDecls;
var
Prog: TProgram;