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 9dbed15..bba076e 100644 --- a/compiler/src/main/pascal/blaise.codegen.native.x86_64.pas +++ b/compiler/src/main/pascal/blaise.codegen.native.x86_64.pas @@ -240,7 +240,8 @@ type the supplied generic-instance lists. } procedure EmitClassMethods(ATypeDecls: TObjectList; AGenericInstances: TObjectList; - AGenericRecordInstances: TObjectList); + AGenericRecordInstances: TObjectList; + AGenericMethodInstances: TObjectList); { Resolve a class/interface name to its assembly symbol form, adding the unit prefix when the type is defined in a non-system unit. Mirrors the @@ -3162,7 +3163,8 @@ end; procedure TX86_64Backend.EmitClassMethods(ATypeDecls: TObjectList; AGenericInstances: TObjectList; - AGenericRecordInstances: TObjectList); + AGenericRecordInstances: TObjectList; + AGenericMethodInstances: TObjectList); var I, J: Integer; TD: TTypeDecl; @@ -3170,6 +3172,7 @@ var RD: TRecordTypeDef; GI: TGenericInstance; GRI: TGenericRecordInstance; + GMI: TGenericMethodInstance; Decl: TMethodDecl; SavedUnit: string; begin @@ -3183,6 +3186,8 @@ begin begin Decl := TMethodDecl(CD.Methods.Items[J]); if Decl.Body = nil then Continue; + { Generic-method templates emit per instantiation, not as a template. } + if Decl.TypeParams <> nil then Continue; Self.EmitFunctionDef(Decl); end; end @@ -3193,6 +3198,7 @@ begin begin Decl := TMethodDecl(RD.Methods.Items[J]); if Decl.Body = nil then Continue; + if Decl.TypeParams <> nil then Continue; Self.EmitFunctionDef(Decl); end; end; @@ -3228,6 +3234,16 @@ begin Self.EmitFunctionDef(Decl); end; end; + + { Generic METHOD instances (method-level ): each monomorphised body. Its + ResolvedQbeName encodes _ and OwnerTypeName is set, so + EmitFunctionDef emits it with the implicit Self like any method. } + for I := 0 to AGenericMethodInstances.Count - 1 do + begin + GMI := TGenericMethodInstance(AGenericMethodInstances.Items[I]); + if GMI.MethodDecl.Body <> nil then + Self.EmitFunctionDef(GMI.MethodDecl); + end; end; { ------------------------------------------------------------------ } @@ -14169,7 +14185,7 @@ begin { Class method bodies before standalone procedures. } Self.EmitClassMethods(AProg.Block.TypeDecls, AProg.GenericInstances, - AProg.GenericRecordInstances); + AProg.GenericRecordInstances, AProg.GenericMethodInstances); { Array-typed constants — emit data sections so const arrays are defined as assembly labels before being referenced in code. Covers block-level @@ -14313,7 +14329,7 @@ begin generic class/record instances declared in this unit. After LinkClassMethodImpls the definition's TMethodDecl nodes hold the bodies. } Self.EmitClassMethods(AUnit.IntfBlock.TypeDecls, AUnit.GenericInstances, - AUnit.GenericRecordInstances); + AUnit.GenericRecordInstances, AUnit.GenericMethodInstances); { Array-typed constants from both interface and implementation blocks. } Self.EmitArrayConstData(AUnit.IntfBlock, ''); diff --git a/compiler/src/main/pascal/blaise.codegen.qbe.pas b/compiler/src/main/pascal/blaise.codegen.qbe.pas index 735844f..f9b9c6f 100644 --- a/compiler/src/main/pascal/blaise.codegen.qbe.pas +++ b/compiler/src/main/pascal/blaise.codegen.qbe.pas @@ -7743,6 +7743,7 @@ var RD: TRecordTypeDef; GI: TGenericInstance; GRI: TGenericRecordInstance; + GMI: TGenericMethodInstance; MDecl: TMethodDecl; Methods: TObjectList; SavedUnit: string; @@ -7763,7 +7764,10 @@ begin else Continue; for J := 0 to Methods.Count - 1 do - if TMethodDecl(Methods.Items[J]).Body <> nil then + if (TMethodDecl(Methods.Items[J]).Body <> nil) and + { Generic-method templates (method-level ) are emitted per + instantiation via GenericMethodInstances, not as a template body. } + (TMethodDecl(Methods.Items[J]).TypeParams = nil) then EmitMethodDef(TD.Name, TMethodDecl(Methods.Items[J])); end; @@ -7799,6 +7803,16 @@ begin EmitMethodDef(QBEMangle(GRI.TypeName), MDecl); end; end; + + { Generic METHOD instances (method-level ) — emit each monomorphised body. + Its ResolvedQbeName already encodes _, so EmitMethodDef + uses that label and adds the implicit Self param. } + for I := 0 to AProg.GenericMethodInstances.Count - 1 do + begin + GMI := TGenericMethodInstance(AProg.GenericMethodInstances.Items[I]); + if GMI.MethodDecl.Body <> nil then + EmitMethodDef(GMI.OwnerType, GMI.MethodDecl); + end; end; procedure TCodeGenQBE.EmitFuncDef(ADecl: TMethodDecl; AExported: Boolean); diff --git a/compiler/src/main/pascal/uAST.pas b/compiler/src/main/pascal/uAST.pas index d85b0a1..2b0abfb 100644 --- a/compiler/src/main/pascal/uAST.pas +++ b/compiler/src/main/pascal/uAST.pas @@ -894,6 +894,19 @@ type destructor Destroy; override; end; + { A monomorphised generic METHOD instance (method-level ): a method that + declares its own type parameters, instantiated at a call site. OwnerType + is the class/record the method belongs to; the instance keeps an implicit + Self and is emitted as OwnerType_Method_. } + TGenericMethodInstance = class + public + OwnerType: string; { the class/record name } + InstName: string; { method name with type args, e.g. 'Pick' } + MethodDecl: TMethodDecl; { owned — concrete method decl with substituted types } + constructor Create; + destructor Destroy; override; + end; + { One concrete instantiation produced by monomorphization — stored on TProgram. Codegen iterates this list to emit typeinfo, vtables, and method bodies. } TGenericInstance = class @@ -977,6 +990,7 @@ type SymbolTable: TSymbolTable; { owned after semantic analysis; nil before } GenericInstances: TObjectList; { owned TGenericInstance — populated by uSemantic } GenericFuncInstances: TObjectList; { owned TGenericFuncInstance — populated by uSemantic } + GenericMethodInstances: TObjectList; { owned TGenericMethodInstance — populated by uSemantic } GenericIntfInstances: TObjectList; { owned TGenericInterfaceInstance — populated by uSemantic } GenericRecordInstances: TObjectList; { owned TGenericRecordInstance — populated by uSemantic } constructor Create; @@ -999,6 +1013,7 @@ type program (program owns the table). } GenericInstances: TObjectList; GenericFuncInstances: TObjectList; + GenericMethodInstances: TObjectList; GenericIntfInstances: TObjectList; GenericRecordInstances: TObjectList; constructor Create; @@ -1535,6 +1550,17 @@ begin inherited Destroy(); end; +constructor TGenericMethodInstance.Create; +begin + inherited Create(); +end; + +destructor TGenericMethodInstance.Destroy; +begin + { Owned class fields released by ARC field cleanup. } + inherited Destroy(); +end; + { TGenericInterfaceDef } constructor TGenericInterfaceDef.Create; @@ -1692,6 +1718,7 @@ begin UsedUnits := TStringList.Create(); GenericInstances := TObjectList.Create(True); GenericFuncInstances := TObjectList.Create(True); + GenericMethodInstances := TObjectList.Create(True); GenericIntfInstances := TObjectList.Create(True); GenericRecordInstances := TObjectList.Create(True); end; @@ -1721,6 +1748,7 @@ begin FinalStmts := nil; GenericInstances := TObjectList.Create(True); GenericFuncInstances := TObjectList.Create(True); + GenericMethodInstances := TObjectList.Create(True); GenericIntfInstances := TObjectList.Create(True); GenericRecordInstances := TObjectList.Create(True); end; diff --git a/compiler/src/main/pascal/uParser.pas b/compiler/src/main/pascal/uParser.pas index 0b32aaf..2d48825 100644 --- a/compiler/src/main/pascal/uParser.pas +++ b/compiler/src/main/pascal/uParser.pas @@ -4030,6 +4030,23 @@ begin [FCurrent.Line, FCurrent.Col, FLexer.Filename])); SecondName := FCurrent.Value; Advance(); + { Generic-method call: IDENT '.' IDENT '<' TypeArgs '>' '(' ... ')'. + Fold the explicit type arguments into the method name + (Pick), mirroring the generic free-function call site; the + semantic pass instantiates on the '<' in the name. } + if Check(tkLessThan) and (PeekKind() = tkIdent) and + (PeekKind2() in [tkGreaterThan, tkComma, tkLessThan]) then + begin + Advance(); { consume '<' } + SecondName := SecondName + '<' + ParseTypeName(); + while Check(tkComma) do + begin + Advance(); + SecondName := SecondName + ',' + ParseTypeName(); + end; + Expect(tkGreaterThan); + SecondName := SecondName + '>'; + end; if Check(tkLParen) then begin { IDENT '.' IDENT '(' ... ')' — method call expression } diff --git a/compiler/src/main/pascal/uSemantic.pas b/compiler/src/main/pascal/uSemantic.pas index 5a4fc55..2518830 100644 --- a/compiler/src/main/pascal/uSemantic.pas +++ b/compiler/src/main/pascal/uSemantic.pas @@ -50,6 +50,7 @@ type lifetime; the destructor frees this list, releasing the groups. } FGroupKeepAlive: TObjectList; FGenericFuncTemplates: TStringList; { base name → TMethodDecl template (not owned) } + FGenericMethodTemplates: TStringList; { 'OwnerType.Method' → TMethodDecl template (not owned) — generic methods with method-level } FLoopDepth: Integer; { depth of enclosing while/for — Break only legal if > 0 } FScopeDepth: Integer; { mirrors FTable scope depth; used to detect main-level globals } FCurrentClass: TRecordTypeDesc; { class being analysed (set in AnalyseMethodDecl) } @@ -131,6 +132,10 @@ type { Generic function instantiation: resolves 'Identity' on demand. } function InstantiateGenericFunc(const AInstName: string): TMethodDecl; + { Generic method instantiation: resolves 'Pick' on an owner class + on demand, preserving the implicit Self. Returns the monomorphised + TMethodDecl (with ResolvedQbeName set), or nil if not a generic method. } + function InstantiateGenericMethod(const AOwnerType, AInstName: string): TMethodDecl; procedure AnalyseBlock(ABlock: TBlock; AIsProgramTop: Boolean = False); procedure AnalyseConstDecls(ABlock: TBlock); @@ -468,6 +473,8 @@ begin FGroupKeepAlive := TObjectList.Create(False); FGenericFuncTemplates := TStringList.Create(); FGenericFuncTemplates.CaseSensitive := False; + FGenericMethodTemplates := TStringList.Create(); + FGenericMethodTemplates.CaseSensitive := False; FCurrentUsesChain := TStringList.Create(); FCurrentUsesChain.CaseSensitive := False; FUnitIfaces := TStringList.Create(); @@ -486,6 +493,7 @@ begin FUnitIfaces.Free(); FCurrentUsesChain.Free(); FGenericFuncTemplates.Free(); + FGenericMethodTemplates.Free(); { Releasing the keep-alive releases every group list; the group string lists themselves only hold raw pointers. } FGroupKeepAlive.Free(); @@ -3050,6 +3058,165 @@ begin end; end; +function TSemanticAnalyser.InstantiateGenericMethod( + const AOwnerType, AInstName: string): TMethodDecl; +{ AInstName is the method name with type args, e.g. 'Pick'. Mirrors + InstantiateGenericFunc but preserves the implicit Self: the instance is + analysed as a method of AOwnerType and emitted as _. } +var + BaseName: string; + ArgsStr: string; + TemplIdx: Integer; + BracPos: Integer; + Templ: TMethodDecl; + Args: TStringList; + NewMDecl: TMethodDecl; + NewPar: TMethodParam; + OldPar: TMethodParam; + ParTypeName: string; + RetTypeName: string; + SubstType: TTypeDesc; + OwnerSym: TSymbol; + OwnerRT: TRecordTypeDesc; + GMI: TGenericMethodInstance; + I, J: Integer; +begin + Result := nil; + BracPos := StrPos('<', AInstName); + if BracPos < 0 then Exit; + BaseName := StrHead(AInstName, BracPos); + ArgsStr := StrCopyFrom(AInstName, BracPos + 1, Length(AInstName) - BracPos - 2); + + TemplIdx := FGenericMethodTemplates.IndexOf(AOwnerType + '.' + BaseName); + if TemplIdx < 0 then Exit; { not a known generic method on this owner } + Templ := TMethodDecl(FGenericMethodTemplates.Objects[TemplIdx]); + + OwnerSym := FTable.Lookup(AOwnerType); + if (OwnerSym = nil) or not (OwnerSym.TypeDesc is TRecordTypeDesc) then Exit; + OwnerRT := TRecordTypeDesc(OwnerSym.TypeDesc); + + { Idempotent: a second call site with the same type args reuses the existing + instance rather than emitting a duplicate symbol. } + if FCurrentUnit <> nil then + begin + for I := 0 to FCurrentUnit.GenericMethodInstances.Count - 1 do + begin + GMI := TGenericMethodInstance(FCurrentUnit.GenericMethodInstances.Items[I]); + if SameText(GMI.OwnerType, AOwnerType) and SameText(GMI.InstName, AInstName) then + Exit(GMI.MethodDecl); + end; + end + else + for I := 0 to FProg.GenericMethodInstances.Count - 1 do + begin + GMI := TGenericMethodInstance(FProg.GenericMethodInstances.Items[I]); + if SameText(GMI.OwnerType, AOwnerType) and SameText(GMI.InstName, AInstName) then + Exit(GMI.MethodDecl); + end; + + Args := TStringList.Create(); + try + while Length(ArgsStr) > 0 do + begin + BracPos := StrPos(',', ArgsStr); + if BracPos >= 0 then + begin + Args.Add(Trim(StrHead(ArgsStr, BracPos))); + ArgsStr := Trim(StrCopyTail(ArgsStr, BracPos + 1)); + end + else + begin + Args.Add(Trim(ArgsStr)); + ArgsStr := ''; + end; + end; + + if Args.Count <> Templ.TypeParams.Count then + SemanticError( + Format('Generic method ''%s.%s'' expects %d type parameter(s) but got %d', + [AOwnerType, BaseName, Templ.TypeParams.Count, Args.Count]), + 0, 0); + for I := 0 to Args.Count - 1 do + if (Templ.TypeParamConstraints <> nil) and + (I < Templ.TypeParamConstraints.Count) then + CheckTypeParamConstraint(Templ.TypeParams.Strings[I], Args.Strings[I], + Templ.TypeParamConstraints.Strings[I], + Format('generic method ''%s.%s''', [AOwnerType, BaseName])); + + NewMDecl := TMethodDecl.Create(); + NewMDecl.Name := AInstName; + NewMDecl.OwnerTypeName := AOwnerType; + NewMDecl.IsRecordMethod := Templ.IsRecordMethod; + { Mangled symbol: _ -> QBEMangle drops the <> + and joins with '_', e.g. TUtil_Pick_Integer. } + NewMDecl.ResolvedQbeName := CurrentUnitPrefix() + AOwnerType + '_' + AInstName; + + if Templ.Body <> nil then + begin + NewMDecl.Body := CloneBlock(Templ.Body); + NewMDecl.OwnBody := True; + for I := 0 to NewMDecl.Body.Decls.Count - 1 do + TVarDecl(NewMDecl.Body.Decls.Items[I]).TypeName := + Self.SubstTypeParam(TVarDecl(NewMDecl.Body.Decls.Items[I]).TypeName, + Templ.TypeParams, Args); + end + else + begin + NewMDecl.Body := nil; + NewMDecl.OwnBody := False; + end; + + RetTypeName := Templ.ReturnTypeName; + for I := 0 to Templ.TypeParams.Count - 1 do + if SameText(RetTypeName, Templ.TypeParams.Strings[I]) then + RetTypeName := Args.Strings[I]; + NewMDecl.ReturnTypeName := RetTypeName; + if RetTypeName <> '' then + begin + SubstType := FindTypeOrInstantiate(RetTypeName); + if SubstType = nil then + SemanticError(Format('Unknown type ''%s'' in generic method instance ''%s.%s''', + [RetTypeName, AOwnerType, AInstName]), 0, 0); + NewMDecl.ResolvedReturnType := SubstType; + end; + + for I := 0 to Templ.Params.Count - 1 do + begin + OldPar := TMethodParam(Templ.Params.Items[I]); + NewPar := TMethodParam.Create(); + NewPar.ParamName := OldPar.ParamName; + NewPar.IsVarParam := OldPar.IsVarParam; + ParTypeName := OldPar.TypeName; + for J := 0 to Templ.TypeParams.Count - 1 do + if SameText(ParTypeName, Templ.TypeParams.Strings[J]) then + ParTypeName := Args.Strings[J]; + NewPar.TypeName := ParTypeName; + SubstType := FindTypeOrInstantiate(ParTypeName); + if SubstType = nil then + SemanticError(Format('Unknown type ''%s'' for parameter ''%s'' in ''%s.%s''', + [ParTypeName, NewPar.ParamName, AOwnerType, AInstName]), 0, 0); + NewPar.ResolvedType := SubstType; + NewMDecl.Params.Add(NewPar); + end; + + { Analyse the body with Self (the owner) and concrete types in scope. } + AnalyseMethodDecl(NewMDecl, OwnerRT); + + GMI := TGenericMethodInstance.Create(); + GMI.OwnerType := AOwnerType; + GMI.InstName := AInstName; + GMI.MethodDecl := NewMDecl; + if FCurrentUnit <> nil then + FCurrentUnit.GenericMethodInstances.Add(GMI) + else + FProg.GenericMethodInstances.Add(GMI); + + Result := NewMDecl; + finally + Args.Free(); + end; +end; + procedure TSemanticAnalyser.AnalyseBlock(ABlock: TBlock; AIsProgramTop: Boolean = False); var I: Integer; @@ -4054,6 +4221,16 @@ begin for J := 0 to MethodList.Count - 1 do begin MDecl := TMethodDecl(MethodList.Items[J]); + { Generic method (method-level ): params/return reference the + method's own type params, unknown until a call site instantiates it. + Register the template keyed by OwnerType.Method and skip resolution. } + if MDecl.TypeParams <> nil then + begin + MDecl.OwnerTypeName := RT.Name; + if FGenericMethodTemplates.IndexOf(RT.Name + '.' + MDecl.Name) < 0 then + FGenericMethodTemplates.AddObject(RT.Name + '.' + MDecl.Name, MDecl); + Continue; + end; for K := 0 to MDecl.Params.Count - 1 do begin Par := TMethodParam(MDecl.Params.Items[K]); @@ -4079,6 +4256,9 @@ begin for J := 0 to MethodList.Count - 1 do begin MDecl := TMethodDecl(MethodList.Items[J]); + { Generic-method templates take no vtable slot — they cannot be + virtual (each instantiation is a distinct monomorphised body). } + if MDecl.TypeParams <> nil then Continue; MangledKey := MDecl.Name; if MDecl.IsOverload then MangledKey := MangledKey + '$' + MangleParamSig(MDecl); @@ -4453,7 +4633,21 @@ var Par: TMethodParam; Sym: TSymbol; SavedClass: TRecordTypeDesc; + TKey: string; begin + { Generic method (method-level ): its params/body reference the method's + own type parameters, which are not in scope until a call site instantiates + it. Register the template keyed by OwnerType.Method and defer analysis to + InstantiateGenericMethod. (A method of a generic CLASS uses OwnerTypeParams, + not TypeParams, and is NOT skipped here.) } + if AMethod.TypeParams <> nil then + begin + TKey := AClassType.Name + '.' + AMethod.Name; + if FGenericMethodTemplates.IndexOf(TKey) < 0 then + FGenericMethodTemplates.AddObject(TKey, AMethod); + AMethod.OwnerTypeName := AClassType.Name; + Exit; + end; SavedClass := FCurrentClass; FCurrentClass := AClassType; FTable.PushScope(); @@ -8850,6 +9044,26 @@ begin Fall back to a plain chain lookup for the no-overload / single case. } for I := 0 to AExpr.Args.Count - 1 do AnalyseExpr(TASTExpr(AExpr.Args.Items[I])); + { Generic method call obj.Pick(...): the parser folded the explicit + type args into AExpr.Name. Instantiate the monomorphised method and use it + directly (it is not part of the overload set). } + if StrPos('<', AExpr.Name) >= 0 then + begin + MDecl := InstantiateGenericMethod(RT.Name, AExpr.Name); + if MDecl = nil then + SemanticError(Format('Class ''%s'' has no generic method ''%s''', + [RT.Name, AExpr.Name]), AExpr.Line, AExpr.Col); + AExpr.ResolvedClassType := RT; + AExpr.ResolvedMethod := MDecl; + AExpr.IsGlobal := ObjSym.IsGlobal; + AExpr.IsVarParam := + (ObjSym.Kind = skVarParameter) or + ((ObjSym.Kind = skParameter) and (ObjSym.TypeDesc <> nil) and + (ObjSym.TypeDesc.Kind in [tyRecord, tyStaticArray])); + Result := MDecl.ResolvedReturnType; + AExpr.ResolvedType := Result; + Exit; + end; MDecl := ResolveMethodOverload(RT.Name, AExpr.Name, AExpr.Args, AExpr.Line, AExpr.Col); if MDecl = nil then diff --git a/compiler/src/test/pascal/cp.test.e2e.generics.pas b/compiler/src/test/pascal/cp.test.e2e.generics.pas index 4be85c5..1ba3b04 100644 --- a/compiler/src/test/pascal/cp.test.e2e.generics.pas +++ b/compiler/src/test/pascal/cp.test.e2e.generics.pas @@ -49,6 +49,12 @@ type interface — class(IVal) on a generic template must wire AddImplements. } procedure TestRun_GenericClassImplementsInterface; procedure TestRun_GenericClassImplementsInterface_MethodArgs; + { Generic METHODS (method-level ): a method declaring its own type + parameter, instantiated per call site (obj.M(...)). } + procedure TestRun_GenericMethod_Pick; + procedure TestRun_GenericMethod_TwoInstantiations; + procedure TestRun_GenericMethod_UsesSelfField; + procedure TestRun_GenericMethod_TwoTypeParams; end; implementation @@ -343,6 +349,93 @@ begin AssertRunsOnAll(SrcGenericImplementsIntfArgs, '42' + LE, 0); end; +const + SrcGenMethodPick = ''' + program Prog; + type + TUtil = class + function Pick(cond: Boolean; a, b: T): T; + begin if cond then Result := a else Result := b end; + end; + var u: TUtil; + begin + u := TUtil.Create; + WriteLn(u.Pick(True, 7, 9)); + WriteLn(u.Pick(False, 7, 9)); + u := nil + end. + '''; + + SrcGenMethodTwo = ''' + program Prog; + type + TUtil = class + function Echo(x: T): T; begin Result := x end; + end; + var u: TUtil; + begin + u := TUtil.Create; + WriteLn(u.Echo(42)); + WriteLn(u.Echo('hi')); + u := nil + end. + '''; + + SrcGenMethodSelf = ''' + program Prog; + type + TBox = class + FBase: Integer; + constructor Create(b: Integer); begin FBase := b end; + function Combine(x: T): T; begin Result := x end; + function Offset: Integer; begin Result := FBase end; + end; + var b: TBox; + begin + b := TBox.Create(100); + WriteLn(b.Combine(5) + b.Offset()); + b := nil + end. + '''; + + SrcGenMethodTwoParams = ''' + program Prog; + type + TUtil = class + function First(x: A; y: B): A; begin Result := x end; + end; + var u: TUtil; + begin + u := TUtil.Create; + WriteLn(u.First(7, 'ignored')); + u := nil + end. + '''; + +procedure TE2EGenericsTests.TestRun_GenericMethod_Pick; +begin + if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit; end; + AssertRunsOnAll(SrcGenMethodPick, '7' + LE + '9' + LE, 0); +end; + +procedure TE2EGenericsTests.TestRun_GenericMethod_TwoInstantiations; +begin + if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit; end; + AssertRunsOnAll(SrcGenMethodTwo, '42' + LE + 'hi' + LE, 0); +end; + +procedure TE2EGenericsTests.TestRun_GenericMethod_UsesSelfField; +begin + if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit; end; + AssertRunsOnAll(SrcGenMethodSelf, '105' + LE, 0); +end; + +procedure TE2EGenericsTests.TestRun_GenericMethod_TwoTypeParams; +begin + if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit; end; + AssertRunsOnAll(SrcGenMethodTwoParams, '7' + LE, 0); +end; + initialization RegisterTest(TE2EGenericsTests); diff --git a/compiler/src/test/pascal/cp.test.genericfuncs.pas b/compiler/src/test/pascal/cp.test.genericfuncs.pas index e6d2389..f35c378 100644 --- a/compiler/src/test/pascal/cp.test.genericfuncs.pas +++ b/compiler/src/test/pascal/cp.test.genericfuncs.pas @@ -53,6 +53,9 @@ type { ------------------------------------------------------------------ } procedure TestCodegen_GenericFunc_BodyEmitted; procedure TestCodegen_GenericFunc_CallEmitted; + { Generic METHOD (method-level ) — monomorphised body + call site. } + procedure TestCodegen_GenericMethod_BodyEmitted; + procedure TestCodegen_GenericMethod_CallEmitted; end; implementation @@ -382,6 +385,36 @@ begin Pos('call $Identity_Integer', IR) > 0); end; +const + SrcGenericMethodUsage = + ''' + program Prog; + type + TUtil = class + function Echo(x: T): T; begin Result := x end; + end; + var u: TUtil; r: Integer; + begin u := TUtil.Create(); r := u.Echo(42); WriteLn(r) end. + '''; + +procedure TGenericFuncTests.TestCodegen_GenericMethod_BodyEmitted; +var + IR: string; +begin + IR := GenIR(SrcGenericMethodUsage); + AssertTrue('generic-method body emitted with mangled owner_method_type name', + Pos('$TUtil_Echo_Integer', IR) > 0); +end; + +procedure TGenericFuncTests.TestCodegen_GenericMethod_CallEmitted; +var + IR: string; +begin + IR := GenIR(SrcGenericMethodUsage); + AssertTrue('generic-method call emitted with mangled name', + Pos('call $TUtil_Echo_Integer', IR) > 0); +end; + initialization RegisterTest(TGenericFuncTests); end. diff --git a/docs/grammar.ebnf b/docs/grammar.ebnf index cb1377a..6c55c84 100644 --- a/docs/grammar.ebnf +++ b/docs/grammar.ebnf @@ -861,9 +861,20 @@ FieldAssignment ; MethodCall - = IDENT DOT IDENT LPAREN [ ArgList ] RPAREN + = IDENT DOT IDENT + [ LESS TypeArgList GREATER ] (* explicit args for a generic method *) + LPAREN [ ArgList ] RPAREN ; +(* Generic method call: Obj.Method(args). The optional + * LESS TypeArgList GREATER supplies explicit type arguments for a method that + * declares its own type parameters (MethodDecl's [ LESS TypeParamList GREATER ]). + * The parser folds the type args into the method name (Method) and the + * semantic pass monomorphises the method on first use. The leading-'<' is + * disambiguated from a comparison by the same two-token lookahead used for + * generic free-function calls. Only the INLINE-body method form is supported; + * the out-of-line impl function TOwner.Method(...) is not yet parsed. *) + (* Semantic disambiguation of IDENT DOT IDENT in Stmt: * - Followed by ASSIGN or LBRACKET ASSIGN → FieldAssignment (plain or indexed) * - Otherwise → MethodCall diff --git a/docs/language-rationale.adoc b/docs/language-rationale.adoc index 260fd16..4940720 100644 --- a/docs/language-rationale.adoc +++ b/docs/language-rationale.adoc @@ -3417,6 +3417,55 @@ inside generic records are handled by the existing record-cleanup logic at variable scope exit, not by class-style field cleanup. +== Generic Methods + +=== Decision + +A class or record method may declare its *own* type parameters, independent of +any type parameters on the enclosing type: + +[source,pascal] +---- +type + TUtil = class + function Pick(cond: Boolean; a, b: T): T; + begin if cond then Result := a else Result := b end; + end; +... + u.Pick(True, 7, 9); // -> 7 + u.Pick(False, 'a', 'b'); // -> 'b' +---- + +The method is *monomorphised* on first use: each distinct set of explicit type +arguments at a call site produces one concrete method body, named +`__` (e.g. `TUtil_Pick_Integer`). The implicit `Self` is +preserved, so a generic method may read the receiver's fields and call its +other methods. Type arguments are explicit at the call site +(`u.Pick(...)`); they are not inferred from the value arguments. + +This is distinct from a method of a generic *class* (`TBox` and its +`function Get: T`), where the type parameter `T` is bound by the class +instantiation, not the method. The two compose: a generic class may have a +method with its own additional type parameters. + +=== Rationale + +Generic methods reuse the existing generic free-function machinery: the same +on-demand instantiation, the same `` type-parameter scoping during body +analysis, and the same `QBEMangle`/`NativeMangle` name mangling (`<`/`,` -> +`_`, `>` dropped). The only addition over a free function is carrying the +owner type and the implicit `Self` through to codegen, so the instance emits as +an ordinary method. Monomorphisation (rather than type erasure) keeps the +model uniform with generic classes and records and needs no runtime type +descriptors. + +=== Current limitation + +Only the *inline-body* declaration form is supported (the body written inside +the class). The out-of-line implementation form +`function TUtil.Pick(...)` with the body separated from the class is not yet +parsed. + == Platform constants — one name per concept Delphi and FPC carry multiple aliases for the same platform constant: