* implement necessary conversion functionality for anonymous procdefs to function reference interfaces including capturing of variables

This commit is contained in:
Sven/Sarah Barth 2022-05-18 22:31:17 +02:00
parent f8b1801a8f
commit 76df7144ba
2 changed files with 83 additions and 9 deletions

View File

@ -108,7 +108,8 @@ interface
tc_array_2_dynarray,
tc_elem_2_openarray,
tc_arrayconstructor_2_dynarray,
tc_arrayconstructor_2_array
tc_arrayconstructor_2_array,
tc_anonproc_2_funcref
);
function compare_defs_ext(def_from,def_to : tdef;
@ -203,6 +204,9 @@ implementation
end;
function proc_to_funcref_conv(def1:tabstractprocdef;def2:tobjectdef):tequaltype;forward;
function compare_defs_ext(def_from,def_to : tdef;
fromtreetype : tnodetype;
var doconv : tconverttype;
@ -1867,6 +1871,20 @@ implementation
doconv:=tc_char_2_string;
eq:=te_convert_l2
end
else if is_funcref(def_to) and
(def_from.typ=procdef) and
(po_anonymous in tprocdef(def_from).procoptions) then
begin
subeq:=proc_to_funcref_conv(tprocdef(def_from),tobjectdef(def_to));
if subeq>te_incompatible then
begin
doconv:=tc_anonproc_2_funcref;
if subeq>te_convert_l5 then
eq:=pred(subeq)
else
eq:=subeq;
end;
end
else if is_funcref(def_to) and
is_funcref(def_from) and
not (cdo_equal_check in cdoptions) then
@ -2507,6 +2525,7 @@ implementation
po_comp: tprocoptions;
pa_comp: tcompare_paras_options;
captured : tfplist;
dstisfuncref : boolean;
begin
proc_to_procvar_equal_internal:=te_incompatible;
if not(assigned(def1)) or not(assigned(def2)) then
@ -2590,19 +2609,27 @@ implementation
if def1.typ<>procdef then
internalerror(2021052602);
captured:=tprocdef(def1).capturedsyms;
{ a function reference can capture anything, but they're
rather expensive, so cheaper overloads are preferred }
dstisfuncref:=assigned(def2.owner) and
assigned(def2.owner.defowner) and
is_funcref(tdef(def2.owner.defowner));
{ if no symbol was captured an anonymous function is
compatible to all three types of function pointers, but we
compatible to all four types of function pointers, but we
might need to generate its code differently (e.g. get rid
of parentfp parameter for global functions); the order for
this is:
- procedure variable
- method variable
- function reference
- nested procvar }
if not assigned(captured) or (captured.count=0) then
begin
if po_methodpointer in def2.procoptions then
eq:=te_convert_l2
else if po_delphi_nested_cc in def2.procoptions then
eq:=te_convert_l4
else if dstisfuncref then
eq:=te_convert_l3
else
eq:=te_convert_l1
@ -2611,21 +2638,27 @@ implementation
compatible to normal function pointers; the order for this
is:
- method variable
- function reference
- nested function }
else if (captured.count=1) and (vo_is_self in tabstractvarsym(pcapturedsyminfo(captured[0])^.sym).varoptions) then
begin
if po_methodpointer in def2.procoptions then
eq:=te_convert_l1
else if po_delphi_nested_cc in def2.procoptions then
eq:=te_convert_l3
else if dstisfuncref then
eq:=te_convert_l2
else
eq:=te_incompatible;
end
{ otherwise it's compatible to nested function pointers only }
{ otherwise it's compatible to nested function pointers and
function references }
else
begin
if po_delphi_nested_cc in def2.procoptions then
if dstisfuncref then
eq:=te_convert_l1
else if po_delphi_nested_cc in def2.procoptions then
eq:=te_convert_l2
else
eq:=te_incompatible;
end;
@ -2642,7 +2675,7 @@ implementation
end;
function proc_to_funcref_equal(def1:tabstractprocdef;def2:tobjectdef):tequaltype;
function proc_to_funcref_conv(def1:tabstractprocdef;def2:tobjectdef):tequaltype;
var
invoke : tprocdef;
begin
@ -2653,6 +2686,12 @@ implementation
internalerror(2022011601);
invoke:=get_invoke_procdef(def2);
result:=proc_to_procvar_equal_internal(def1,invoke,false,true);
end;
function proc_to_funcref_equal(def1:tabstractprocdef;def2:tobjectdef):tequaltype;
begin
result:=proc_to_funcref_conv(def1,def2);
{ as long as the two methods are considered convertible we consider the
procdef and the function reference as equal }
if result>te_convert_operator then

View File

@ -120,6 +120,7 @@ interface
function typecheck_elem_2_openarray : tnode; virtual;
function typecheck_arrayconstructor_to_dynarray : tnode; virtual;
function typecheck_arrayconstructor_to_array : tnode; virtual;
function typecheck_anonproc_2_funcref : tnode; virtual;
private
function _typecheck_int_to_int : tnode;
function _typecheck_cord_to_pointer : tnode;
@ -153,6 +154,7 @@ interface
function _typecheck_elem_2_openarray : tnode;
function _typecheck_arrayconstructor_to_dynarray : tnode;
function _typecheck_arrayconstructor_to_array : tnode;
function _typecheck_anonproc_to_funcref : tnode;
protected
function first_int_to_int : tnode;virtual;
function first_cstring_to_pchar : tnode;virtual;
@ -325,7 +327,7 @@ implementation
ncon,ncal,nset,nadd,nmem,nmat,nbas,nutils,ninl,nflw,
psub,
cgbase,procinfo,
htypechk,blockutl,pparautl,pass_1,cpuinfo;
htypechk,blockutl,pparautl,procdefutil,pass_1,cpuinfo;
{*****************************************************************************
@ -2344,6 +2346,12 @@ implementation
end;
function ttypeconvnode._typecheck_anonproc_to_funcref : tnode;
begin
result:=typecheck_anonproc_2_funcref;
end;
function ttypeconvnode.target_specific_general_typeconv: boolean;
begin
result:=false;
@ -2639,6 +2647,30 @@ implementation
end;
function ttypeconvnode.typecheck_anonproc_2_funcref : tnode;
var
capturer : tsym;
intfdef : tdef;
ldnode : tnode;
begin
intfdef:=capturer_add_anonymous_proc(current_procinfo,tprocdef(left.resultdef),capturer);
if assigned(intfdef) then
begin
if assigned(capturer) then
ldnode:=cloadnode.create(capturer,capturer.owner)
else
ldnode:=cnilnode.create;
result:=ctypeconvnode.create_internal(
ctypeconvnode.create_internal(
ldnode,
intfdef),
totypedef);
end
else
result:=cerrornode.create;
end;
function ttypeconvnode.typecheck_call_helper(c : tconverttype) : tnode;
const
resultdefconvert : array[tconverttype] of pointer = (
@ -2684,7 +2716,8 @@ implementation
{ array_2_dynarray} @ttypeconvnode._typecheck_array_2_dynarray,
{ elem_2_openarray } @ttypeconvnode._typecheck_elem_2_openarray,
{ arrayconstructor_2_dynarray } @ttypeconvnode._typecheck_arrayconstructor_to_dynarray,
{ arrayconstructor_2_array } @ttypeconvnode._typecheck_arrayconstructor_to_array
{ arrayconstructor_2_array } @ttypeconvnode._typecheck_arrayconstructor_to_array,
{ anonproc_2_funcref } @ttypeconvnode._typecheck_anonproc_to_funcref
);
type
tprocedureofobject = function : tnode of object;
@ -4392,7 +4425,8 @@ implementation
nil,
@ttypeconvnode._first_nothing,
@ttypeconvnode._first_nothing,
@ttypeconvnode._first_nothing
@ttypeconvnode._first_nothing,
nil
);
type
tprocedureofobject = function : tnode of object;
@ -4673,7 +4707,8 @@ implementation
@ttypeconvnode._second_nothing, { array_2_dynarray }
@ttypeconvnode._second_elem_to_openarray, { elem_2_openarray }
@ttypeconvnode._second_nothing, { arrayconstructor_2_dynarray }
@ttypeconvnode._second_nothing { arrayconstructor_2_array }
@ttypeconvnode._second_nothing, { arrayconstructor_2_array }
@ttypeconvnode._second_nothing { anonproc_2_funcref }
);
type
tprocedureofobject = procedure of object;