From 7744498ad2b72074e3f6ee9cfbe31aeeade9f490 Mon Sep 17 00:00:00 2001 From: John Benediktsson Date: Sat, 23 Mar 2013 18:13:17 -0700 Subject: [PATCH] compiler.cfg.ssa.construction.tdmsc: pass visited set on stack. --- .../cfg/ssa/construction/tdmsc/tdmsc.factor | 24 +++++++++---------- 1 file changed, 12 insertions(+), 12 deletions(-) diff --git a/basis/compiler/cfg/ssa/construction/tdmsc/tdmsc.factor b/basis/compiler/cfg/ssa/construction/tdmsc/tdmsc.factor index 188ef3ba58..1cae9c44d3 100644 --- a/basis/compiler/cfg/ssa/construction/tdmsc/tdmsc.factor +++ b/basis/compiler/cfg/ssa/construction/tdmsc/tdmsc.factor @@ -14,7 +14,7 @@ IN: compiler.cfg.ssa.construction.tdmsc ] H{ } map>assoc merge-sets set ; @@ -52,22 +52,22 @@ SYMBOLS: visited merge-sets levels again? ; : consistent? ( snode lnode -- ? ) [ merge-sets get at ] bi@ subset? ; -: (process-edge) ( from to -- ) - f walk [ - 2dup 2array visited get ?adjoin - [ 2drop ] [ consistent? [ again? on ] unless ] if +: (process-edge) ( from to visited -- ) + [ f walk ] dip '[ + 2dup 2array _ ?adjoin [ 2drop ] [ + consistent? [ again? on ] unless + ] if ] each-incoming-j-edge ; -: process-edge ( from to -- ) - 2dup 2array visited get ?adjoin - [ (process-edge) ] [ 2drop ] if ; +: process-edge ( from to visited -- ) + [ 2over 2array swap ?adjoin ] keep + '[ _ (process-edge) ] [ 2drop ] if ; -: process-block ( bb -- ) - [ process-edge ] each-incoming-j-edge ; +: process-block ( bb visited -- ) + '[ _ process-edge ] each-incoming-j-edge ; : compute-merge-set-step ( bfo -- ) - HS{ } clone visited set - [ process-block ] each ; + HS{ } clone '[ _ process-block ] each ; : compute-merge-set-loop ( cfg -- ) breadth-first-order