mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-08 01:08:07 +02:00
* implement necessary conversion functionality for anonymous procdefs to function reference interfaces including capturing of variables
This commit is contained in:
parent
f8b1801a8f
commit
76df7144ba
@ -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
|
||||
|
@ -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;
|
||||
|
Loading…
Reference in New Issue
Block a user