From df1cd1e18596e393bfd09f23d44fd5fe00a68724 Mon Sep 17 00:00:00 2001 From: Colby Mchenry Date: Thu, 22 Oct 2026 22:42:08 +0000 Subject: [PATCH] fix(pascal): Delphi units with re-published properties and similar syntax parse whole (#2816) MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit SynEdit's main unit parsed into one ERROR node on main. A re-published property, `property OwnsObjects;` at line 303, is one of several Delphi constructs tree-sitter-pascal has no rule for. Each breaks the parse locally, and enough of them cost a whole unit: routines after a break lost their calls or had them credited to the file, their locals showed up as unit variables, and class members after an unnamed record went missing. The Pascal pre-parse now fixes each construct in place, offsets and newlines kept (signatures still read the source as written): - a re-published property (`property Cursor default crIBeam;`) is blanked; - a conditional right after a routine's header that holds no whole body (`{$IFDEF HASINLINE}inline;{$ENDIF}`) has its directives blanked, and so does one nested at the start of a conditional that holds no block; - branches that open the same `begin` keep only the first one, and an assembler version that opens a body beside a Pascal one is blanked; - a re-raise is blanked, or written as `;` right before an `end`; - an unnamed record type (`fIn: record … end`) is written as `string` with its fields blanked, so the declaration keeps its name; - a label right before `end` is blanked; - alternative statements after a case label, or after then/else/do without a `;`, read as one block: the directives become begin, `;` and end, so every branch keeps its calls. The last fix also undoes a regression the header fix caused alone: in HeidiSQL's SynRegExpr.pas a case statement full of `{$IFDEF}` alternatives broke the unit once main's accidental resync points were gone (659 references lost). With all fixes it has 1,712 against main's 1,681. Also fixed on the way: a routine nested in another credited the constants its parent's body reads to itself, when it was the last one before the body (the value-ref scan pulled in the next sibling, which is the outer routine's body). Validation: pascal-delphi-syntax (17 tests, 13 fail on main) and a new pascal-nested-routines case (fails on main); 14 mutations, one per rule and three guards, each fail a test. Two pascal-system-calls fixtures broke the parse on purpose with constructs this now reads; they use an old-style `begin … end.` initialization and an anonymous record holding a method instead, which still break it, and still fail when the guard they cover is removed. Parse census, main -> fix, files without a unit node: SynEdit 4 -> 1, HeidiSQL 6 -> 1, DelphiMVCFramework 15 -> 1, mORMot2 34 -> 6, DWScript 2100 -> 2086 (its test scripts have no unit header). Indexed A/B, edges removed/added: SynEdit 1889/2150, HeidiSQL 2571/3305, DelphiMVCFramework 4915/6227, mORMot2 15298/27195, DWScript 3758/4570; leveldb and SDWebImage identical. No file loses more call sites than it gains outside DelphiMVCFramework, where the six that do lose only wrong edges. Index time within noise (HeidiSQL +3% wall, +8% CPU for the code now read); the pre-parse itself takes 223 ms over mORMot2's 25 MB. Co-Authored-By: Claude Opus 5.5 --- CHANGELOG.md | 2 + __tests__/pascal-delphi-syntax.test.ts | 521 +++++++++++++ __tests__/pascal-nested-routines.test.ts | 38 + __tests__/pascal-system-calls.test.ts | 21 +- src/extraction/languages/pascal-preparse.ts | 823 +++++++++++++++++++- src/extraction/tree-sitter.ts | 6 +- 6 files changed, 1361 insertions(+), 50 deletions(-) create mode 100644 __tests__/pascal-delphi-syntax.test.ts diff --git a/CHANGELOG.md b/CHANGELOG.md index 82873bfce..0d43a8c3f 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -35,6 +35,8 @@ and adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0.html). - In Delphi, a routine called without parentheses, the usual way to call one that takes no arguments, like `Before;`, `if Ready then`, `Result := FProvider.Value + 1` or `QueryTabs.ActiveTab.MemoFilename`, now counts as a call, so it shows up in callers, callees and impact, and a method given to an event, like `OnClick := ButtonClick`, is linked as a reference. A name is linked only to a method or function its code reaches, in its class and the classes it inherits from (`class sealed (TBase)` included), its unit, or the units it uses, never to a field, property or variable of that name. Thanks @OleksiyPenkov for the report, and @drakeo338 and @OleksiyPenkov for their pull requests. (#2514) - In Delphi, a call to something the compiler provides, like `SizeOf(X)`, `TypeInfo(TFoo)`, `High(A)`, `Inc(N)`, `Assert(…)` or a typecast like `Pointer(P)`, written in any letter case, no longer shows up as a call to a project method, field or variable that happens to share its name, unless the calling code's own class or units declare one, like a list class's own `Delete`. A call through a field, property or variable now counts only when it holds a routine, like an `OnChange` event or a `reference to function` variable, and calls in `{$I}` include files and into units the parser could only partly read now find the routines those units declare. Thanks @OleksiyPenkov for the report. (#2514) - In Delphi, a routine declared inside another, between its header and its `begin`, is now indexed as a routine of its own under the one it belongs to (`TFoo.Bar`'s `Inner` is `TFoo::Bar::Inner`), with the calls its body makes. Before, its body was skipped, so what it called was missing from callers and impact, and a call to it from its own routine went to any routine of the same name elsewhere. Thanks @OleksiyPenkov for the pull request this follows. (#2550) +- In Delphi, a unit that re-publishes an inherited property, like `property OwnsObjects;` or `property Cursor default crIBeam;`, is now indexed whole. So is one with a conditional right after a routine's header (`{$IFDEF HASINLINE}inline;{$ENDIF}`), an assembler and a Pascal version of one routine, a bare `raise`, a field or variable of an unnamed record type (`fIn: record … end`), a label just before `end`, or two versions of a statement in one `case` branch. Before, the parse broke at such a line, so the routines and class members after it went missing or their calls were credited to the file, which cost SynEdit's main unit most of its code. +- In Delphi, a constant read in a routine's body is no longer credited to the last routine nested inside it. - In VB.NET and C#, what a property's `Get` and `Set` code calls, creates and reads now belongs to that property, as do C#'s `get => …` accessors and `=> …` property bodies. Before, it was dropped, so a method used only from a property looked unused. - In VB.NET, a field or property initializer like `= Compute()` or `As New List(Of Order)` now links what it calls and creates, and so do a `Custom Event`'s `AddHandler`, `RemoveHandler` and `RaiseEvent` blocks. Re-index VB.NET and C# projects after upgrading. - In C#, a field or property initializer like `private readonly ILogger _log = LogManager.GetLogger(typeof(X));` or `public List Items { get; } = new();` now links what it calls, creates and reads, including inside a lambda, and a target-typed `new()` there counts as creating the declared type. Before, initializers were skipped, so a method or class used only from one — like a converter created in a static list — looked unused, and a method passed as a value there was credited to the whole class instead of the field or property. diff --git a/__tests__/pascal-delphi-syntax.test.ts b/__tests__/pascal-delphi-syntax.test.ts new file mode 100644 index 000000000..639e11212 --- /dev/null +++ b/__tests__/pascal-delphi-syntax.test.ts @@ -0,0 +1,521 @@ +/** + * Delphi syntax the Pascal grammar has no rule for, which broke whole units + * of SynEdit, mORMot2, DWScript and HeidiSQL: a property re-published + * without its type (`property OwnsObjects;`, SynEdit.pas from line 303), a + * conditional right after a routine's header that holds no whole body, two + * branches that open the same `begin`, a re-raise, a field or variable of an + * anonymous record type, a label right before `end`, and alternative + * statements where the grammar takes one (`OP_X: {$IFDEF U} … {$ELSE} … + * {$ENDIF}`). The extractor's preParse blanks each, or writes a word the + * grammar knows in its place, offsets kept, so the unit parses whole and the + * routines after it keep their calls. + */ +import { describe, it, expect, beforeAll } from 'vitest'; +import * as fs from 'node:fs'; +import * as path from 'node:path'; +import * as os from 'node:os'; +import { CodeGraph } from '../src'; +import { extractFromSource } from '../src/extraction'; +import { getParser, initGrammars, loadGrammarsForLanguages } from '../src/extraction/grammars'; +import { preParsePascal } from '../src/extraction/languages/pascal-preparse'; + +beforeAll(async () => { + await initGrammars(); + await loadGrammarsForLanguages(['pascal']); +}); + +/** Whether the unit parses whole: a `unit` node and no error anywhere. */ +function parsesWhole(code: string): boolean { + const tree = getParser('pascal')!.parse(preParsePascal(code))!; + try { + return !tree.rootNode.hasError && tree.rootNode.namedChildren.some((c) => c.type === 'unit'); + } finally { + tree.delete(); + } +} + +/** Every routine's calls, as `Caller->Callee`, and every node's qualified name, from the unit's extraction. */ +function extract(code: string, file: string): { calls: string[]; names: string[] } { + const result = extractFromSource(file, code); + const byId = new Map(result.nodes.map((n) => [n.id, n])); + return { + calls: result.unresolvedReferences + .filter((r) => r.referenceKind === 'calls') + .map((r) => `${byId.get(r.fromNodeId)?.name}->${r.referenceName}`), + names: result.nodes.map((n) => n.qualifiedName), + }; +} + +const OVERRIDES = `unit Marks; + +interface + +type + TMarkList = class(TObjectList) + protected + function GetItem(Index: Integer): TObject; + property OwnsObjects; + public + constructor Create; + property Items[Index: Integer]: TObject read GetItem; default; + end; + + TEditor = class(TCustomControl) + published + property Align; + property Cursor default crIBeam; + class property Tag; + property Lines: TStrings read FLines; + procedure Paint; + end; + +implementation + +procedure TEditor.Paint; +begin + Refresh(1); +end; + +end. +`; + +const HEADERS = `unit Headers; + +interface + +procedure KeyUp; +function Size: Integer; +procedure Generate; + +implementation + +procedure KeyUp; +{$IFDEF LINUX} +var + Code: Byte; +{$ENDIF} +begin + Translate(1); +end; + +function Size: Integer; {$IFDEF HASINLINE}inline;{$ENDIF} +begin + Result := Measure(1); +end; + +procedure Generate; +{$IFDEF LLVM} +{$IFDEF LLVM_EXECUTE} +var + Engine: Pointer; +{$ENDIF} +{$ENDIF} +begin + Emit(1); +end; + +end. +`; + +const BEGINS = `unit Begins; + +interface + +procedure Click; +procedure After; + +implementation + +procedure Click; +var + I: Integer; +{$IFDEF FOLDING} + Index: Integer; +begin + Fold(1); + if I > 0 then + begin + Exit; + end; +{$ELSE} +begin +{$ENDIF} + Paint(1); +end; + +procedure After; +begin + Finish(1); +end; + +end. +`; + +const ASSEMBLER = `unit Assembler; + +interface + +function Log2Of(const V: Double): Double; +function DivMod10(var Dividend: Cardinal): Cardinal; +procedure Fill(P: Pointer); +procedure After; + +implementation + +procedure Fill(P: Pointer); +{$IFDEF FPC}nostackframe; assembler; asm {$ELSE} asm .noframe {$ENDIF} + mov eax, 1 +end; + +function Log2Of(const V: Double): Double; +{$IFDEF WIN32_ASM} +asm + fld1 + fld V + fyl2x +{$ELSE} +begin + Result := Log2(V); +{$ENDIF} +end; + +function DivMod10(var Dividend: Cardinal): Cardinal; +{$IFNDEF WIN32_ASM} +var + Divided: Cardinal; +begin + Divided := Dividend div 10; + Result := Remainder(Dividend, Divided); +{$ELSE} +const + C10: Cardinal = 10; +asm + mov ecx, eax + div C10 +{$ENDIF} +end; + +procedure After; +begin + Finish(1); +end; + +end. +`; + +const RERAISES = `unit Reraises; + +interface + +procedure Load; +procedure Parse; + +implementation + +procedure Load; +begin + try + Read(1); + except + Log(1); + raise; + end +end; + +procedure Parse; +begin + try + Scan(1); + except + on E: EConvertError do + Recover(1); + else raise + end; +end; + +end. +`; + +const RECORDS = `unit Records; + +interface + +type + TClient = class + private + fIn: record + Headers: Pointer; + URL, Method: string; + end; + fRows: array of packed record + Id: Integer; + end; + fCount: Integer; + public + procedure Send; + end; + + TCaches = array[1..4] of record + Size: Integer; + end; + + TState = record + Seed: Integer; + Data: record + case Integer of + 0: (Lc: Pointer) + end + end; + +var + PosixInject: record + GetSmbios: function(Index: Integer): string; + OnIdle: procedure of object; + end; + Ready: Boolean; + +const + Origin: record X, Y: Integer; end = (X: 0; Y: 0); + +implementation + +procedure TClient.Send; +begin + Post(fIn.URL); +end; + +end. +`; + +const LABELS = `unit Labels; + +interface + +function Find(P: PChar): Integer; +procedure After; + +implementation + +function Find(P: PChar): Integer; +label + fnd, quit; +begin + Result := 0; + if P = nil then + goto quit; + if Match(P) then + goto fnd; + goto quit; +fnd: + Result := 1; +quit: +end; + +procedure After; +begin + Finish(1); +end; + +end. +`; + +const ALTERNATIVES = `unit Alternatives; + +interface + +function Repeated(Op: Integer): Integer; +function Pick(Lookup: Pointer): Integer; + +implementation + +function Repeated(Op: Integer): Integer; +begin + Result := 0; + case Op of + 1: + {$IFDEF UNICODE} + begin + CountWide(Result); + end; + {$ELSE} + while Result < 10 do + CountAnsi(Result); + {$ENDIF} + 2: + Result := 2; + end; +end; + +function Pick(Lookup: Pointer): Integer; +begin + if Lookup = nil then + {$IFDEF ASMX86} + Result := PosAsm(0) + {$ELSE} + Result := PosPas(0) + {$ENDIF} + else + Result := PosLookup(Lookup); +end; + +end. +`; + +describe('Delphi syntax the Pascal grammar has no rule for', () => { + it.each([ + ['re-published properties', OVERRIDES], + ['conditionals after routine headers', HEADERS], + ['branches that open the same begin', BEGINS], + ['an assembler and a Pascal version of a body', ASSEMBLER], + ['re-raises', RERAISES], + ['anonymous records', RECORDS], + ['a label that ends a block', LABELS], + ['alternative statements where one goes', ALTERNATIVES], + ])('parses a unit whole past %s', (_name, code) => { + expect(parsesWhole(code)).toBe(true); + }); + + it('keeps a class whole past its re-published properties', () => { + const { calls, names } = extract(OVERRIDES, 'Marks.pas'); + expect(names).toEqual(expect.arrayContaining([ + 'TMarkList::GetItem', 'TMarkList::Create', 'TMarkList::Items', 'TEditor::Lines', 'TEditor::Paint', + ])); + // An override declares nothing new. + expect(names).not.toContain('TMarkList::OwnsObjects'); + expect(names).not.toContain('TEditor::Align'); + expect(calls).toEqual(['Paint->Refresh']); + }); + + it('gives each routine its calls past a conditional after its header', () => { + expect(extract(HEADERS, 'Headers.pas').calls.sort()).toEqual(['Generate->Emit', 'KeyUp->Translate', 'Size->Measure']); + expect(extract(BEGINS, 'Begins.pas').calls.sort()).toEqual(['After->Finish', 'Click->Fold', 'Click->Paint']); + expect(extract(ASSEMBLER, 'Assembler.pas').calls.sort()).toEqual(['After->Finish', 'DivMod10->Remainder', 'Log2Of->Log2']); + }); + + it('gives each routine its calls past a re-raise and a label that ends a block', () => { + expect(extract(RERAISES, 'Reraises.pas').calls.sort()).toEqual(['Load->Log', 'Load->Read', 'Parse->Recover', 'Parse->Scan']); + expect(extract(LABELS, 'Labels.pas').calls.sort()).toEqual(['After->Finish', 'Find->Match']); + }); + + it('keeps a declaration of an anonymous record type, and every declaration after it', () => { + const { calls, names } = extract(RECORDS, 'Records.pas'); + expect(names).toEqual(expect.arrayContaining([ + 'TClient::fIn', 'TClient::fRows', 'TClient::fCount', 'TClient::Send', 'TCaches', 'TState::Seed', 'TState::Data', + 'PosixInject', 'Ready', 'Origin', + ])); + // The record's own fields are no members of the class around it. + expect(names).not.toContain('TClient::URL'); + expect(names).not.toContain('GetSmbios'); + expect(calls).toEqual(['Send->Post']); + }); + + it('reads alternative statements where one goes as one block, keeping the calls of each', () => { + expect(extract(ALTERNATIVES, 'Alternatives.pas').calls.sort()).toEqual([ + 'Pick->PosAsm', 'Pick->PosLookup', 'Pick->PosPas', 'Repeated->CountAnsi', 'Repeated->CountWide', + ]); + }); + + it('keeps every offset and line, CRLF included', () => { + for (const code of [OVERRIDES, HEADERS, BEGINS, ASSEMBLER, RERAISES, RECORDS, LABELS, ALTERNATIVES]) { + const crlf = code.replace(/\n/g, '\r\n'); + const out = preParsePascal(crlf); + expect(out.length).toBe(crlf.length); + const breaks = (s: string) => [...s.matchAll(/\r\n/g)].map((m) => m.index); + expect(breaks(out)).toEqual(breaks(crlf)); + } + }); + + it('writes the words it needs where the grammar reads them', () => { + const blank = (s: string) => s.replace(/[^\r\n]/g, ' '); + expect(preParsePascal(' 1: {$IFDEF U} A(1); {$ELSE} B(2); {$ENDIF}\n')) + .toBe(' 1: begin A(1); ; B(2); end; \n'); + expect(preParsePascal(' Data: record X: Integer; end;\n')).toBe(` Data: string${blank(' X: Integer; end')};\n`); + expect(preParsePascal(' Data: packed record X: Integer; end end;\n')).toBe(` Data: string${blank(' record X: Integer; ')}; end;\n`); + expect(preParsePascal(' else raise\n end;\n')).toBe(' else ; \n end;\n'); + }); + + it('leaves alone what the grammar reads as it is', () => { + const code = `unit Keep; + +interface + +type + TList = class + property Items[Index: Integer]: T read GetItem; default; + property Count: Integer read FCount; + Value: {$IFDEF CPU64} Int64 {$ELSE} Integer {$ENDIF}; + end; + TRec = record + X: Integer; + end; + +function Load: Integer; + +implementation + +function Load: Integer; +{$IFDEF PUREPASCAL} +var + I: Integer; +begin + Result := Read(I); +end; +{$ELSE} +asm + mov eax, 1 +end; +{$ENDIF} + +procedure Run; +begin + with List do + {$IFDEF CPU64} + if A = B then + {$ELSE} + if C = D then + {$ENDIF} + Exit; + if Ready then {$IFDEF X} Go(1); {$ELSE} Stay(1); {$ENDIF} + raise EAbort.Create('stop'); + WriteLn('raise; property X; quit:'); +end; + +end. +`; + expect(preParsePascal(code)).toBe(code); + }); + + it('links a routine past a conditional after its header to what it calls', async () => { + const dir = fs.mkdtempSync(path.join(os.tmpdir(), 'cg-pascal-delphi-syntax-')); + try { + fs.writeFileSync(path.join(dir, 'Lib.pas'), `unit Lib; + +interface + +procedure Translate(N: Integer); +procedure Emit(N: Integer); + +implementation + +procedure Translate(N: Integer); begin end; +procedure Emit(N: Integer); begin end; + +end. +`); + fs.writeFileSync(path.join(dir, 'Headers.pas'), HEADERS.replace('implementation\n', 'implementation\n\nuses Lib;\n')); + const cg = await CodeGraph.init(dir, { index: true }); + try { + const callers = (name: string) => { + const target = cg.getNodesByKind('function').find((n) => n.qualifiedName === name && n.filePath === 'Lib.pas'); + return target ? cg.getIncomingEdges(target.id).filter((e) => e.kind === 'calls').map((e) => cg.getNode(e.source)?.name) : []; + }; + expect(callers('Translate')).toEqual(['KeyUp']); + expect(callers('Emit')).toEqual(['Generate']); + } finally { + cg.close(); + } + } finally { + fs.rmSync(dir, { recursive: true, force: true }); + } + }); +}); diff --git a/__tests__/pascal-nested-routines.test.ts b/__tests__/pascal-nested-routines.test.ts index 7c594db95..cc3cf4324 100644 --- a/__tests__/pascal-nested-routines.test.ts +++ b/__tests__/pascal-nested-routines.test.ts @@ -360,4 +360,42 @@ end;`); expect(callsFrom(cg, 'THost::Fire')).toEqual(['Host.pas:THost::Fire::Calc', 'Host.pas:THost::Fire::Delete']); }); }); + + it('gives a nested routine the constants it reads, not those its routine\'s body reads after it', async () => { + const code = `unit Values; + +interface + +const + MAX_DEPTH = 10; + OP_EXACTLY = 3; + OP_ANY = 4; + +function Parse(N: Integer): Integer; + +implementation + +function Parse(N: Integer): Integer; + + function Unquote(C: Integer): Integer; + begin + Result := C + OP_ANY; + end; + +begin + if N > MAX_DEPTH then + Result := OP_EXACTLY + else + Result := Unquote(N); +end; + +end. +`; + await withIndex({ 'Values.pas': code }, (cg) => { + const reads = cg.getOutgoingEdges(routine(cg, 'Parse::Unquote').id) + .filter((e) => e.kind === 'references') + .map((e) => cg.getNode(e.target)!.name); + expect(reads).toEqual(['OP_ANY']); + }); + }); }); diff --git a/__tests__/pascal-system-calls.test.ts b/__tests__/pascal-system-calls.test.ts index 6714ee974..a3741e623 100644 --- a/__tests__/pascal-system-calls.test.ts +++ b/__tests__/pascal-system-calls.test.ts @@ -483,7 +483,7 @@ end. }); it('sees the declarations of a used unit whose header the parser lost', async () => { - // The `{$IFDEF}` around a local `var` section costs the parse its `unit` + // An old-style `begin … end.` initialization costs the parse its `unit` // node; the unit is still the one its file is named after. const lib = `unit Lib; @@ -500,14 +500,12 @@ function FileSize(const FileName: string): Int64; implementation function FileSize(const FileName: string): Int64; -{$IFDEF MSWINDOWS} -var - Handle: THandle; -{$ENDIF} begin Result := 0; end; +begin + crc32c := nil; end. `; const main = `unit Main; @@ -606,16 +604,18 @@ end; }); it('takes no member of a class such a unit\'s parse lost for a routine of the unit', async () => { - // The anonymous record ends the class early, so `Insert` comes out as a - // routine of the unit, indented as no routine of the unit is. + // The anonymous record holding a method, which the parser can't read, + // ends the class early, so `Insert` comes out as a routine of the unit, + // indented as no routine of the unit is. const lib = `unit Lib; interface type TClient = class - Items: array of record + Items: record Name: string; + procedure Clear; end; procedure Insert(Index: Integer; const S: string); end; @@ -627,13 +627,10 @@ implementation procedure TClient.Insert(Index: Integer; const S: string); begin end; procedure Log(const S: string); -{$IFDEF MSWINDOWS} -var - Handle: THandle; -{$ENDIF} begin end; +begin end. `; const main = `unit Main; diff --git a/src/extraction/languages/pascal-preparse.ts b/src/extraction/languages/pascal-preparse.ts index 5d907f3ef..8e3675b20 100644 --- a/src/extraction/languages/pascal-preparse.ts +++ b/src/extraction/languages/pascal-preparse.ts @@ -1,8 +1,8 @@ /** * Offset-preserving source fixes the Pascal grammar needs before it parses a * Delphi unit (the extractor's `preParse`). Each one blanks syntax the grammar - * has no rule for with spaces, keeping every newline, so node positions and - * text stay where they are. + * has no rule for with spaces, or writes a word it knows in its place, keeping + * every newline, so node positions and text stay where they are. * * - An attribute on a routine parameter, before or after its modifier: * `const [ref] AValue: Integer`, `[ref] const Source: TVarData`, @@ -17,6 +17,46 @@ * call in its body was read. Blanking `var` and the type leaves the loop * the grammar knows. The resolver still finds the type: it reads a * receiver's declaration from the source as written. + * - A property override, which names an inherited property without its type + * to publish it or change a specifier: `property OwnsObjects;`, `property + * Cursor default crIBeam;`. The grammar's property rule needs the type, so + * the class fell apart at the first override and every member declared + * after it was lost. An override declares nothing new to index. + * - A conditional right after a routine's header that doesn't hold whole + * bodies: `procedure KeyUp(…); {$IFDEF LINUX} var Code: Byte; {$ENDIF}`, + * `function Get: Integer; {$IFDEF HASINLINE}inline;{$ENDIF}`. The grammar + * reads a conditional there as alternative bodies only, so any other one + * broke the whole unit. Blanking its directives leaves its branches as + * plain code, which is how the grammar reads a conditional anywhere else. + * - A branch holding only a `begin` that another branch of its conditional + * opens too: `{$IFDEF FOLDING} Index: Integer; begin … {$ELSE} begin + * {$ENDIF}`. Read together, the branches open one block more than the code + * closes, so every routine after it was lost. The other branch's `begin` + * stays. An assembler version that opens the body beside a Pascal one, + * `{$IFDEF WIN32_ASM} asm … {$ELSE} begin … {$ENDIF} end;`, is blanked + * whole, so the Pascal version is the body. + * - A field, variable or typed constant of an anonymous record type: + * `AlgData: record case … end`, `Stack: array[1..32] of record First, Last: + * LongInt; end;`. The grammar knows a record only as a named type, so the + * record's `end` closed the class around it and the members declared after + * it were lost. The `record` (or the `packed` before it) is written over by + * `string` and the fields are blanked, so the declaration keeps its name: + * the fields belong to no type the graph could index them under. + * - A re-raise, `raise` with no exception (`except Log; raise; end`). The + * grammar's `raise` takes an exception, so it read the next word (often + * the `end`) as one and the unit broke. The `raise` is blanked, or written + * over by `;` right before an `end` (`else raise end`), where the grammar + * needs a statement to end the list. + * - A label that ends its block, right before `end`, `until`, `except` or + * `finally` (`quit: end;`). The grammar takes a label only before a + * statement, so it read the `end` as a name and the routine never closed, + * taking the routines after it along. The graph reads no labels. + * - Alternative statements where the grammar takes one: `OP_X: {$IFDEF U} + * begin … end; {$ELSE} while … do Inc(N); {$ENDIF}` after a case label, or + * `then {$IFDEF X} A := 1 {$ELSE} A := 2 {$ENDIF} else …`. Read together, + * the branches are two statements, so the case arm broke and took the + * routines after it along. The conditional's directives become `begin`, `;` + * and `end`, which makes its branches one block and keeps the code of each. */ const MODIFIERS: ReadonlySet = new Set(['const', 'var', 'out', 'constref']); @@ -27,13 +67,54 @@ const MAX_ATTRIBUTE_LENGTH = 2000; const MAX_LOOP_TYPE_LENGTH = 500; /** Words that end a for-in variable's type without an `in`: not the for-in form. */ const NOT_A_FOR_IN: ReadonlySet = new Set(['do', 'to', 'downto', 'begin', 'end']); -/** Whether a file can hold a `for var … in` loop at all (the scan below decides). */ -const FOR_VAR = /\bfor\s+var\b/i; +/** + * Whether a file can hold anything to fix at all (the scan below decides): a directive, an attribute, a `for var` + * loop, a property override, an anonymous record, a re-raise or a label (only a `goto` needs one). + */ +const MAY_NEED_FIXES = /\{\$|\[|\bfor\s+var\b|\bproperty\b|\brecord\b|\braise\b|\bgoto\b/i; +/** A property override longer than this, up to its `;`, is not one. */ +const MAX_OVERRIDE_LENGTH = 500; +/** A routine header's rest after its parameters, or a hint after it (`message WM_SIZE;`), longer than this is not one. */ +const MAX_HEADER_PART_LENGTH = 500; +/** An anonymous record longer than this, `record` to `end`, is left alone. */ +const MAX_RECORD_LENGTH = 20000; +/** The hints a routine's header can carry after its `;`: the grammar's procedure attributes. */ +const ROUTINE_HINTS: ReadonlySet = new Set([ + 'static', 'virtual', 'dynamic', 'abstract', 'override', 'overload', 'reintroduce', 'inline', + 'stdcall', 'cdecl', 'pascal', 'register', 'safecall', 'assembler', 'noreturn', 'local', 'far', + 'near', 'default', 'nodefault', 'deprecated', 'experimental', 'message', 'platform', + 'unimplemented', 'cppdecl', 'cvar', 'mwpascal', 'nostackframe', 'interrupt', 'iocheck', + 'hardfloat', 'softfloat', 'ms_abi_default', 'ms_abi_cdecl', 'saveregisters', 'sysv_abi_default', + 'sysv_abi_cdecl', 'vectorcall', 'varargs', 'winapi', 'public', 'export', 'alias', 'dispid', +]); +/** Words that end a block's statements, so a label right before one labels no statement, and a `raise` re-raises. */ +const LABEL_ENDS: ReadonlySet = new Set(['end', 'until', 'except', 'finally']); +/** Words that open a block an `end` closes, for telling whether a conditional branch leaves one open. */ +const BLOCK_OPENERS: ReadonlySet = new Set(['begin', 'asm', 'try', 'case', 'record']); +/** Words an anonymous record's fields can't hold: a `record` before them is something else. */ +const NOT_IN_RECORD_FIELDS: ReadonlySet = new Set([ + 'begin', 'class', 'object', 'interface', 'implementation', 'procedure', 'function', 'constructor', + 'destructor', 'property', 'type', 'var', 'const', 'private', 'protected', 'public', 'published', 'strict', +]); +/** Words that start a statement, for telling a conditional's branch holds statements rather than a type. */ +const STATEMENT_KEYWORDS: ReadonlySet = new Set([ + 'begin', 'if', 'while', 'for', 'repeat', 'case', 'try', 'with', 'raise', 'inherited', 'goto', 'asm', +]); +/** Words a type can start with, so a name before `(` that is one of them starts no call. */ +const TYPE_KEYWORDS: ReadonlySet = new Set([ + 'procedure', 'function', 'reference', 'class', 'record', 'object', 'interface', 'array', 'set', 'file', + 'packed', 'string', 'type', 'const', 'var', 'out', +]); +/** Words a statement can't end with: a branch ending in one holds a statement's head or a part of an expression. */ +const STATEMENT_CONTINUES: ReadonlySet = new Set([ + 'then', 'do', 'else', 'of', 'and', 'or', 'xor', 'not', 'div', 'mod', 'shl', 'shr', 'in', 'is', 'as', 'to', + 'downto', 'until', 'goto', 'on', +]); -const CH_TAB = 9, CH_LF = 10, CH_CR = 13, CH_SPACE = 32, CH_AMP = 38, CH_QUOTE = 39; -const CH_LPAREN = 40, CH_RPAREN = 41, CH_STAR = 42, CH_DOT = 46, CH_SLASH = 47; -const CH_COLON = 58, CH_SEMI = 59, CH_LT = 60, CH_EQ = 61, CH_GT = 62; -const CH_LBRACKET = 91, CH_RBRACKET = 93, CH_LBRACE = 123; +const CH_TAB = 9, CH_LF = 10, CH_CR = 13, CH_SPACE = 32, CH_DOLLAR = 36, CH_AMP = 38, CH_QUOTE = 39; +const CH_LPAREN = 40, CH_RPAREN = 41, CH_STAR = 42, CH_COMMA = 44, CH_DOT = 46, CH_SLASH = 47; +const CH_COLON = 58, CH_SEMI = 59, CH_LT = 60, CH_EQ = 61, CH_GT = 62, CH_AT = 64; +const CH_LBRACKET = 91, CH_RBRACKET = 93, CH_LBRACE = 123, CH_RBRACE = 125; /** Identifier characters, `&` (Delphi's keyword escape) and any non-ASCII letter. */ function isIdentStart(c: number): boolean { @@ -42,6 +123,9 @@ function isIdentStart(c: number): boolean { function isIdentPart(c: number): boolean { return (c >= 65 && c <= 90) || (c >= 97 && c <= 122) || c === 95 || (c >= 48 && c <= 57) || c >= 128; } +function isSpace(c: number): boolean { + return c === CH_SPACE || c === CH_TAB || c === CH_LF || c === CH_CR; +} function wordEnd(s: string, i: number): number { while (i < s.length && isIdentPart(s.charCodeAt(i))) i++; @@ -85,21 +169,72 @@ function commentOrStringEnd(s: string, i: number): number { return -1; } +/** Whether a comment starts at `i`. */ +function isCommentStart(s: string, i: number): boolean { + const c = s.charCodeAt(i); + return c === CH_LBRACE || (c === CH_LPAREN && s.charCodeAt(i + 1) === CH_STAR) || (c === CH_SLASH && s.charCodeAt(i + 1) === CH_SLASH); +} + /** The index of the first character from `i` that is neither whitespace nor in a comment. */ function skipTrivia(s: string, i: number): number { while (i < s.length) { - const c = s.charCodeAt(i); - if (c === CH_SPACE || c === CH_TAB || c === CH_LF || c === CH_CR) { - i++; - } else if (c === CH_LBRACE || (c === CH_LPAREN && s.charCodeAt(i + 1) === CH_STAR) || (c === CH_SLASH && s.charCodeAt(i + 1) === CH_SLASH)) { - i = commentOrStringEnd(s, i); - } else { - break; - } + if (isSpace(s.charCodeAt(i))) i++; + else if (isCommentStart(s, i)) i = commentOrStringEnd(s, i); + else break; } return i; } +/** The index after the last character before `i` that is neither whitespace nor in a `{…}` or `(*…*)` comment. */ +function tokenEndBefore(s: string, i: number): number { + for (;;) { + while (i > 0 && isSpace(s.charCodeAt(i - 1))) i--; + if (i > 0 && s.charCodeAt(i - 1) === CH_RBRACE) { + const open = s.lastIndexOf('{', i - 2); + if (open < 0) return i; + i = open; + } else if (i > 1 && s.charCodeAt(i - 1) === CH_RPAREN && s.charCodeAt(i - 2) === CH_STAR) { + const open = s.lastIndexOf('(*', i - 3); + if (open < 0) return i; + i = open; + } else { + return i; + } + } +} + +/** The start of the identifier that ends at `i`, or -1 when none does. */ +function wordStartBefore(s: string, i: number): number { + let k = i; + while (k > 0 && isIdentPart(s.charCodeAt(k - 1))) k--; + if (k === i) return -1; + if (k > 0 && s.charCodeAt(k - 1) === CH_AMP) k--; + return isIdentStart(s.charCodeAt(k)) ? k : -1; +} + +/** The index after the first `;` from `i` outside parentheses and brackets, or -1 when none comes within `max` characters. */ +function semicolonEnd(s: string, i: number, max: number): number { + const limit = Math.min(s.length, i + max); + let depth = 0; + while (i < limit) { + const k = commentOrStringEnd(s, i); + if (k >= 0) { + i = k; + continue; + } + const c = s.charCodeAt(i); + if (c === CH_LPAREN || c === CH_LBRACKET) { + depth++; + } else if (c === CH_RPAREN || c === CH_RBRACKET) { + depth--; + } else if (c === CH_SEMI && depth <= 0) { + return i + 1; + } + i++; + } + return -1; +} + /** * The index after the `]` closing the attribute group whose `[` is at `i`, * or -1 when the group doesn't close the way an attribute does: nested @@ -268,25 +403,587 @@ function scanForInVariable(s: string, forEnd: number, ranges: number[]): number return i; } -/** `s` with every `[from, to)` range in `ranges` blanked to spaces, newlines kept. */ -function blankRanges(s: string, ranges: number[]): string { - if (ranges.length === 0) return s; +/** + * After a `property` keyword running from `start` to `propertyEnd`, + * recognize a property override, which names an inherited property without + * its type to publish it or change a specifier — `property OwnsObjects;`, + * `property Cursor default crIBeam;`, `property Color stored IsColorStored;` + * — and push its range, keyword (or the `class` before it) to `;`, onto + * `ranges`. A name followed by `:` or by an index list (`property + * Items[Index: Integer]: T`) declares a property the grammar knows. Returns + * the index to resume scanning from. + */ +function scanPropertyOverride(s: string, start: number, propertyEnd: number, ranges: number[]): number { + const nameStart = skipTrivia(s, propertyEnd); + if (!isIdentStart(s.charCodeAt(nameStart))) return propertyEnd; + const i = skipTrivia(s, wordEnd(s, nameStart + 1)); + const next = s.charCodeAt(i); + if (next === CH_COLON || next === CH_LBRACKET) return propertyEnd; + const end = semicolonEnd(s, i, MAX_OVERRIDE_LENGTH); + if (end < 0) return propertyEnd; + const classStart = classBefore(s, start); + ranges.push(classStart >= 0 ? classStart : start, end); + return end; +} + +/** + * A conditional compiler directive group, from its `{$IF…}`, `{$IFDEF…}`, + * `{$IFNDEF…}` or `{$IFOPT…}` to its `{$ENDIF}` or `{$IFEND}`. `bounds` + * holds the `[start, end)` offsets of the group's own directives in order, + * its `{$ELSE}`s and `{$ELSEIF…}`s between, so branch `b` runs from + * `bounds[2b + 1]` to `bounds[2b + 2]`; `nested[b]` says whether another + * group sits in that branch. + */ +interface ConditionalGroup { + bounds: number[]; + nested: boolean[]; +} + +const COND_NONE = 0, COND_OPEN = 1, COND_ELSE = 2, COND_CLOSE = 3; + +/** What the `{$…}` directive at `i` does to a conditional: opens one, starts its next branch, closes it, or none of these. */ +function conditionalKind(s: string, i: number): number { + let j = i + 2; + while (j < s.length) { + const c = s.charCodeAt(j) | 32; + if (c < 97 || c > 122) break; + j++; + } + switch (s.slice(i + 2, j).toLowerCase()) { + case 'if': case 'ifdef': case 'ifndef': case 'ifopt': return COND_OPEN; + case 'else': case 'elseif': return COND_ELSE; + case 'endif': case 'ifend': return COND_CLOSE; + default: return COND_NONE; + } +} + +/** + * Every closed conditional group in `s`, innermost first. Directives in + * strings and comments don't count, nor do `(*$…*)` ones, which the grammar + * reads as comments. + */ +function conditionalGroups(s: string): ConditionalGroup[] { + const groups: ConditionalGroup[] = []; + const open: ConditionalGroup[] = []; + const n = s.length; + let i = 0; + while (i < n) { + const c = s.charCodeAt(i); + const k = c === CH_LBRACE || c === CH_QUOTE || c === CH_LPAREN || c === CH_SLASH ? commentOrStringEnd(s, i) : -1; + if (k < 0) { + i++; + continue; + } + if (c === CH_LBRACE && s.charCodeAt(i + 1) === CH_DOLLAR) { + const kind = conditionalKind(s, i); + const top = open[open.length - 1]; + if (kind === COND_OPEN) { + if (top) top.nested[top.nested.length - 1] = true; + open.push({ bounds: [i, k], nested: [false] }); + } else if (kind === COND_ELSE && top) { + top.bounds.push(i, k); + top.nested.push(false); + } else if (kind === COND_CLOSE && top) { + top.bounds.push(i, k); + groups.push(open.pop()!); + } + } + i = k; + } + return groups; +} + +/** + * Whether the code from `from` to `to` is a routine's locals and body, the + * one conditional the grammar reads right after a routine's header: it ends + * with the `end;` of a block that no routine declared in it owns. Code that + * closes a block it didn't open (a local class type) counts as a body too, + * so it stays the way the grammar reads it. + */ +function holdsBody(s: string, from: number, to: number): boolean { + const blocks: string[] = []; + let pending = 0; // routines declared at the top whose body hasn't come yet + let own = false; // whether the last top-level block is no declared routine's + let last = ''; + let beforeLast = ''; + let i = from; + while (i < to) { + const k = commentOrStringEnd(s, i); + if (k >= 0) { + if (s.charCodeAt(i) === CH_QUOTE) { + beforeLast = last; + last = "'"; + } + i = k; + continue; + } + const c = s.charCodeAt(i); + if (isIdentStart(c)) { + const e = wordEnd(s, i + 1); + const word = e - i <= 11 ? s.slice(i, e).toLowerCase() : 'word'; + if (blocks.length === 0) { + if (ROUTINE_KEYWORDS.has(word) && (last === '' || last === ';')) pending++; + else if ((word === 'forward' || word === 'external') && pending > 0) pending--; + } + if (word === 'end') { + if (blocks.pop() === undefined) return true; + } else if (word === 'begin' || word === 'asm') { + if (blocks.length === 0) { + own = pending === 0; + if (!own) pending--; + } + blocks.push(word); + } else if (word === 'try' || word === 'record' || (word === 'case' && blocks[blocks.length - 1] !== 'record')) { + blocks.push(word); + } + beforeLast = last; + last = word; + i = e; + continue; + } + if (!isSpace(c)) { + beforeLast = last; + last = s[i]!; + } + i++; + } + return blocks.length === 0 && own && beforeLast === 'end' && last === ';'; +} + +/** Whether the code from `from` to `to` holds a `begin` or an `asm`: a body, or a part of one. */ +function holdsBlock(s: string, from: number, to: number): boolean { + let i = from; + while (i < to) { + const k = commentOrStringEnd(s, i); + if (k >= 0) { + i = k; + continue; + } + if (isIdentStart(s.charCodeAt(i))) { + const e = wordEnd(s, i + 1); + if (e - i === 3 || e - i === 5) { + const word = s.slice(i, e).toLowerCase(); + if (word === 'begin' || word === 'asm') return true; + } + i = e; + continue; + } + i++; + } + return false; +} + +/** The index of the first character from `i` that is neither whitespace nor in a comment, stopping at a conditional group's opening directive. */ +function skipTriviaToGroup(s: string, i: number, groupAt: ReadonlyMap): number { + while (i < s.length) { + if (isSpace(s.charCodeAt(i))) i++; + else if (isCommentStart(s, i) && !groupAt.has(i)) i = commentOrStringEnd(s, i); + else break; + } + return i; +} + +/** + * From `i`, the index after a routine header's `;`, blank the directives of + * each conditional that follows the header, past the hints it carries + * (`overload;`, `inline;`), unless every branch of the conditional holds a + * whole body: the one conditional the grammar reads there. When the + * conditional holds no block at all (only locals or hints), the scan goes on + * in its first branch, now plain code, so a conditional nested at its start + * comes right after the header too. + */ +function blankConditionalsAfterHeader(s: string, i: number, groupAt: ReadonlyMap, ranges: number[]): void { + for (;;) { + i = skipTriviaToGroup(s, i, groupAt); + const group = groupAt.get(i); + if (group) { + const { bounds } = group; + let bodies = true; + for (let b = 1; b < bounds.length - 1 && bodies; b += 2) bodies = holdsBody(s, bounds[b]!, bounds[b + 1]!); + if (bodies) return; // the grammar reads these + ranges.push(...bounds); + i = holdsBlock(s, bounds[1]!, bounds[bounds.length - 2]!) ? bounds[bounds.length - 1]! : bounds[1]!; + continue; + } + if (!ROUTINE_HINTS.has(lowerWordAt(s, i))) return; + i = semicolonEnd(s, i, MAX_HEADER_PART_LENGTH); + if (i < 0) return; + } +} + +const OPEN_BEGIN = 0, OPEN_ASM = 1, OPEN_OTHER = 2; + +/** + * The blocks the code from `from` to `to` leaves open, in order, each as its + * opener's offset and kind (OPEN_BEGIN, OPEN_ASM, or OPEN_OTHER for `try`, + * `case` and `record`), or null when it closes a block it didn't open. + */ +function openBlocks(s: string, from: number, to: number): Array<[number, number]> | null { + const open: Array<[number, number]> = []; + let i = from; + while (i < to) { + const k = commentOrStringEnd(s, i); + if (k >= 0) { + i = k; + continue; + } + if (isIdentStart(s.charCodeAt(i))) { + const e = wordEnd(s, i + 1); + if (e - i >= 3 && e - i <= 6) { + const word = s.slice(i, e).toLowerCase(); + if (word === 'end') { + if (open.pop() === undefined) return null; + } else if (BLOCK_OPENERS.has(word)) { + open.push([i, word === 'begin' ? OPEN_BEGIN : word === 'asm' ? OPEN_ASM : OPEN_OTHER]); + } + } + i = e; + continue; + } + i++; + } + return open; +} + +/** + * In every conditional (holding no conditional of its own) whose branches + * each leave blocks open for the code after it to close. When they all leave + * the same number of `begin`s open, the `begin`s each branch after the first + * leaves open are blanked: read together, they would open that many blocks + * more than the code closes, and a branch's statements can sit in the first + * branch's block, as the graph doesn't read nesting. When each opens one + * body, some with `asm` and some with `begin` (an assembler and a Pascal + * version of a routine sharing one `end`), each assembler branch is blanked + * whole, so the Pascal one is the body; the graph reads nothing in assembler. + */ +function blankDuplicateBegins(s: string, groups: readonly ConditionalGroup[], ranges: number[]): void { + for (const { bounds, nested } of groups) { + if (nested.length < 2 || nested.includes(true)) continue; + const open: Array> = []; + for (let b = 0; b < nested.length; b++) { + const blocks = openBlocks(s, bounds[2 * b + 1]!, bounds[2 * b + 2]!); + if (!blocks || blocks.length === 0) break; + open.push(blocks); + } + if (open.length < nested.length) continue; + const kinds = (kind: number) => open.filter((o) => o.every(([, k]) => k === kind)).length; + if (kinds(OPEN_BEGIN) === open.length && open.every((o) => o.length === open[0]!.length)) { + for (let b = 1; b < open.length; b++) for (const [at] of open[b]!) ranges.push(at, at + 5); + } else if (open.every((o) => o.length === 1) && kinds(OPEN_ASM) > 0 && kinds(OPEN_BEGIN) > 0 && kinds(OPEN_BEGIN) + kinds(OPEN_ASM) === open.length) { + let kept = false; + for (let b = 0; b < open.length; b++) { + const [at, kind] = open[b]![0]!; + if (kind === OPEN_ASM) ranges.push(bounds[2 * b + 1]!, bounds[2 * b + 2]!); + else if (kept) ranges.push(at, at + 5); + else kept = true; + } + } + } +} + +const SHAPE_NONE = -1, SHAPE_STATEMENTS = 0, SHAPE_STATEMENTS_SEMI = 1, SHAPE_EMPTY = 2; +const START_NONE = 0, START_STATEMENT = 1, START_CALL = 2, START_NAME = 3; + +/** + * Whether the code from `from` to `to`, a conditional's branch, holds whole statements: its blocks and brackets + * close, every `if` has its `then` and every `while`, `for`, `with` and `on` its `do`, and it ends where a + * statement can. It must start with a statement's keyword, assign at its top level or call a routine (`Foo(…)`, + * `A.B(…)`); with `bare`, a lone name counts too (`Exit`, `List.Clear;`), which after a case label could just as + * well be a type. Returns SHAPE_STATEMENTS (SHAPE_STATEMENTS_SEMI when it ends with `;`), SHAPE_EMPTY for no code, + * or SHAPE_NONE. + */ +function statementsShape(s: string, from: number, to: number, bare: boolean): number { + const blocks: boolean[] = []; // an open block each: true for a `repeat`, which `until` closes + let depth = 0; + let heads = 0; // `if`, `while`, `for`, `with` and `on` still waiting for their `then` or `do` + let tokens = 0; + let start = START_NONE; + let name = 0; // reading the first dotted name: 1 after a part of it, 2 after its `.`, 0 when done + let last = ''; // the last token: a word lowercased ('word' when long), '0' for a number, else its character + let i = from; + while (i < to) { + const k = commentOrStringEnd(s, i); + if (k >= 0) { + if (s.charCodeAt(i) === CH_QUOTE) { + tokens++; + name = 0; + last = "'"; + } + i = k; + continue; + } + const c = s.charCodeAt(i); + if (isSpace(c)) { + i++; + continue; + } + tokens++; + if (isIdentStart(c)) { + const e = wordEnd(s, i + 1); + const word = e - i <= 9 ? s.slice(i, e).toLowerCase() : 'word'; + if (word === 'begin' || word === 'try' || word === 'case' || word === 'asm') blocks.push(false); + else if (word === 'repeat') blocks.push(true); + else if (word === 'end' && blocks.pop() !== false) return SHAPE_NONE; + else if (word === 'until' && blocks.pop() !== true) return SHAPE_NONE; + else if (word === 'if' || word === 'while' || word === 'for' || word === 'with' || word === 'on') heads++; + else if (word === 'then' || word === 'do') heads--; + if (tokens === 1) { + if (STATEMENT_KEYWORDS.has(word)) start = START_STATEMENT; + else if (!TYPE_KEYWORDS.has(word) && !STATEMENT_CONTINUES.has(word) && word !== 'end') name = 1; + } else { + name = name === 2 ? 1 : 0; + } + last = word; + i = e; + continue; + } + if (c >= 48 && c <= 57) { + name = 0; + last = '0'; + i = wordEnd(s, i + 1); + continue; + } + if (c === CH_COLON && s.charCodeAt(i + 1) === CH_EQ) { + if (depth === 0 && start !== START_CALL) start = START_STATEMENT; + name = 0; + last = ':='; + i += 2; + continue; + } + if (c === CH_LPAREN || c === CH_LBRACKET) { + if (c === CH_LPAREN && name === 1 && start === START_NONE) start = START_CALL; + depth++; + } else if ((c === CH_RPAREN || c === CH_RBRACKET) && --depth < 0) { + return SHAPE_NONE; + } else if (c === CH_SEMI && name === 1 && start === START_NONE) { + start = START_NAME; + } + name = c === CH_DOT && name === 1 ? 2 : 0; + last = s[i]!; + i++; + } + if (tokens === 0) return SHAPE_EMPTY; + if (depth !== 0 || blocks.length > 0 || heads !== 0) return SHAPE_NONE; + if (name === 1 && start === START_NONE) start = START_NAME; + if (start === START_NONE || (start === START_NAME && !bare)) return SHAPE_NONE; + const ends = last === ';' || last === ')' || last === ']' || last === '^' || last === "'" || last === '0' + || (isIdentStart(last.charCodeAt(0)) && !STATEMENT_CONTINUES.has(last)); + if (!ends) return SHAPE_NONE; + return last === ';' ? SHAPE_STATEMENTS_SEMI : SHAPE_STATEMENTS; +} + +/** Whether a blank range in `ranges` overlaps `[from, to)`. */ +function overlapsRange(ranges: readonly number[], from: number, to: number): boolean { + for (let r = 0; r < ranges.length; r += 2) if (ranges[r]! < to && ranges[r + 1]! > from) return true; + return false; +} + +/** Whether `[at, at + length)` holds no line break, so a word written there keeps every line where it is. */ +function onOneLine(s: string, at: number, length: number): boolean { + for (let i = at; i < at + length; i++) { + const c = s.charCodeAt(i); + if (c === CH_LF || c === CH_CR) return false; + } + return true; +} + +/** + * Read as one statement each conditional whose branches are alternative statements where the grammar takes just + * one: after a case label, `then`, `else` or `do` (`label` maps each such group's opening directive to whether a + * case label's `:` comes before it). Its opening directive becomes `begin`, each `{$ELSE}` a `;`, and its closing + * directive `end`, or `end;` when its branches end with `;`. Read together, the branches of one after a case label + * always broke the arm (`OP_X: begin … end; while … do Inc(N);`). After the others they break only when a branch + * before the last has no `;` (`then A {$ELSE} B {$ENDIF} else C`), since `then A; B;` parses as it is. A group + * holding another conditional is left alone, as is one whose branches end in a statement's head (`if … then`) for a + * body after them. + */ +function wrapAlternativeStatements( + s: string, + groups: readonly ConditionalGroup[], + label: ReadonlyMap, + ranges: readonly number[], + words: Array<[number, number, string]>, +): void { + for (const { bounds, nested } of groups) { + const afterLabel = label.get(bounds[0]!); + if (afterLabel === undefined || nested.length < 2 || nested.includes(true)) continue; + let filled = 0; + let semi = false; + let breaks = afterLabel; + let ok = true; + for (let b = 0; b < nested.length && ok; b++) { + const shape = statementsShape(s, bounds[2 * b + 1]!, bounds[2 * b + 2]!, !afterLabel); + if (shape === SHAPE_EMPTY) continue; + if (shape === SHAPE_NONE) ok = false; + if (filled > 0 && !semi) breaks = true; + filled++; + semi = shape === SHAPE_STATEMENTS_SEMI; + } + if (!ok || filled < 2 || !breaks || !onOneLine(s, bounds[0]!, 5)) continue; + let clear = true; + for (let d = 0; d < bounds.length && clear; d += 2) clear = !overlapsRange(ranges, bounds[d]!, bounds[d + 1]!); + if (!clear) continue; + words.push([bounds[0]!, bounds[1]!, 'begin']); + for (let d = 2; d < bounds.length - 2; d += 2) words.push([bounds[d]!, bounds[d + 1]!, ';']); + words.push([bounds[bounds.length - 2]!, bounds[bounds.length - 1]!, semi ? 'end;' : 'end']); + } +} + +/** + * The kind of statement position the token from `at` to `end` makes for what follows it: 1 for a case label's + * `:`, 0 for `then`, `else` or `do`, -1 for anything else. + */ +function statementPosition(s: string, at: number, end: number): number { + const length = end - at; + if (length === 1) return s.charCodeAt(at) === CH_COLON ? 1 : -1; + if (length < 2 || length > 4) return -1; + const word = s.slice(at, end).toLowerCase(); + return word === 'then' || word === 'else' || word === 'do' ? 0 : -1; +} + +/** + * The start of the declaration that the `record` keyword at `i` gives an + * anonymous type to: the first of the `Names` in `Names: [packed] record` or + * `Names: [packed] array[…] of [packed] record`, or the `TName` in `TName = + * array[…] of record`. -1 for a named record type (`TName = record`) and + * anything else. + */ +function anonymousRecordDeclStart(s: string, i: number): number { + let j = tokenEndBefore(s, i); + let w = wordStartBefore(s, j); + if (w >= 0 && lowerWordAt(s, w) === 'packed') { + j = tokenEndBefore(s, w); + w = wordStartBefore(s, j); + } + let array = false; + if (w >= 0 && lowerWordAt(s, w) === 'of') { + j = tokenEndBefore(s, w); + if (s.charCodeAt(j - 1) === CH_RBRACKET) { + const open = s.lastIndexOf('[', j - 1); + if (open < 0) return -1; + j = tokenEndBefore(s, open); + } + w = wordStartBefore(s, j); + if (w < 0 || lowerWordAt(s, w) !== 'array') return -1; + j = tokenEndBefore(s, w); + w = wordStartBefore(s, j); + if (w >= 0 && lowerWordAt(s, w) === 'packed') j = tokenEndBefore(s, w); + array = true; + } + const c = s.charCodeAt(j - 1); + if (c !== CH_COLON && !(c === CH_EQ && array)) return -1; + let start = wordStartBefore(s, tokenEndBefore(s, j - 1)); + if (start < 0 || c === CH_EQ) return start; + for (;;) { + const k = tokenEndBefore(s, start); + if (s.charCodeAt(k - 1) !== CH_COMMA) return start; + const name = wordStartBefore(s, tokenEndBefore(s, k - 1)); + if (name < 0) return -1; + start = name; + } +} + +/** + * The index after the `end` closing a record whose fields start at `i`, or -1 when they hold what a record's fields + * can't. A word like `procedure` or `object` is part of a field's type after `:`, `of` or `to` (`OnIdle: procedure + * of object`, `Get: reference to function: Integer`, `Args: array of const`), and words in brackets are a + * routine type's parameters. + */ +function recordEnd(s: string, i: number): number { + const limit = Math.min(s.length, i + MAX_RECORD_LENGTH); + let depth = 1; + let brackets = 0; + let prev = ''; // the token before: a word lowercased, or its character + while (i < limit) { + const k = commentOrStringEnd(s, i); + if (k >= 0) { + if (s.charCodeAt(i) === CH_QUOTE) prev = "'"; + i = k; + continue; + } + const c = s.charCodeAt(i); + if (isIdentStart(c)) { + const e = wordEnd(s, i + 1); + const word = s.slice(i, e).toLowerCase(); + if (brackets === 0) { + if (word === 'end') { + if (--depth === 0) return e; + } else if (word === 'record') { + depth++; + } else if (NOT_IN_RECORD_FIELDS.has(word) && prev !== ':' && prev !== 'of' && prev !== 'to') { + return -1; + } + } + prev = word; + i = e; + continue; + } + if (c === CH_LPAREN || c === CH_LBRACKET) brackets++; + else if (c === CH_RPAREN || c === CH_RBRACKET) brackets--; + else if (c === CH_EQ && brackets === 0) return -1; + if (!isSpace(c)) prev = s[i]!; + i++; + } + return -1; +} + +/** + * At a `record` keyword from `start` to `end`, recognize the declaration of a field, variable or typed constant of + * an anonymous record type, followed by its `;`, a typed constant's `=`, or the `)` or `end` after a last field. The + * `record` (or the `packed` before it) is written over by `string`, a type the grammar knows, and the fields after + * it are blanked through its `end`, so the declaration keeps its name and a typed constant its value. Returns the + * index to resume from. + */ +function scanAnonymousRecord(s: string, start: number, end: number, ranges: number[], words: Array<[number, number, string]>): number { + if (anonymousRecordDeclStart(s, start) < 0) return end; + const first = lowerWordAt(s, skipTrivia(s, end)); + if (first === '' || NOT_IN_RECORD_FIELDS.has(first)) return end; // ``, `R: record;` + const close = recordEnd(s, end); + if (close < 0) return end; + const next = skipTrivia(s, close); + const c = s.charCodeAt(next); + const last = lowerWordAt(s, next) === 'end'; // a last field, whose `;` Pascal lets go but the grammar needs + if (c !== CH_SEMI && c !== CH_EQ && c !== CH_RPAREN && !last) return end; + const packed = wordStartBefore(s, tokenEndBefore(s, start)); + const at = packed >= 0 && lowerWordAt(s, packed) === 'packed' ? packed : start; + words.push([at, at + 6, 'string']); + if (last) { + ranges.push(at + 6, close - 3); + words.push([close - 3, close, ';']); + } else { + ranges.push(at + 6, close); + } + return close; +} + +/** + * `s` with every `[from, to)` range in `ranges` blanked to spaces, newlines kept, and every `[from, to, word]` in + * `words` (which overlap neither each other nor a range) written over by its word, padded with spaces. Ranges may + * come in any order and overlap. + */ +function applyEdits(s: string, ranges: readonly number[], words: ReadonlyArray): string { + if (ranges.length === 0 && words.length === 0) return s; + const edits: Array = words.slice(); + for (let r = 0; r < ranges.length; r += 2) edits.push([ranges[r]!, ranges[r + 1]!, '']); + edits.sort((a, b) => a[0] - b[0]); let out = ''; let last = 0; - for (let r = 0; r < ranges.length; r += 2) { - const from = ranges[r]!; - const to = ranges[r + 1]!; - out += s.slice(last, from) + s.slice(from, to).replace(/[^\r\n]/g, ' '); + for (const [start, to, word] of edits) { + const from = Math.max(start, last); + if (to <= from) continue; + const written = from === start && word.length <= to - from ? word : ''; + out += s.slice(last, from) + written + s.slice(from + written.length, to).replace(/[^\r\n]/g, ' '); last = to; } return out + s.slice(last); } -/** Whether the word before index `i`, past whitespace, is `class`. */ -function followsClass(s: string, i: number): boolean { - let j = i - 1; - while (j >= 0 && (s.charCodeAt(j) === CH_SPACE || s.charCodeAt(j) === CH_TAB || s.charCodeAt(j) === CH_LF || s.charCodeAt(j) === CH_CR)) j--; - return j >= 4 && s.slice(j - 4, j + 1).toLowerCase() === 'class' && (j < 5 || !isIdentPart(s.charCodeAt(j - 5))); +/** The start of the `class` word before index `i`, past whitespace, or -1. */ +function classBefore(s: string, i: number): number { + let j = i; + while (j > 0 && isSpace(s.charCodeAt(j - 1))) j--; + const w = j - 5; + return w >= 0 && s.slice(w, j).toLowerCase() === 'class' && (w === 0 || !isIdentPart(s.charCodeAt(w - 1))) ? w : -1; } /** @@ -294,13 +991,30 @@ function followsClass(s: string, i: number): boolean { * the source unchanged when there is nothing to blank. */ export function preParsePascal(source: string): string { - if (source.indexOf('[') < 0 && !FOR_VAR.test(source)) return source; + if (!MAY_NEED_FIXES.test(source)) return source; + const directives = source.indexOf('{$') >= 0; const ranges: number[] = []; + const words: Array<[number, number, string]> = []; + const groups = directives ? conditionalGroups(source) : []; + const groupAt = new Map(); + for (const group of groups) groupAt.set(group.bounds[0]!, group); + // Each conditional's opening directive that comes where one statement goes: whether a case label is before it. + const label = new Map(); + // The last token read, start and end, for that; -1 right after a declaration the scan read past. + let lastAt = -1; + let lastEnd = -1; const n = source.length; let i = 0; while (i < n) { const k = commentOrStringEnd(source, i); if (k >= 0) { + if (source.charCodeAt(i) === CH_QUOTE) { + lastAt = i; + lastEnd = k; + } else if (lastAt >= 0 && source.charCodeAt(i + 1) === CH_DOLLAR && groupAt.has(i)) { + const position = statementPosition(source, lastAt, lastEnd); + if (position >= 0) label.set(i, position === 1); + } i = k; continue; } @@ -308,25 +1022,62 @@ export function preParsePascal(source: string): string { if (isIdentStart(c)) { const e = wordEnd(source, i + 1); const len = e - i; - const word = len >= 8 && len <= 11 ? source.slice(i, e).toLowerCase() : ''; + const word = len >= 6 && len <= 11 ? source.slice(i, e).toLowerCase() : ''; // `operator` is no reserved word in Delphi (a call `Operator([1, 2])` is // code), so it starts a header only after `class`. - if (ROUTINE_KEYWORDS.has(word) && (word !== 'operator' || followsClass(source, i))) { + if (ROUTINE_KEYWORDS.has(word) && (word !== 'operator' || classBefore(source, i) >= 0)) { const open = skipTrivia(source, routineNameEnd(source, e)); - if (source.charCodeAt(open) === CH_LPAREN) { - i = scanParameterList(source, open, ranges); - continue; + const next = source.charCodeAt(open) === CH_LPAREN ? scanParameterList(source, open, ranges) : e; + if (groupAt.size > 0) { + const headerEnd = semicolonEnd(source, next, MAX_HEADER_PART_LENGTH); + if (headerEnd >= 0) blankConditionalsAfterHeader(source, headerEnd, groupAt, ranges); } + i = next; + lastAt = -1; + continue; + } else if (word === 'property') { + i = scanPropertyOverride(source, i, e, ranges); + lastAt = -1; + continue; + } else if (word === 'record') { + i = scanAnonymousRecord(source, i, e, ranges, words); + lastAt = -1; + continue; } else if (len === 3 && source.slice(i, e).toLowerCase() === 'for') { i = scanForInVariable(source, e, ranges); + lastAt = -1; continue; + } else if (len === 5 && source.slice(i, e).toLowerCase() === 'raise') { + // A re-raise: blanked, or an empty statement where one must end a list (`else raise end`). + const next = skipTrivia(source, e); + const after = lowerWordAt(source, next); + if (source.charCodeAt(next) === CH_SEMI || after === 'else') ranges.push(i, e); + else if (LABEL_ENDS.has(after)) words.push([i, e, ';']); + } else { + let colon = e; + while (source.charCodeAt(colon) === CH_SPACE || source.charCodeAt(colon) === CH_TAB) colon++; + // A label ending its block (`quit: end;`), not an assembler one (`@z:`). + if (source.charCodeAt(colon) === CH_COLON && source.charCodeAt(colon + 1) !== CH_EQ && source.charCodeAt(i - 1) !== CH_AT + && LABEL_ENDS.has(lowerWordAt(source, skipTrivia(source, colon + 1)))) ranges.push(i, colon + 1); } + lastAt = i; + lastEnd = e; i = e; } else if (c >= 48 && c <= 57) { + lastAt = i; i = wordEnd(source, i + 1); // a number - } else { + lastEnd = i; + } else if (isSpace(c)) { i++; + } else { + lastAt = i; + i += c === CH_COLON && source.charCodeAt(i + 1) === CH_EQ ? 2 : 1; + lastEnd = i; } } - return blankRanges(source, ranges); + if (groups.length > 0) { + blankDuplicateBegins(source, groups, ranges); + if (label.size > 0) wrapAlternativeStatements(source, groups, label, ranges, words); + } + return applyEdits(source, ranges, words); } diff --git a/src/extraction/tree-sitter.ts b/src/extraction/tree-sitter.ts index 94453c64e..7310dc15b 100644 --- a/src/extraction/tree-sitter.ts +++ b/src/extraction/tree-sitter.ts @@ -1309,8 +1309,10 @@ export class TreeSitterExtractor { // live in the sibling. Pull it in. (A body as a next sibling of the scope // node is unique to Dart/Pascal among the value-ref languages — every other // grammar nests the body inside the function node — so this is inert - // elsewhere.) - const sib = scope.node.nextNamedSibling; + // elsewhere.) A Pascal routine nested in another is stored as its whole + // `defProc`, body included, and the `block` after it is the outer + // routine's body: its reads are not the nested routine's. + const sib = scope.node.type === 'defProc' ? null : scope.node.nextNamedSibling; if (sib && (sib.type === 'function_body' || sib.type === 'block')) stack.push(sib); let visited = 0; while (stack.length > 0 && visited < TreeSitterExtractor.MAX_VALUE_REF_NODES) {