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

Merge foreachnodes into one version that uses a context object.

Browse Source
This commit is contained in:
Rika Ichinose 2022-01-12 10:34:38 +03:00 committed by FPK
parent 1cd1415df7
commit 2d1ab3410d
1 changed files with 97 additions and 162 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

259
compiler/nutils.pas
View File

@ -224,107 +224,132 @@ implementation
cpubase,cgbase,procinfo, cpubase,cgbase,procinfo,
pass_1; pass_1;
function foreachnode(procmethod : tforeachprocmethod;var n: tnode; f: foreachnodefunction; arg: pointer): boolean; type
ForEachNodeContext = object
procmethod: tforeachprocmethod;
f: staticforeachnodefunction;
arg: pointer;
res: boolean;
procedure perform(var n: tnode);
procedure process_children(n: tnode);
procedure process_casenode(n: tcasenode);
end;
function process_children(res : boolean) : boolean;
procedure ForEachNodeContext.perform(var n: tnode);
var var
i: longint; fr: foreachnoderesult;
begin
if not assigned(n) then
exit;
if procmethod=pm_preprocess then
process_children(n);
fr:=f(n,arg);
res:=(fr in [fen_true, fen_norecurse_true]) or res;
if fr in [fen_norecurse_false, fen_norecurse_true] then
exit;
if procmethod in [pm_postprocess,pm_postandagain] then
begin
process_children(n);
if procmethod=pm_postandagain then
begin
fr:=f(n,arg);
res:=(fr in [fen_true, fen_norecurse_true]) or res;
end;
end;
end;
procedure ForEachNodeContext.process_children(n: tnode);
begin begin
result:=res;
case n.nodetype of case n.nodetype of
asn: asn:
if assigned(tasnode(n).call) then if assigned(tasnode(n).call) then
begin begin
result := foreachnode(procmethod,tasnode(n).call,f,arg); perform(tasnode(n).call);
exit exit
end; end;
calln: calln:
begin begin
result := foreachnode(procmethod,tnode(tcallnode(n).callinitblock),f,arg) or result; perform(tnode(tcallnode(n).callinitblock));
result := foreachnode(procmethod,tcallnode(n).methodpointer,f,arg) or result; perform(tcallnode(n).methodpointer);
result := foreachnode(procmethod,tcallnode(n).funcretnode,f,arg) or result; perform(tcallnode(n).funcretnode);
result := foreachnode(procmethod,tnode(tcallnode(n).vmt_entry),f,arg) or result; perform(tnode(tcallnode(n).vmt_entry));
result := foreachnode(procmethod,tnode(tcallnode(n).callcleanupblock),f,arg) or result; perform(tnode(tcallnode(n).callcleanupblock));
end; end;
callparan: callparan:
begin begin
result := foreachnode(procmethod,tnode(tcallparanode(n).fparainit),f,arg) or result; perform(tnode(tcallparanode(n).fparainit));
result := foreachnode(procmethod,tcallparanode(n).fparacopyback,f,arg) or result; perform(tcallparanode(n).fparacopyback);
end; end;
ifn, whilerepeatn, forn, tryexceptn: ifn, whilerepeatn, forn, tryexceptn:
begin begin
{ not in one statement, won't work because of b- } perform(tloopnode(n).t1);
result := foreachnode(procmethod,tloopnode(n).t1,f,arg) or result; perform(tloopnode(n).t2);
result := foreachnode(procmethod,tloopnode(n).t2,f,arg) or result;
end; end;
raisen, tryfinallyn: raisen, tryfinallyn:
{ frame tree/copy of finally code } { frame tree/copy of finally code }
result := foreachnode(ttertiarynode(n).third,f,arg) or result; perform(ttertiarynode(n).third);
tempcreaten: tempcreaten:
{ temp. initialization code } { temp. initialization code }
if assigned(ttempcreatenode(n).tempinfo^.tempinitcode) then if assigned(ttempcreatenode(n).tempinfo^.tempinitcode) then
result := foreachnode(ttempcreatenode(n).tempinfo^.tempinitcode,f,arg) or result; perform(ttempcreatenode(n).tempinfo^.tempinitcode);
casen: casen:
begin process_casenode(tcasenode(n));
for i := 0 to tcasenode(n).blocks.count-1 do
if assigned(tcasenode(n).blocks[i]) then
result := foreachnode(procmethod,pcaseblock(tcasenode(n).blocks[i])^.statement,f,arg) or result;
result := foreachnode(procmethod,tcasenode(n).elseblock,f,arg) or result;
end;
else else
; ;
end; end;
if n.inheritsfrom(tbinarynode) then if n.inheritsfrom(tbinarynode) then
begin begin
{ first process the "payload" of statementnodes } { first process the "payload" of statementnodes }
result := foreachnode(procmethod,tbinarynode(n).left,f,arg) or result; perform(tbinarynode(n).left);
result := foreachnode(procmethod,tbinarynode(n).right,f,arg) or result; perform(tbinarynode(n).right);
end end
else if n.inheritsfrom(tunarynode) then else if n.inheritsfrom(tunarynode) then
result := foreachnode(procmethod,tunarynode(n).left,f,arg) or result; perform(tunarynode(n).left);
end; end;
begin
result := false; procedure ForEachNodeContext.process_casenode(n: tcasenode);
if not assigned(n) then var
exit; i: SizeInt;
if procmethod=pm_preprocess then block: pointer;
result:=process_children(result); begin
case f(n,arg) of for i := 0 to n.blocks.count-1 do
fen_norecurse_false:
exit;
fen_norecurse_true:
begin begin
result := true; block := n.blocks[i];
exit; if assigned(block) then
perform(pcaseblock(block)^.statement);
end; end;
fen_true: perform(n.elseblock);
result := true; end;
{ result is already false
fen_false:
result := false; } { Adapts foreachnodefunction to staticforeachnodefunction. }
else type
; BoundToStaticForEachNodeContext = record
f: foreachnodefunction;
arg: pointer;
end;
function BoundToStaticForEachNodeAdapter(var n: tnode; arg: pointer): foreachnoderesult;
var
adaptCtx: ^BoundToStaticForEachNodeContext absolute arg;
begin
result := adaptCtx^.f(n, adaptCtx^.arg);
end;
function foreachnode(procmethod : tforeachprocmethod;var n: tnode; f: foreachnodefunction; arg: pointer): boolean;
var
adaptCtx: BoundToStaticForEachNodeContext;
begin
adaptCtx.f := f;
adaptCtx.arg := arg;
result:=foreachnodestatic(procmethod,n,@BoundToStaticForEachNodeAdapter,@adaptCtx);
end; end;
if (procmethod=pm_postprocess) or (procmethod=pm_postandagain) then
result:=process_children(result);
if procmethod=pm_postandagain then
begin
case f(n,arg) of
fen_norecurse_false:
exit;
fen_norecurse_true:
begin
result := true;
exit;
end;
fen_true:
result := true;
else
;
end;
end;
end;
function foreachnode(var n: tnode; f: foreachnodefunction; arg: pointer): boolean; function foreachnode(var n: tnode; f: foreachnodefunction; arg: pointer): boolean;
@ -333,108 +358,18 @@ implementation
end; end;
function foreachnodestatic(procmethod : tforeachprocmethod;var n: tnode; f: staticforeachnodefunction; arg: pointer): boolean; function foreachnodestatic(procmethod : tforeachprocmethod;var n: tnode; f: staticforeachnodefunction; arg: pointer): boolean;
function process_children(res : boolean) : boolean;
var var
i: longint; fen: ForEachNodeContext;
begin begin
result:=res; fen.procmethod := procmethod;
case n.nodetype of fen.f := f;
asn: fen.arg := arg;
if assigned(tasnode(n).call) then fen.res := false;
begin fen.perform(n);
result := foreachnodestatic(procmethod,tasnode(n).call,f,arg); result := fen.res;
exit
end;
calln:
begin
result := foreachnodestatic(procmethod,tnode(tcallnode(n).callinitblock),f,arg) or result;
result := foreachnodestatic(procmethod,tcallnode(n).methodpointer,f,arg) or result;
result := foreachnodestatic(procmethod,tcallnode(n).funcretnode,f,arg) or result;
result := foreachnodestatic(procmethod,tnode(tcallnode(n).vmt_entry),f,arg) or result;
result := foreachnodestatic(procmethod,tnode(tcallnode(n).callcleanupblock),f,arg) or result;
end;
callparan:
begin
result := foreachnodestatic(procmethod,tnode(tcallparanode(n).fparainit),f,arg) or result;
result := foreachnodestatic(procmethod,tcallparanode(n).fparacopyback,f,arg) or result;
end;
ifn, whilerepeatn, forn, tryexceptn:
begin
{ not in one statement, won't work because of b- }
result := foreachnodestatic(procmethod,tloopnode(n).t1,f,arg) or result;
result := foreachnodestatic(procmethod,tloopnode(n).t2,f,arg) or result;
end;
raisen, tryfinallyn:
{ frame tree/copy of finally code }
result := foreachnodestatic(ttertiarynode(n).third,f,arg) or result;
tempcreaten:
{ temp. initialization code }
if assigned(ttempcreatenode(n).tempinfo^.tempinitcode) then
result := foreachnodestatic(ttempcreatenode(n).tempinfo^.tempinitcode,f,arg) or result;
casen:
begin
for i := 0 to tcasenode(n).blocks.count-1 do
if assigned(tcasenode(n).blocks[i]) then
result := foreachnodestatic(procmethod,pcaseblock(tcasenode(n).blocks[i])^.statement,f,arg) or result;
result := foreachnodestatic(procmethod,tcasenode(n).elseblock,f,arg) or result;
end;
else
;
end;
if n.inheritsfrom(tbinarynode) then
begin
{ first process the "payload" of statementnodes }
result := foreachnodestatic(procmethod,tbinarynode(n).left,f,arg) or result;
result := foreachnodestatic(procmethod,tbinarynode(n).right,f,arg) or result;
end
else if n.inheritsfrom(tunarynode) then
result := foreachnodestatic(procmethod,tunarynode(n).left,f,arg) or result;
end; end;
begin
result := false;
if not assigned(n) then
exit;
if procmethod=pm_preprocess then
result:=process_children(result);
case f(n,arg) of
fen_norecurse_false:
exit;
fen_norecurse_true:
begin
result := true;
exit;
end;
fen_true:
result := true;
{ result is already false
fen_false:
result := false; }
else
;
end;
if (procmethod=pm_postprocess) or (procmethod=pm_postandagain) then
result:=process_children(result);
if procmethod=pm_postandagain then
begin
case f(n,arg) of
fen_norecurse_false:
exit;
fen_norecurse_true:
begin
result := true;
exit;
end;
fen_true:
result := true;
else
;
end;
end;
end;
function foreachnodestatic(var n: tnode; f: staticforeachnodefunction; arg: pointer): boolean; function foreachnodestatic(var n: tnode; f: staticforeachnodefunction; arg: pointer): boolean;
begin begin