From 6eea55bc598946d1c7509de1257168b80f7cd89a Mon Sep 17 00:00:00 2001 From: Andrew Haines Date: Wed, 24 Jun 2026 15:48:36 -0400 Subject: [PATCH] feat(semantic): allow unqualified calls to a procedural-typed field Inside a method, an unqualified FFn(args) -- no 'Self.' prefix -- where FFn is a procedural-typed field of the current class failed with "Undeclared function/procedure 'FFn'". Only the explicit Self.FFn(args) form resolved. Both call analysers now fall through to an implicit-Self field lookup after the method lookup fails: a procedural-typed field of the current class is dispatched through its stored pointer, validating argument count and types (and the l-value requirement for var/out arguments) against the field signature, exactly like the explicit-receiver path. Codegen: * QBE: a shared EmitImplicitSelfProcFieldCall loads Self, indexes the field, and dispatches; var/out arguments are passed by reference and 'of object' fields pass the captured Data as the implicit first arg. Used by both the statement and expression forms. * Native x86-64: both forms reuse EmitProcFieldCall with Self as the receiver. The two new AST flags (TProcCall.IsProcFieldCall, TFuncCallExpr.IsProcFieldCall) are recorded in the bif-coverage status inventory as semantic-only (safe, not serialised), matching the existing IsIndirectCall flags. Covered by an IR test (loads Self, indirect dispatch) and end-to-end tests on both backends for the expression and statement forms. --- .../pascal/blaise.codegen.native.x86_64.pas | 16 ++++ .../src/main/pascal/blaise.codegen.qbe.pas | 90 +++++++++++++++++++ compiler/src/main/pascal/uAST.pas | 8 ++ compiler/src/main/pascal/uSemantic.pas | 68 ++++++++++++++ compiler/src/test/pascal/cp.test.e2e.misc.pas | 62 +++++++++++++ .../src/test/pascal/cp.test.proctypes.pas | 37 ++++++++ tools/bif-coverage/bif-coverage.status | 2 + 7 files changed, 283 insertions(+) diff --git a/compiler/src/main/pascal/blaise.codegen.native.x86_64.pas b/compiler/src/main/pascal/blaise.codegen.native.x86_64.pas index 952a0d1..fcd7ca2 100644 --- a/compiler/src/main/pascal/blaise.codegen.native.x86_64.pas +++ b/compiler/src/main/pascal/blaise.codegen.native.x86_64.pas @@ -6365,6 +6365,14 @@ begin Self.Emit(#9'movq %xmm0, %rax'); Exit; end; + { Unqualified call to a procedural-typed field of the current class + (implicit Self.Field) used as an expression. } + if FC.IsProcFieldCall then + begin + Self.EmitProcFieldCall(nil, 'Self', False, FC.ProcFieldInfo, + TProceduralTypeDesc(FC.ResolvedProcType), FC.Args, FC.ResolvedType); + Exit; + end; if FC.IsIndirectCall then begin { Bare function-pointer call: load the pointer from the variable slot @@ -11549,6 +11557,14 @@ begin Self.Emit(#9'callq _ProcessFree'); Exit; end; + { Unqualified call to a procedural-typed field of the current class + (implicit Self.Field) used as a statement. } + if PC.IsProcFieldCall then + begin + Self.EmitProcFieldCall(nil, 'Self', False, PC.ProcFieldInfo, + TProceduralTypeDesc(PC.ResolvedProcType), PC.Args, nil); + Exit; + end; if PC.IsIndirectCall then begin if (PC.ResolvedProcType <> nil) and diff --git a/compiler/src/main/pascal/blaise.codegen.qbe.pas b/compiler/src/main/pascal/blaise.codegen.qbe.pas index 19a9134..a3c3128 100644 --- a/compiler/src/main/pascal/blaise.codegen.qbe.pas +++ b/compiler/src/main/pascal/blaise.codegen.qbe.pas @@ -326,6 +326,13 @@ type function EmitInheritedCallExpr(ACall: TInheritedCallExpr): string; procedure EmitCaseStmt(AStmt: TCaseStmt); procedure EmitProcCall(ACall: TProcCall); + { Dispatch a call through a procedural-typed field of the current class + reached via implicit Self (an unqualified FFn(args) inside a method). + Loads Self, indexes the field, and calls through the stored pointer; + var/out arguments are passed by reference. Returns the QBE result + temp, or '' for a procedure (no return value). } + function EmitImplicitSelfProcFieldCall(AFieldInfo: TFieldInfo; + APT: TProceduralTypeDesc; AArgs: TObjectList): string; { Helper for string-mutator built-ins (Delete, SetLength). ARtlName is the RTL function (e.g. '_StringDelete') and AExtraArgCount is the number of trailing Integer args after the @@ -8615,6 +8622,74 @@ begin TGenericFuncInstance(AProg.GenericFuncInstances.Items[I]).MethodDecl); end; +function TCodeGenQBE.EmitImplicitSelfProcFieldCall(AFieldInfo: TFieldInfo; + APT: TProceduralTypeDesc; AArgs: TObjectList): string; +var + SelfTemp: string; + SlotAddr: string; + FPtrTemp: string; + ArgTemp: string; + DataTemp: string; + ArgLine: string; + QType: string; + T: string; + I: Integer; +begin + { Self pointer from the implicit Self parameter slot. } + SelfTemp := AllocTemp(); + EmitLine(Format(' %s =l loadl %%_var_Self', [SelfTemp])); + if AFieldInfo.Offset > 0 then + begin + SlotAddr := AllocTemp(); + EmitLine(Format(' %s =l add %s, %d', [SlotAddr, SelfTemp, AFieldInfo.Offset])); + end + else + SlotAddr := SelfTemp; + FPtrTemp := AllocTemp(); + EmitLine(Format(' %s =l loadl %s', [FPtrTemp, SlotAddr])); + { 'of object' field: Data (Self) sits at +8 and becomes the first arg. } + if APT.IsMethodPtr then + begin + ArgTemp := AllocTemp(); + EmitLine(Format(' %s =l add %s, 8', [ArgTemp, SlotAddr])); + DataTemp := AllocTemp(); + EmitLine(Format(' %s =l loadl %s', [DataTemp, ArgTemp])); + ArgLine := Format('l %s', [DataTemp]); + end + else + ArgLine := ''; + for I := 0 to AArgs.Count - 1 do + begin + if ArgLine <> '' then ArgLine := ArgLine + ', '; + { var/out parameters pass the argument's l-value address by reference. } + if TProcParamInfo(APT.Params.Items[I]).IsVarParam then + begin + ArgTemp := EmitLValueAddr(TASTExpr(AArgs.Items[I])); + ArgLine := ArgLine + Format('l %s', [ArgTemp]); + end + else + begin + ArgTemp := EmitExpr(TASTExpr(AArgs.Items[I])); + QType := QbeTypeOf(TProcParamInfo(APT.Params.Items[I]).TypeDesc); + ArgTemp := CoerceArg(ArgTemp, TASTExpr(AArgs.Items[I]), QType); + ArgLine := ArgLine + Format('%s %s', + [QbeParamTypeOf(TProcParamInfo(APT.Params.Items[I]).TypeDesc), ArgTemp]); + end; + end; + if APT.ReturnType <> nil then + begin + QType := QbeTypeOf(APT.ReturnType); + T := AllocTemp(); + EmitLine(Format(' %s =%s call %s(%s)', [T, QType, FPtrTemp, ArgLine])); + Result := T; + end + else + begin + EmitLine(Format(' call %s(%s)', [FPtrTemp, ArgLine])); + Result := ''; + end; +end; + procedure TCodeGenQBE.EmitProcCall(ACall: TProcCall); var UCaseName: string; @@ -8635,6 +8710,15 @@ var CallTgt: string; begin PMark := PendingReleaseMark(); + { Unqualified call to a procedural-typed field of the current class + (implicit Self.Field) used as a statement. } + if ACall.IsProcFieldCall then + begin + EmitImplicitSelfProcFieldCall(ACall.ProcFieldInfo, + TProceduralTypeDesc(ACall.ResolvedProcType), ACall.Args); + FlushPendingReleases(PMark); + Exit; + end; { Indirect call through a procedural-typed variable: load the function pointer from the variable and call through it. For 'of object' types the variable's slot is a 16-byte (Code, Data) block; load both halves @@ -10444,6 +10528,12 @@ begin Exit(T); end; + { Unqualified call to a procedural-typed field of the current class + (implicit Self.Field) used as an expression. } + if FC.IsProcFieldCall then + Exit(EmitImplicitSelfProcFieldCall(FC.ProcFieldInfo, + TProceduralTypeDesc(FC.ResolvedProcType), FC.Args)); + { Indirect call through a procedural-typed variable: F() / F(args) where F is declared 'var F: TProcType'. Load the function pointer from F and call through it. Must precede the ResolvedDecl=nil diff --git a/compiler/src/main/pascal/uAST.pas b/compiler/src/main/pascal/uAST.pas index bf8369e..7513c3a 100644 --- a/compiler/src/main/pascal/uAST.pas +++ b/compiler/src/main/pascal/uAST.pas @@ -466,6 +466,10 @@ type IsIndirectCall: Boolean; { set by uSemantic — Name is a procedural-typed variable } IndirectCallIsGlobal: Boolean; { set by uSemantic — when IsIndirectCall, variable is global } [Unretained] ResolvedProcType: TObject; { TProceduralTypeDesc — not owned; valid when IsIndirectCall } + IsProcFieldCall: Boolean; { set by uSemantic — unqualified Name is a + procedural-typed field of the current class + (implicit Self.Field), called as a statement } + [Unretained] ProcFieldInfo: TFieldInfo; { not owned — the procedural field, when IsProcFieldCall } constructor Create; destructor Destroy; override; end; @@ -489,6 +493,10 @@ type IsBuiltinHasClassAttr: Boolean; { set by uSemantic — HasClassAttribute builtin } HasClassAttrClass: string; { class name for arg 1 (class being queried) } HasClassAttrAttr: string; { attribute class name for arg 2 } + IsProcFieldCall: Boolean; { set by uSemantic — unqualified Name is a + procedural-typed field of the current class + (implicit Self.Field), used as an expression } + [Unretained] ProcFieldInfo: TFieldInfo; { not owned — the procedural field, when IsProcFieldCall } constructor Create; destructor Destroy; override; end; diff --git a/compiler/src/main/pascal/uSemantic.pas b/compiler/src/main/pascal/uSemantic.pas index 9a0215a..bac3b79 100644 --- a/compiler/src/main/pascal/uSemantic.pas +++ b/compiler/src/main/pascal/uSemantic.pas @@ -8717,6 +8717,7 @@ var I: Integer; PT: TProceduralTypeDesc; PPar: TProcParamInfo; + FldInfo: TFieldInfo; begin { Resolution order matches Delphi/FPC: 1. Local variables / parameters / var-parameters — a `var Run: @@ -8767,6 +8768,38 @@ begin ACall.IsImplicitSelfMethod := True; Exit; end; + { No method of that name — an unqualified procedural-typed field of the + current class (implicit Self.Field) dispatches through its stored + pointer, mirroring the explicit Self.Field() path. } + FldInfo := FCurrentClass.FindField(ACall.Name); + if (FldInfo <> nil) and (FldInfo.TypeDesc <> nil) and + (FldInfo.TypeDesc.Kind = tyProcedural) then + begin + PT := TProceduralTypeDesc(FldInfo.TypeDesc); + if ACall.Args.Count <> PT.Params.Count then + SemanticError(Format( + 'Indirect call ''%s'' expects %d argument(s), got %d', + [ACall.Name, PT.Params.Count, ACall.Args.Count]), + ACall.Line, ACall.Col); + for I := 0 to ACall.Args.Count - 1 do + begin + ArgType := AnalyseExpr(TASTExpr(ACall.Args.Items[I])); + PPar := TProcParamInfo(PT.Params.Items[I]); + if PPar.IsVarParam and + not IsVarArgLValue(TASTExpr(ACall.Args.Items[I])) then + SemanticError( + Format('var argument %d of ''%s'' must be a variable', + [I + 1, ACall.Name]), + ACall.Line, ACall.Col); + CheckTypesMatch(PPar.TypeDesc, ArgType, + Format('argument %d of ''%s''', [I + 1, ACall.Name]), + ACall.Line, ACall.Col); + end; + ACall.IsProcFieldCall := True; + ACall.ProcFieldInfo := FldInfo; + ACall.ResolvedProcType := FldInfo.TypeDesc; + Exit; + end; end; { Try on-demand instantiation of a generic function } if StrPos('<', ACall.Name) >= 0 then @@ -9019,6 +9052,7 @@ var I: Integer; PT: TProceduralTypeDesc; PPar: TProcParamInfo; + FldInfo: TFieldInfo; begin { HasClassAttribute(AClass, AAttrClass): Boolean — runtime query of the custom attribute RTTI stored in slot 7 of the class's typeinfo. Both arguments @@ -9237,6 +9271,40 @@ begin AExpr.ResolvedType := Result; Exit; end; + { No method of that name — an unqualified procedural-typed field of the + current class (implicit Self.Field) called as an expression dispatches + through its stored pointer and yields the signature's return type. } + FldInfo := FCurrentClass.FindField(AExpr.Name); + if (FldInfo <> nil) and (FldInfo.TypeDesc <> nil) and + (FldInfo.TypeDesc.Kind = tyProcedural) then + begin + PT := TProceduralTypeDesc(FldInfo.TypeDesc); + if AExpr.Args.Count <> PT.Params.Count then + SemanticError(Format( + 'Indirect call ''%s'' expects %d argument(s), got %d', + [AExpr.Name, PT.Params.Count, AExpr.Args.Count]), + AExpr.Line, AExpr.Col); + for I := 0 to AExpr.Args.Count - 1 do + begin + ArgType := AnalyseExpr(TASTExpr(AExpr.Args.Items[I])); + PPar := TProcParamInfo(PT.Params.Items[I]); + if PPar.IsVarParam and + not IsVarArgLValue(TASTExpr(AExpr.Args.Items[I])) then + SemanticError( + Format('var argument %d of ''%s'' must be a variable', + [I + 1, AExpr.Name]), + AExpr.Line, AExpr.Col); + CheckTypesMatch(PPar.TypeDesc, ArgType, + Format('argument %d of ''%s''', [I + 1, AExpr.Name]), + AExpr.Line, AExpr.Col); + end; + AExpr.IsProcFieldCall := True; + AExpr.ProcFieldInfo := FldInfo; + AExpr.ResolvedProcType := FldInfo.TypeDesc; + Result := PT.ReturnType; + AExpr.ResolvedType := Result; + Exit; + end; end; { Try on-demand instantiation of a generic function } if StrPos('<', AExpr.Name) >= 0 then diff --git a/compiler/src/test/pascal/cp.test.e2e.misc.pas b/compiler/src/test/pascal/cp.test.e2e.misc.pas index 0e25daa..0aba452 100644 --- a/compiler/src/test/pascal/cp.test.e2e.misc.pas +++ b/compiler/src/test/pascal/cp.test.e2e.misc.pas @@ -50,6 +50,10 @@ type { Method-pointer (of object) field: assign @Obj.Method into a field, then dispatch through it — exercises the 16-byte (Code, Data) field store. } procedure TestRun_MethodPtrField_AssignAndCall; + { Unqualified call to a procedural-typed field via implicit Self (FFn(...) + with no 'Self.' prefix), as an expression and as a statement. } + procedure TestRun_ImplicitSelfProcField_Expr; + procedure TestRun_ImplicitSelfProcField_Stmt; { Default parameters } procedure TestRun_DefaultParam_OmitLast; @@ -458,6 +462,52 @@ const end. '''; + { Unqualified (implicit-Self) call to a procedural-typed field, as an + expression — FFn(...) with no 'Self.' prefix. } + SrcImplicitProcFieldExpr = ''' + program Prg; + type + TFn = function(A, B, C: Integer): Integer; + TBox = class + FFn: TFn; + function Run(X: Integer): Integer; + end; + function Sum3(A, B, C: Integer): Integer; + begin Result := A + B + C end; + function TBox.Run(X: Integer): Integer; + begin Result := FFn(X, X + 1, X + 2) end; + var B: TBox; + begin + B := TBox.Create(); + B.FFn := @Sum3; + WriteLn(IntToStr(B.Run(10))); + B.Free() + end. + '''; + + { Unqualified (implicit-Self) call to a procedural-typed field, as a + statement. } + SrcImplicitProcFieldStmt = ''' + program Prg; + type + TFn = procedure(const S: string); + TBox = class + FFn: TFn; + procedure Run; + end; + procedure Hi(const S: string); + begin WriteLn(S) end; + procedure TBox.Run; + begin FFn('hi') end; + var B: TBox; + begin + B := TBox.Create(); + B.FFn := @Hi; + B.Run(); + B.Free() + end. + '''; + SrcDefaultParam = ''' program Prg; function Add(A: Integer; B: Integer = 10): Integer; @@ -805,6 +855,18 @@ begin AssertRunsOnAll(SrcMethodPtrField, 'T:hello' + LE, 0); end; +procedure TE2EMiscTests.TestRun_ImplicitSelfProcField_Expr; +begin + if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit; end; + AssertRunsOnAll(SrcImplicitProcFieldExpr, '33' + LE, 0); +end; + +procedure TE2EMiscTests.TestRun_ImplicitSelfProcField_Stmt; +begin + if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit; end; + AssertRunsOnAll(SrcImplicitProcFieldStmt, 'hi' + LE, 0); +end; + procedure TE2EMiscTests.TestRun_DefaultParam_OmitLast; begin if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit; end; diff --git a/compiler/src/test/pascal/cp.test.proctypes.pas b/compiler/src/test/pascal/cp.test.proctypes.pas index 9e076b8..5333acc 100644 --- a/compiler/src/test/pascal/cp.test.proctypes.pas +++ b/compiler/src/test/pascal/cp.test.proctypes.pas @@ -51,6 +51,9 @@ type expression (Result := Self.FFn(S)) must type to the field's return type and dispatch through the loaded pointer, not a direct call. } procedure TestCodegen_ProcFieldCallExpr_IndirectNotDirect; + { An unqualified procedural-field call via implicit Self (Result := FFn(S), + no 'Self.' prefix) must resolve and dispatch through Self's field. } + procedure TestCodegen_ImplicitSelfProcFieldCall_LoadsSelf; end; implementation @@ -586,6 +589,40 @@ begin IRContains(IR, 'call $FFn(')); end; +procedure TProcTypesTests.TestCodegen_ImplicitSelfProcFieldCall_LoadsSelf; +var + IR: string; +begin + { Regression: an unqualified FFn(...) where FFn is a procedural field used + to fail with "Undeclared function". It must now resolve as an implicit + Self.Field call: load Self, then dispatch through a temp. } + IR := GenIR( + ''' + program Test; + type + TFn = function(const S: string): Integer; + TBox = class + FFn: TFn; + function Run(const S: string): Integer; + end; + function TBox.Run(const S: string): Integer; + begin + Result := FFn(S) + end; + var + B: TBox; + begin + end. + ''' + ); + AssertTrue('Implicit-Self field call must load Self', + IRContains(IR, 'loadl %_var_Self')); + AssertTrue('Implicit-Self field call must dispatch through a temp', + IRContains(IR, 'call %')); + AssertFalse('Implicit-Self field call must not be a direct call to $FFn', + IRContains(IR, 'call $FFn(')); +end; + initialization RegisterTest(TProcTypesTests); diff --git a/tools/bif-coverage/bif-coverage.status b/tools/bif-coverage/bif-coverage.status index fce9f5b..b2a67d6 100644 --- a/tools/bif-coverage/bif-coverage.status +++ b/tools/bif-coverage/bif-coverage.status @@ -214,6 +214,7 @@ TProcCall.Args serialise TProcCall.IsImplicitSelfMethod safe TProcCall.IsIndirectCall safe TProcCall.IndirectCallIsGlobal safe +TProcCall.IsProcFieldCall safe # TFuncCallExpr (uAST.pas:465) TFuncCallExpr.Name serialise @@ -224,6 +225,7 @@ TFuncCallExpr.IndirectCallIsGlobal safe TFuncCallExpr.IsBuiltinHasClassAttr safe TFuncCallExpr.HasClassAttrClass safe TFuncCallExpr.HasClassAttrAttr safe +TFuncCallExpr.IsProcFieldCall safe # TIndirectFuncCallExpr (uAST.pas:491) TIndirectFuncCallExpr.CalleeExpr serialise