paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-09-07 19:50:17 +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 Count: Integer read FCount write SetCount;
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;
@ -1031,6 +1037,27 @@ begin
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)

57
compiler/htypechk.pas
View File

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

9
compiler/ncal.pas
View File

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

21
compiler/pgenutil.pas
View File

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