paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-09-14 14:29:14 +02:00
Code Issues Packages Projects Releases Wiki Activity

Turn TCallCandidates into an object, make it create FIgnoredCandidateProcs on demand, and outline such adding on demand into dedicated TFPList.AddOnDemand.

Browse Source
This commit is contained in:
Rika Ichinose 2022-01-06 22:36:38 +03:00 committed by FPK
parent b74411cf03
commit 326776c7fa
4 changed files with 60 additions and 54 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
compiler/cclasses.pas
View File

@ -110,6 +110,12 @@ type
property Capacity: Integer read FCapacity write SetCapacity; property Capacity: Integer read FCapacity write SetCapacity;
property Count: Integer read FCount write SetCount; property Count: Integer read FCount write SetCount;
property Items[Index: Integer]: Pointer read Get write Put; default; property Items[Index: Integer]: Pointer read Get write Put; default;
{ Add to list, creating it if required. }
class procedure AddOnDemand(var Lst: TFPList; Item: Pointer); static;
{ FreeAndNil the list, and its items as TObjects. }
class procedure FreeAndNilObjects(var Lst: TFPList); static;
end; end;
@ -1031,6 +1037,27 @@ begin
end; end;
end; end;
class procedure TFPList.AddOnDemand(var Lst: TFPList; Item: Pointer);
begin
if not Assigned(Lst) then
Lst := TFPList.Create;
Lst.Add(Item);
end;
class procedure TFPList.FreeAndNilObjects(var Lst: TFPList);
var
Lp: PPointer;
I: SizeInt;
begin
if not Assigned(Lst) then
exit;
Lp := Lst.FList;
for I := 0 to Lst.Count-1 do
TObject(Lp[I]).Free;
Lst.Free;
Lst := nil;
end;
{***************************************************************************** {*****************************************************************************
TFPObjectList (Copied from rtl/objpas/classes/lists.inc) TFPObjectList (Copied from rtl/objpas/classes/lists.inc)

57
compiler/htypechk.pas
View File

@ -69,13 +69,13 @@ interface
wrongparanr : byte; wrongparanr : byte;
end; end;
tcallcandidates = class tcallcandidates = object
private private
FProcsym : tprocsym; FProcsym : tprocsym;
FProcsymtable : tsymtable; FProcsymtable : tsymtable;
FOperator : ttoken; FOperator : ttoken;
FCandidateProcs : pcandidate; FCandidateProcs : pcandidate;
FIgnoredCandidateProcs: tfpobjectlist; FIgnoredCandidateProcs : tfplist;
FProcCnt : integer; FProcCnt : integer;
FParaNode : tnode; FParaNode : tnode;
FParaLength : smallint; FParaLength : smallint;
@ -87,9 +87,9 @@ interface
procedure calc_distance(st_root:tsymtable;objcidcall: boolean); procedure calc_distance(st_root:tsymtable;objcidcall: boolean);
function proc_add(st:tsymtable;pd:tprocdef;objcidcall: boolean):pcandidate; function proc_add(st:tsymtable;pd:tprocdef;objcidcall: boolean):pcandidate;
public public
constructor create(sym:tprocsym;st:TSymtable;ppn:tnode;ignorevisibility,allowdefaultparas,objcidcall,explicitunit,searchhelpers,anoninherited:boolean;spezcontext:tspecializationcontext); constructor init(sym:tprocsym;st:TSymtable;ppn:tnode;ignorevisibility,allowdefaultparas,objcidcall,explicitunit,searchhelpers,anoninherited:boolean;spezcontext:tspecializationcontext);
constructor create_operator(op:ttoken;ppn:tnode); constructor init_operator(op:ttoken;ppn:tnode);
destructor destroy;override; destructor done;
procedure list(all:boolean); procedure list(all:boolean);
{$ifdef EXTDEBUG} {$ifdef EXTDEBUG}
procedure dump_info(lvl:longint); procedure dump_info(lvl:longint);
@ -804,12 +804,12 @@ implementation
ppn:=ccallparanode.create(tunarynode(t).left.getcopy,nil); ppn:=ccallparanode.create(tunarynode(t).left.getcopy,nil);
ppn.get_paratype; ppn.get_paratype;
end; end;
candidates:=tcallcandidates.create_operator(optoken,ppn); candidates.init_operator(optoken,ppn);
{ stop when there are no operators found } { stop when there are no operators found }
if candidates.count=0 then if candidates.count=0 then
begin begin
candidates.free; candidates.done;
ppn.free; ppn.free;
if not (ocf_check_only in ocf) then if not (ocf_check_only in ocf) then
begin begin
@ -830,7 +830,7 @@ implementation
{ exit when no overloads are found } { exit when no overloads are found }
if cand_cnt=0 then if cand_cnt=0 then
begin begin
candidates.free; candidates.done;
ppn.free; ppn.free;
if not (ocf_check_only in ocf) then if not (ocf_check_only in ocf) then
begin begin
@ -852,7 +852,7 @@ implementation
{ we'll just use the first candidate to make the { we'll just use the first candidate to make the
call } call }
end; end;
candidates.free; candidates.done;
if ocf_check_only in ocf then if ocf_check_only in ocf then
begin begin
@ -889,13 +889,13 @@ implementation
{ generate parameter nodes } { generate parameter nodes }
ppn:=ccallparanode.create(tbinarynode(t).right.getcopy,ccallparanode.create(tbinarynode(t).left.getcopy,nil)); ppn:=ccallparanode.create(tbinarynode(t).right.getcopy,ccallparanode.create(tbinarynode(t).left.getcopy,nil));
ppn.get_paratype; ppn.get_paratype;
candidates:=tcallcandidates.create_operator(optoken,ppn); candidates.init_operator(optoken,ppn);
{ for commutative operators we can swap arguments and try again } { for commutative operators we can swap arguments and try again }
if (candidates.count=0) and if (candidates.count=0) and
not(optoken in non_commutative_op_tokens) then not(optoken in non_commutative_op_tokens) then
begin begin
candidates.free; candidates.done;
reverseparameters(ppn); reverseparameters(ppn);
{ reverse compare operators } { reverse compare operators }
case optoken of case optoken of
@ -910,7 +910,7 @@ implementation
else else
; ;
end; end;
candidates:=tcallcandidates.create_operator(optoken,ppn); candidates.init_operator(optoken,ppn);
end; end;
{ stop when there are no operators found } { stop when there are no operators found }
@ -918,7 +918,7 @@ implementation
if (result=0) and generror then if (result=0) and generror then
begin begin
CGMessage(parser_e_operator_not_overloaded); CGMessage(parser_e_operator_not_overloaded);
candidates.free; candidates.done;
ppn.free; ppn.free;
ppn:=nil; ppn:=nil;
exit; exit;
@ -939,7 +939,7 @@ implementation
if (result=0) and generror then if (result=0) and generror then
begin begin
CGMessage3(parser_e_operator_not_overloaded_3,ld.GetTypeName,arraytokeninfo[optoken].str,rd.GetTypeName); CGMessage3(parser_e_operator_not_overloaded_3,ld.GetTypeName,arraytokeninfo[optoken].str,rd.GetTypeName);
candidates.free; candidates.done;
ppn.free; ppn.free;
ppn:=nil; ppn:=nil;
exit; exit;
@ -957,7 +957,7 @@ implementation
{ we'll just use the first candidate to make the { we'll just use the first candidate to make the
call } call }
end; end;
candidates.free; candidates.done;
end; end;
begin begin
@ -2194,7 +2194,7 @@ implementation
TCallCandidates TCallCandidates
****************************************************************************} ****************************************************************************}
constructor tcallcandidates.create(sym:tprocsym;st:TSymtable;ppn:tnode;ignorevisibility,allowdefaultparas,objcidcall,explicitunit,searchhelpers,anoninherited:boolean;spezcontext:tspecializationcontext); constructor tcallcandidates.init(sym:tprocsym;st:TSymtable;ppn:tnode;ignorevisibility,allowdefaultparas,objcidcall,explicitunit,searchhelpers,anoninherited:boolean;spezcontext:tspecializationcontext);
begin begin
if not assigned(sym) then if not assigned(sym) then
internalerror(200411015); internalerror(200411015);
@ -2202,23 +2202,21 @@ implementation
FProcsym:=sym; FProcsym:=sym;
FProcsymtable:=st; FProcsymtable:=st;
FParanode:=ppn; FParanode:=ppn;
FIgnoredCandidateProcs:=tfpobjectlist.create(false);
create_candidate_list(ignorevisibility,allowdefaultparas,objcidcall,explicitunit,searchhelpers,anoninherited,spezcontext); create_candidate_list(ignorevisibility,allowdefaultparas,objcidcall,explicitunit,searchhelpers,anoninherited,spezcontext);
end; end;
constructor tcallcandidates.create_operator(op:ttoken;ppn:tnode); constructor tcallcandidates.init_operator(op:ttoken;ppn:tnode);
begin begin
FOperator:=op; FOperator:=op;
FProcsym:=nil; FProcsym:=nil;
FProcsymtable:=nil; FProcsymtable:=nil;
FParanode:=ppn; FParanode:=ppn;
FIgnoredCandidateProcs:=tfpobjectlist.create(false);
create_candidate_list(false,false,false,false,false,false,nil); create_candidate_list(false,false,false,false,false,false,nil);
end; end;
destructor tcallcandidates.destroy; destructor tcallcandidates.done;
var var
hpnext, hpnext,
hp : pcandidate; hp : pcandidate;
@ -2229,12 +2227,7 @@ implementation
FIgnoredCandidateProcs.free; FIgnoredCandidateProcs.free;
{ free any symbols for anonymous parameter types that we're used for { free any symbols for anonymous parameter types that we're used for
specialization when no specialization was picked } specialization when no specialization was picked }
if assigned(FParaAnonSyms) then TFPList.FreeAndNilObjects(FParaAnonSyms);
begin
for i := 0 to FParaAnonSyms.count-1 do
tsym(FParaAnonSyms[i]).free;
FParaAnonSyms.free;
end;
hp:=FCandidateProcs; hp:=FCandidateProcs;
while assigned(hp) do while assigned(hp) do
begin begin
@ -2284,7 +2277,7 @@ implementation
continue; continue;
if (po_ignore_for_overload_resolution in pd.procoptions) then if (po_ignore_for_overload_resolution in pd.procoptions) then
begin begin
FIgnoredCandidateProcs.add(pd); TFPList.AddOnDemand(FIgnoredCandidateProcs,pd);
continue; continue;
end; end;
{ in case of anonymous inherited, only match procdefs identical { in case of anonymous inherited, only match procdefs identical
@ -2517,7 +2510,7 @@ implementation
continue; continue;
if (po_ignore_for_overload_resolution in pd.procoptions) then if (po_ignore_for_overload_resolution in pd.procoptions) then
begin begin
FIgnoredCandidateProcs.add(pd); TFPList.AddOnDemand(FIgnoredCandidateProcs,pd);
continue; continue;
end; end;
{ Store first procsym found } { Store first procsym found }
@ -2626,7 +2619,7 @@ implementation
{$ifdef DISABLE_FAST_OVERLOAD_PATCH} {$ifdef DISABLE_FAST_OVERLOAD_PATCH}
if (FParalength>=pd.minparacount) and if (FParalength>=pd.minparacount) and
{$else} {$else}
if (pd.seenmarker<>pointer(self)) and (FParalength>=pd.minparacount) and if (pd.seenmarker<>pointer(@self)) and (FParalength>=pd.minparacount) and
{$endif} {$endif}
( (
( (
@ -2685,7 +2678,7 @@ implementation
proc_add(st,pd,objcidcall); proc_add(st,pd,objcidcall);
added:=true; added:=true;
{$ifndef DISABLE_FAST_OVERLOAD_PATCH} {$ifndef DISABLE_FAST_OVERLOAD_PATCH}
pd.seenmarker:=self; pd.seenmarker:=pointer(@self);
{$endif} {$endif}
end; end;
end; end;
@ -3636,7 +3629,7 @@ implementation
parameters (so the overload choosing was not influenced by their parameters (so the overload choosing was not influenced by their
presence, but now that we've decided which overloaded version to call, presence, but now that we've decided which overloaded version to call,
make sure we call the version closest in terms of visibility } make sure we call the version closest in terms of visibility }
if cntpd=1 then if (cntpd=1) and assigned(FIgnoredCandidateProcs) then
begin begin
for res:=0 to FIgnoredCandidateProcs.count-1 do for res:=0 to FIgnoredCandidateProcs.count-1 do
begin begin
@ -3864,7 +3857,7 @@ implementation
parameters (so the overload choosing was not influenced by their parameters (so the overload choosing was not influenced by their
presence, but now that we've decided which overloaded version to call, presence, but now that we've decided which overloaded version to call,
make sure we call the version closest in terms of visibility } make sure we call the version closest in terms of visibility }
if cntpd=1 then if (cntpd=1) and assigned(FIgnoredCandidateProcs) then
begin begin
for res:=0 to FIgnoredCandidateProcs.count-1 do for res:=0 to FIgnoredCandidateProcs.count-1 do
begin begin

9
compiler/ncal.pas
View File

@ -3963,7 +3963,6 @@ implementation
invokesym : tsym; invokesym : tsym;
begin begin
result:=nil; result:=nil;
candidates:=nil;
oldcallnode:=aktcallnode; oldcallnode:=aktcallnode;
aktcallnode:=self; aktcallnode:=self;
@ -4083,7 +4082,7 @@ implementation
ignorevisibility:=(nf_isproperty in flags) or ignorevisibility:=(nf_isproperty in flags) or
((m_delphi in current_settings.modeswitches) and (cnf_anon_inherited in callnodeflags)) or ((m_delphi in current_settings.modeswitches) and (cnf_anon_inherited in callnodeflags)) or
(cnf_ignore_visibility in callnodeflags); (cnf_ignore_visibility in callnodeflags);
candidates:=tcallcandidates.create(symtableprocentry,symtableproc,left,ignorevisibility, candidates.init(symtableprocentry,symtableproc,left,ignorevisibility,
not(nf_isproperty in flags),cnf_objc_id_call in callnodeflags,cnf_unit_specified in callnodeflags, not(nf_isproperty in flags),cnf_objc_id_call in callnodeflags,cnf_unit_specified in callnodeflags,
callnodeflags*[cnf_anon_inherited,cnf_inherited]=[],cnf_anon_inherited in callnodeflags,spezcontext); callnodeflags*[cnf_anon_inherited,cnf_inherited]=[],cnf_anon_inherited in callnodeflags,spezcontext);
@ -4128,7 +4127,7 @@ implementation
symtableprocentry.write_parameter_lists(nil); symtableprocentry.write_parameter_lists(nil);
end; end;
end; end;
candidates.free; candidates.done;
exit; exit;
end; end;
@ -4203,7 +4202,7 @@ implementation
{$endif EXTDEBUG} {$endif EXTDEBUG}
{ We can not proceed, release all procs and exit } { We can not proceed, release all procs and exit }
candidates.free; candidates.done;
exit; exit;
end; end;
@ -4213,7 +4212,7 @@ implementation
if procdefinition.is_specialization and (procdefinition.typ=procdef) then if procdefinition.is_specialization and (procdefinition.typ=procdef) then
maybe_add_pending_specialization(procdefinition,candidates.para_anon_syms); maybe_add_pending_specialization(procdefinition,candidates.para_anon_syms);
candidates.free; candidates.done;
end; { end of procedure to call determination } end; { end of procedure to call determination }
end; end;

21
compiler/pgenutil.pas
View File

@ -1227,11 +1227,7 @@ uses
sym:=create_unnamed_typesym(caller_def); sym:=create_unnamed_typesym(caller_def);
{ add the unnamed sym to the list but only it was allocated manually } { add the unnamed sym to the list but only it was allocated manually }
if sym.owner=caller_def.owner then if sym.owner=caller_def.owner then
begin TFPList.AddOnDemand(unnamed_syms,sym);
if not assigned(unnamed_syms) then
unnamed_syms:=tfplist.create;
unnamed_syms.add(sym);
end;
genericparams.add(target_key,sym); genericparams.add(target_key,sym);
end end
else else
@ -1267,11 +1263,7 @@ uses
result.insert(0,sym); result.insert(0,sym);
{ add the unnamed sym to the list but only if it was allocated manually } { add the unnamed sym to the list but only if it was allocated manually }
if sym.owner=paradef.owner then if sym.owner=paradef.owner then
begin TFPList.AddOnDemand(unnamed_syms,sym);
if not assigned(unnamed_syms) then
unnamed_syms:=tfplist.create;
unnamed_syms.add(sym);
end;
end end
else else
result.insert(0,paradef.typesym); result.insert(0,paradef.typesym);
@ -1280,7 +1272,7 @@ uses
end; end;
var var
i,j,k : integer; i,j : integer;
srsym : tprocsym; srsym : tprocsym;
callerparams : tfplist; callerparams : tfplist;
pd : tprocdef; pd : tprocdef;
@ -1333,12 +1325,7 @@ uses
else else
begin begin
{ the specialization was not chosen so clean up any unnamed syms } { the specialization was not chosen so clean up any unnamed syms }
if pd_unnamed_syms<>nil then TFPList.FreeAndNilObjects(pd_unnamed_syms);
begin
for k:=0 to pd_unnamed_syms.count-1 do
tsym(pd_unnamed_syms[k]).free;
pd_unnamed_syms.free;
end;
end; end;
end; end;
end; end;