From 3c092babc66dc422ab532e93aed1cf24176a4aef Mon Sep 17 00:00:00 2001 From: Andrew Haines Date: Wed, 24 Jun 2026 17:40:18 -0400 Subject: [PATCH] feat(parser): resolve unit-qualified symbols UnitName.Symbol MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit 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. --- compiler/src/main/pascal/uParser.pas | 205 +++++++++++++++++- .../src/test/pascal/cp.test.e2e.useschain.pas | 89 ++++++++ compiler/src/test/pascal/cp.test.parser.pas | 98 +++++++++ 3 files changed, 391 insertions(+), 1 deletion(-) diff --git a/compiler/src/main/pascal/uParser.pas b/compiler/src/main/pascal/uParser.pas index 193b2e5..b296a84 100644 --- a/compiler/src/main/pascal/uParser.pas +++ b/compiler/src/main/pascal/uParser.pas @@ -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.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 diff --git a/compiler/src/test/pascal/cp.test.e2e.useschain.pas b/compiler/src/test/pascal/cp.test.e2e.useschain.pas index fbe1669..71adc36 100644 --- a/compiler/src/test/pascal/cp.test.e2e.useschain.pas +++ b/compiler/src/test/pascal/cp.test.e2e.useschain.pas @@ -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); diff --git a/compiler/src/test/pascal/cp.test.parser.pas b/compiler/src/test/pascal/cp.test.parser.pas index 4bc6e6f..4783d76 100644 --- a/compiler/src/test/pascal/cp.test.parser.pas +++ b/compiler/src/test/pascal/cp.test.parser.pas @@ -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;