From c6b310228eaf94e311ce80af1310b2d8cfcfb0bf Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Thu, 7 Aug 2008 01:08:11 -0500 Subject: [PATCH] Finishing up with propagation and escape analysis --- .../tree/cleanup/cleanup-tests.factor | 3 +- .../tree/copy-equiv/copy-equiv.factor | 20 ++-- .../allocations/allocations.factor | 16 ++- .../escape-analysis-tests.factor | 100 +++++++++++++++++- .../escape-analysis/escape-analysis.factor | 1 - .../recursive/recursive.factor | 34 +++--- .../tree/normalization/normalization.factor | 4 + .../compiler/tree/optimizer/optimizer.factor | 1 - .../tree/propagation/branches/branches.factor | 36 +++++-- .../tree/propagation/info/info.factor | 25 ++++- .../tree/propagation/inlining/inlining.factor | 3 +- .../tree/propagation/nodes/nodes.factor | 4 +- .../tree/propagation/propagation-tests.factor | 13 ++- .../tree/propagation/propagation.factor | 10 +- .../propagation/recursive/recursive.factor | 31 +++--- .../stack-checker/inlining/inlining.factor | 7 +- 16 files changed, 232 insertions(+), 76 deletions(-) diff --git a/unfinished/compiler/tree/cleanup/cleanup-tests.factor b/unfinished/compiler/tree/cleanup/cleanup-tests.factor index c483b8bdc6..4d2b312e9c 100644 --- a/unfinished/compiler/tree/cleanup/cleanup-tests.factor +++ b/unfinished/compiler/tree/cleanup/cleanup-tests.factor @@ -9,12 +9,11 @@ compiler.tree compiler.tree.combinators compiler.tree.cleanup compiler.tree.builder -compiler.tree.copy-equiv compiler.tree.normalization compiler.tree.propagation ; : cleaned-up-tree ( quot -- nodes ) - build-tree normalize compute-copy-equiv propagate cleanup ; + build-tree normalize propagate cleanup ; [ t ] [ [ [ 1 ] [ 2 ] if ] cleaned-up-tree [ #if? ] contains-node? ] unit-test diff --git a/unfinished/compiler/tree/copy-equiv/copy-equiv.factor b/unfinished/compiler/tree/copy-equiv/copy-equiv.factor index a96fe8eb22..6a4cca7ff4 100644 --- a/unfinished/compiler/tree/copy-equiv/copy-equiv.factor +++ b/unfinished/compiler/tree/copy-equiv/copy-equiv.factor @@ -7,6 +7,9 @@ compiler.tree.def-use compiler.tree.combinators ; IN: compiler.tree.copy-equiv +! This is not really a compiler pass; its invoked as part of +! propagation. + ! Two values are copy-equivalent if they are always identical ! at run-time ("DS" relation). This is just a weak form of ! value numbering. @@ -26,8 +29,7 @@ SYMBOL: copies ] if ] ; -: resolve-copy ( copy -- val ) - copies get compress-path [ "Unknown value" throw ] unless* ; +: resolve-copy ( copy -- val ) copies get compress-path ; : is-copy-of ( val copy -- ) copies get set-at ; @@ -68,13 +70,7 @@ M: #phi compute-copy-equiv* M: node compute-copy-equiv* drop ; -: amend-copy-equiv ( node -- ) - [ - [ node-defs-values [ introduce-value ] each ] - [ compute-copy-equiv* ] - bi - ] each-node ; - -: compute-copy-equiv ( node -- node ) - H{ } clone copies set - dup amend-copy-equiv ; +: compute-copy-equiv ( node -- ) + [ node-defs-values [ introduce-value ] each ] + [ compute-copy-equiv* ] + bi ; diff --git a/unfinished/compiler/tree/escape-analysis/allocations/allocations.factor b/unfinished/compiler/tree/escape-analysis/allocations/allocations.factor index b4f4a2a5dd..8bcaf53ab1 100644 --- a/unfinished/compiler/tree/escape-analysis/allocations/allocations.factor +++ b/unfinished/compiler/tree/escape-analysis/allocations/allocations.factor @@ -28,14 +28,9 @@ C: slot-access : record-allocation ( allocation value -- ) (allocation) set-at ; -: unknown-allocation ( value -- ) t swap record-allocation ; - : record-allocations ( allocations values -- ) [ record-allocation ] 2each ; -: unknown-allocations ( values -- ) - [ unknown-allocation ] each ; - ! We track escaping values with a disjoint set. SYMBOL: escaping-values @@ -66,10 +61,21 @@ SYMBOL: +escaping+ : merge-slots ( values -- value ) [ merge-values ] keep ; +: add-escaping-value ( value -- ) + +escaping+ escaping-values get equate ; + : add-escaping-values ( values -- ) escaping-values get '[ +escaping+ , equate ] each ; +: unknown-allocation ( value -- ) + [ add-escaping-value ] + [ t swap record-allocation ] + bi ; + +: unknown-allocations ( values -- ) + [ unknown-allocation ] each ; + : escaping-value? ( value -- ? ) +escaping+ escaping-values get equiv? ; diff --git a/unfinished/compiler/tree/escape-analysis/escape-analysis-tests.factor b/unfinished/compiler/tree/escape-analysis/escape-analysis-tests.factor index 256152a556..2728a3c933 100644 --- a/unfinished/compiler/tree/escape-analysis/escape-analysis-tests.factor +++ b/unfinished/compiler/tree/escape-analysis/escape-analysis-tests.factor @@ -12,7 +12,7 @@ prettyprint classes.tuple.private classes classes.tuple ; GENERIC: count-unboxed-allocations* ( m node -- n ) : (count-unboxed-allocations) ( m node -- n ) - out-d>> first escaping-allocation? [ 1+ ] unless ; + dup out-d>> first escaping-allocation? [ drop ] [ short. 1+ ] if ; M: #call count-unboxed-allocations* dup word>> \ = @@ -27,10 +27,8 @@ M: node count-unboxed-allocations* drop ; : count-unboxed-allocations ( quot -- sizes ) build-tree normalize - compute-copy-equiv propagate cleanup - compute-copy-equiv escape-analysis 0 swap [ count-unboxed-allocations* ] each-node ; @@ -187,3 +185,99 @@ TUPLE: cons { car read-only } { cdr read-only } ; 1 2 cons boa infinite-cons-loop ] count-unboxed-allocations ] unit-test + +TUPLE: rw-box i ; + +C: rw-box + +[ 0 ] [ [ i>> ] count-unboxed-allocations ] unit-test + +: fake-fib ( m -- n ) + dup i>> 1 <= [ drop 1 ] when ; inline recursive + +[ 0 ] [ [ fake-fib i>> ] count-unboxed-allocations ] unit-test + +TUPLE: ro-box { i read-only } ; + +C: ro-box + +: tuple-fib ( m -- n ) + dup i>> 1 <= [ + drop 1 + ] [ + i>> 1- + dup tuple-fib + swap + i>> 1- + tuple-fib + swap i>> swap i>> + + ] if ; inline recursive + +[ 5 ] [ [ tuple-fib i>> ] count-unboxed-allocations ] unit-test + +[ 3 ] [ [ tuple-fib ] count-unboxed-allocations ] unit-test + +: bad-tuple-fib-1 ( m -- n ) + dup i>> 1 <= [ + drop 1 + ] [ + i>> 1- + dup bad-tuple-fib-1 + swap + i>> 1- + bad-tuple-fib-1 dup . + swap i>> swap i>> + + ] if ; inline recursive + +[ 3 ] [ [ bad-tuple-fib-1 i>> ] count-unboxed-allocations ] unit-test + +: bad-tuple-fib-2 ( m -- n ) + dup . + dup i>> 1 <= [ + drop 1 + ] [ + i>> 1- + dup bad-tuple-fib-2 + swap + i>> 1- + bad-tuple-fib-2 + swap i>> swap i>> + + ] if ; inline recursive + +[ 2 ] [ [ bad-tuple-fib-2 i>> ] count-unboxed-allocations ] unit-test + +: tuple-fib-2 ( m -- n ) + dup 1 <= [ + drop 1 + ] [ + 1- dup tuple-fib-2 + swap + 1- tuple-fib-2 + swap i>> swap i>> + + ] if ; inline recursive + +[ 2 ] [ [ tuple-fib-2 i>> ] count-unboxed-allocations ] unit-test + +: tuple-fib-3 ( m -- n ) + dup 1 <= [ + drop 1 + ] [ + 1- dup tuple-fib-3 + swap + 1- tuple-fib-3 dup . + swap i>> swap i>> + + ] if ; inline recursive + +[ 0 ] [ [ tuple-fib-3 i>> ] count-unboxed-allocations ] unit-test + +: bad-tuple-fib-3 ( m -- n ) + dup 1 <= [ + drop 1 + ] [ + 1- dup bad-tuple-fib-3 + swap + 1- bad-tuple-fib-3 + 2drop f + ] if ; inline recursive + +[ 0 ] [ [ bad-tuple-fib-3 i>> ] count-unboxed-allocations ] unit-test diff --git a/unfinished/compiler/tree/escape-analysis/escape-analysis.factor b/unfinished/compiler/tree/escape-analysis/escape-analysis.factor index 0ba44a1dc5..d1b1ab2dd0 100644 --- a/unfinished/compiler/tree/escape-analysis/escape-analysis.factor +++ b/unfinished/compiler/tree/escape-analysis/escape-analysis.factor @@ -4,7 +4,6 @@ USING: kernel namespaces search-dequeues assocs fry sequences disjoint-sets compiler.tree compiler.tree.def-use -compiler.tree.copy-equiv compiler.tree.escape-analysis.allocations compiler.tree.escape-analysis.recursive compiler.tree.escape-analysis.branches diff --git a/unfinished/compiler/tree/escape-analysis/recursive/recursive.factor b/unfinished/compiler/tree/escape-analysis/recursive/recursive.factor index 5bc386690d..e72f4b6a45 100644 --- a/unfinished/compiler/tree/escape-analysis/recursive/recursive.factor +++ b/unfinished/compiler/tree/escape-analysis/recursive/recursive.factor @@ -1,8 +1,8 @@ ! Copyright (C) 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: kernel sequences math combinators accessors namespaces +fry disjoint-sets compiler.tree -compiler.tree.copy-equiv compiler.tree.combinators compiler.tree.escape-analysis.nodes compiler.tree.escape-analysis.branches @@ -17,9 +17,10 @@ IN: compiler.tree.escape-analysis.recursive [ [ [ allocation ] bi@ congruent? ] 2all? ] } cond ; -: check-fixed-point ( node alloc1 alloc2 -- node ) - [ congruent? ] 2all? - [ dup label>> f >>fixed-point drop ] unless ; inline +: check-fixed-point ( node alloc1 alloc2 -- ) + [ congruent? ] 2all? [ drop ] [ + label>> f >>fixed-point drop + ] if ; : node-input-allocations ( node -- allocations ) in-d>> [ allocation ] map ; @@ -35,31 +36,26 @@ IN: compiler.tree.escape-analysis.recursive [ [ merge-values ] 2each ] [ [ (merge-allocations) ] dip - [ [ allocation ] map check-fixed-point drop ] + [ [ allocation ] map check-fixed-point ] [ record-allocations ] 2bi ] 2bi ; M: #recursive escape-analysis* ( #recursive -- ) [ - ! copies [ clone ] change - child>> [ first analyze-recursive-phi ] [ (escape-analysis) ] bi ] until-fixed-point ; -M: #call-recursive escape-analysis* ( #call-label -- ) - dup - [ node-output-allocations ] - [ label>> return>> node-input-allocations ] bi - [ check-fixed-point ] keep - swap out-d>> record-allocations ; +: return-allocations ( node -- allocations ) + label>> return>> node-input-allocations ; -! M: #return-recursive escape-analysis* ( #return-recursive -- ) -! dup dup label>> calls>> dup empty? [ 3drop ] [ -! [ node-input-allocations ] -! [ first node-output-allocations ] bi* -! check-fixed-point drop -! ] if ; +M: #call-recursive escape-analysis* ( #call-label -- ) + [ ] [ return-allocations ] [ node-output-allocations ] tri + [ check-fixed-point ] [ drop swap out-d>> record-allocations ] 3bi ; + +M: #return-recursive escape-analysis* ( #return-recursive -- ) + [ in-d>> ] [ label>> calls>> ] bi + [ out-d>> escaping-values get '[ , equate ] 2each ] with each ; diff --git a/unfinished/compiler/tree/normalization/normalization.factor b/unfinished/compiler/tree/normalization/normalization.factor index b6a9f126d6..4eb28be917 100644 --- a/unfinished/compiler/tree/normalization/normalization.factor +++ b/unfinished/compiler/tree/normalization/normalization.factor @@ -128,6 +128,10 @@ M: #recursive normalize* dup dup label>> introductions>> eliminate-recursive-introductions ; +M: #enter-recursive normalize* + dup [ label>> ] keep >>enter-recursive drop + dup [ label>> ] [ out-d>> ] bi >>enter-out drop ; + : unchanged-underneath ( #call-recursive -- n ) [ out-d>> length ] [ label>> return>> in-d>> length ] bi - ; diff --git a/unfinished/compiler/tree/optimizer/optimizer.factor b/unfinished/compiler/tree/optimizer/optimizer.factor index 753c962061..f28b192d2b 100644 --- a/unfinished/compiler/tree/optimizer/optimizer.factor +++ b/unfinished/compiler/tree/optimizer/optimizer.factor @@ -9,7 +9,6 @@ IN: compiler.tree.optimizer : optimize-tree ( nodes -- nodes' ) normalize - compute-copy-equiv propagate cleanup compute-def-use diff --git a/unfinished/compiler/tree/propagation/branches/branches.factor b/unfinished/compiler/tree/propagation/branches/branches.factor index eb6ba3697f..00a7833655 100644 --- a/unfinished/compiler/tree/propagation/branches/branches.factor +++ b/unfinished/compiler/tree/propagation/branches/branches.factor @@ -90,7 +90,7 @@ M: #phi propagate-before ( #phi -- ) [ drop condition-value get [ [ =t ] [ =t ] bi* <--> ] - [ [ =f ] [ =f ] bi* <--> ] 2bi /\ assume + [ [ =f ] [ =f ] bi* <--> ] 2bi /\ ] } { @@ -98,19 +98,43 @@ M: #phi propagate-before ( #phi -- ) [ drop condition-value get [ [ =t ] [ =f ] bi* <--> ] - [ [ =f ] [ =t ] bi* <--> ] 2bi /\ assume + [ [ =f ] [ =t ] bi* <--> ] 2bi /\ ] } { { { t f } { f } } - [ first =t condition-value get =t /\ swap t--> assume ] + [ + first =t + condition-value get =t /\ + swap t--> + ] } { { { f } { t f } } - [ second =t condition-value get =f /\ swap t--> assume ] + [ + second =t + condition-value get =f /\ + swap t--> + ] } - [ 3drop ] - } case ; + ! { + ! { { t f } { } } + ! [ B + ! first + ! [ [ =t ] bi@ <--> ] + ! [ [ =f ] bi@ <--> ] 2bi /\ + ! ] + ! } + ! { + ! { { } { t f } } + ! [ + ! second + ! [ [ =t ] bi@ <--> ] + ! [ [ =f ] bi@ <--> ] 2bi /\ + ! ] + ! } + [ 3drop f ] + } case assume ; M: #phi propagate-after ( #phi -- ) condition-value get [ diff --git a/unfinished/compiler/tree/propagation/info/info.factor b/unfinished/compiler/tree/propagation/info/info.factor index 3d79840f7e..bc6f1d73e3 100644 --- a/unfinished/compiler/tree/propagation/info/info.factor +++ b/unfinished/compiler/tree/propagation/info/info.factor @@ -2,7 +2,8 @@ ! See http://factorcode.org/license.txt for BSD license. USING: assocs classes classes.algebra kernel accessors math math.intervals namespaces sequences words -combinators arrays compiler.tree.copy-equiv ; +combinators combinators.short-circuit arrays +compiler.tree.copy-equiv ; IN: compiler.tree.propagation.info : false-class? ( class -- ? ) \ f class<= ; @@ -218,6 +219,28 @@ DEFER: (value-info-union) [ drop null-info ] [ dup first [ value-info-union ] reduce ] if ; +: literals<= ( info1 info2 -- ? ) + { + { [ dup literal?>> not ] [ 2drop t ] } + { [ over literal?>> not ] [ 2drop f ] } + [ [ literal>> ] bi@ eql? ] + } cond ; + +: value-info<= ( info1 info2 -- ? ) + { + { [ dup not ] [ 2drop t ] } + { [ over not ] [ 2drop f ] } + [ + { + [ [ class>> ] bi@ class<= ] + [ [ interval>> ] bi@ interval-subset? ] + [ literals<= ] + [ [ length>> ] bi@ value-info<= ] + [ [ slots>> ] bi@ [ value-info<= ] 2all? ] + } 2&& + ] + } cond ; + ! Current value --> info mapping SYMBOL: value-infos diff --git a/unfinished/compiler/tree/propagation/inlining/inlining.factor b/unfinished/compiler/tree/propagation/inlining/inlining.factor index e4da863d68..22e056ce60 100644 --- a/unfinished/compiler/tree/propagation/inlining/inlining.factor +++ b/unfinished/compiler/tree/propagation/inlining/inlining.factor @@ -6,7 +6,6 @@ classes.union sets quotations assocs combinators words namespaces compiler.tree compiler.tree.builder -compiler.tree.copy-equiv compiler.tree.normalization compiler.tree.propagation.info compiler.tree.propagation.nodes ; @@ -25,7 +24,7 @@ M: quotation splicing-nodes normalize ; : propagate-body ( #call -- ) - body>> [ amend-copy-equiv ] [ (propagate) ] bi ; + body>> (propagate) ; ! Dispatch elimination : eliminate-dispatch ( #call word/quot/f -- ? ) diff --git a/unfinished/compiler/tree/propagation/nodes/nodes.factor b/unfinished/compiler/tree/propagation/nodes/nodes.factor index 6317ec4e06..10dd1a03c6 100644 --- a/unfinished/compiler/tree/propagation/nodes/nodes.factor +++ b/unfinished/compiler/tree/propagation/nodes/nodes.factor @@ -3,6 +3,7 @@ USING: sequences accessors kernel assocs sequences compiler.tree compiler.tree.def-use +compiler.tree.copy-equiv compiler.tree.propagation.info ; IN: compiler.tree.propagation.nodes @@ -15,7 +16,8 @@ GENERIC: propagate-after ( node -- ) GENERIC: propagate-around ( node -- ) -: (propagate) ( node -- ) [ propagate-around ] each ; +: (propagate) ( node -- ) + [ [ compute-copy-equiv ] [ propagate-around ] bi ] each ; : extract-value-info ( values -- assoc ) [ dup value-info ] H{ } map>assoc ; diff --git a/unfinished/compiler/tree/propagation/propagation-tests.factor b/unfinished/compiler/tree/propagation/propagation-tests.factor index 515d1bf474..d2583af832 100644 --- a/unfinished/compiler/tree/propagation/propagation-tests.factor +++ b/unfinished/compiler/tree/propagation/propagation-tests.factor @@ -1,5 +1,5 @@ USING: kernel compiler.tree.builder compiler.tree -compiler.tree.propagation compiler.tree.copy-equiv +compiler.tree.propagation compiler.tree.normalization tools.test math math.order accessors sequences arrays kernel.private vectors alien.accessors alien.c-types sequences.private @@ -14,7 +14,6 @@ IN: compiler.tree.propagation.tests : final-info ( quot -- seq ) build-tree normalize - compute-copy-equiv propagate peek node-input-infos ; @@ -145,6 +144,8 @@ IN: compiler.tree.propagation.tests [ dup string? t xor [ "A" throw ] [ ] if ] final-classes ] unit-test +[ f ] [ [ t xor ] final-classes first null-class? ] unit-test + [ t ] [ [ t or ] final-classes first true-class? ] unit-test [ t ] [ [ t swap or ] final-classes first true-class? ] unit-test @@ -155,12 +156,20 @@ IN: compiler.tree.propagation.tests [ t ] [ [ dup not or ] final-classes first true-class? ] unit-test +[ t ] [ [ dup t xor or ] final-classes first true-class? ] unit-test + [ t ] [ [ dup not swap or ] final-classes first true-class? ] unit-test +[ t ] [ [ dup t xor swap or ] final-classes first true-class? ] unit-test + [ t ] [ [ dup not and ] final-classes first false-class? ] unit-test +[ t ] [ [ dup t xor and ] final-classes first false-class? ] unit-test + [ t ] [ [ dup not swap and ] final-classes first false-class? ] unit-test +[ t ] [ [ dup t xor swap and ] final-classes first false-class? ] unit-test + [ t ] [ [ over [ drop f ] when [ "A" throw ] unless ] final-classes first false-class? ] unit-test [ V{ fixnum } ] [ diff --git a/unfinished/compiler/tree/propagation/propagation.factor b/unfinished/compiler/tree/propagation/propagation.factor index db69024413..7fa971bafe 100755 --- a/unfinished/compiler/tree/propagation/propagation.factor +++ b/unfinished/compiler/tree/propagation/propagation.factor @@ -3,6 +3,7 @@ USING: accessors kernel sequences namespaces hashtables compiler.tree compiler.tree.def-use +compiler.tree.copy-equiv compiler.tree.propagation.info compiler.tree.propagation.nodes compiler.tree.propagation.simple @@ -13,8 +14,7 @@ compiler.tree.propagation.known-words ; IN: compiler.tree.propagation : propagate ( node -- node ) - [ - H{ } clone constraints set - H{ } clone value-infos set - dup (propagate) - ] with-scope ; + H{ } clone copies set + H{ } clone constraints set + H{ } clone value-infos set + dup (propagate) ; diff --git a/unfinished/compiler/tree/propagation/recursive/recursive.factor b/unfinished/compiler/tree/propagation/recursive/recursive.factor index 3732d7c08c..9e1bf52bbf 100644 --- a/unfinished/compiler/tree/propagation/recursive/recursive.factor +++ b/unfinished/compiler/tree/propagation/recursive/recursive.factor @@ -13,8 +13,9 @@ compiler.tree.propagation.branches compiler.tree.propagation.constraints ; IN: compiler.tree.propagation.recursive -: check-fixed-point ( node infos1 infos2 -- node ) - sequence= [ dup label>> f >>fixed-point drop ] unless ; inline +: check-fixed-point ( node infos1 infos2 -- ) + [ value-info<= ] 2all? + [ drop ] [ label>> f >>fixed-point drop ] if ; : recursive-stacks ( #enter-recursive -- stacks initial ) [ label>> calls>> [ node-input-infos ] map flip ] @@ -46,19 +47,21 @@ IN: compiler.tree.propagation.recursive : propagate-recursive-phi ( #enter-recursive -- ) [ ] [ recursive-stacks unify-recursive-stacks ] [ ] tri - [ node-output-infos check-fixed-point drop ] 2keep - out-d>> set-value-infos ; + [ node-output-infos check-fixed-point ] + [ out-d>> set-value-infos drop ] + 3bi ; M: #recursive propagate-around ( #recursive -- ) - [ - copies [ clone ] change + { 0 } clone [ USE: math + dup first 10 = [ "OOPS" throw ] [ dup first 1+ swap set-first ] if constraints [ clone ] change child>> + [ first compute-copy-equiv ] [ first propagate-recursive-phi ] [ (propagate) ] - bi - ] until-fixed-point ; + tri + ] curry until-fixed-point ; : generalize-return-interval ( info -- info' ) dup [ literal?>> ] [ class>> null-class? ] bi or @@ -67,11 +70,9 @@ M: #recursive propagate-around ( #recursive -- ) : generalize-return ( infos -- infos' ) [ generalize-return-interval ] map ; -M: #call-recursive propagate-before ( #call-label -- ) - dup [ node-output-infos ] [ label>> return>> node-input-infos ] bi - [ check-fixed-point ] keep - generalize-return swap out-d>> set-value-infos ; +: return-infos ( node -- infos ) + label>> return>> node-input-infos generalize-return ; -M: #return-recursive propagate-before ( #return-recursive -- ) - dup [ node-input-infos ] [ in-d>> [ value-info ] map ] bi - check-fixed-point drop ; +M: #call-recursive propagate-before ( #call-label -- ) + [ ] [ return-infos ] [ node-output-infos ] tri + [ check-fixed-point ] [ drop swap out-d>> set-value-infos ] 3bi ; diff --git a/unfinished/stack-checker/inlining/inlining.factor b/unfinished/stack-checker/inlining/inlining.factor index ffa90c13ed..155baa7e65 100644 --- a/unfinished/stack-checker/inlining/inlining.factor +++ b/unfinished/stack-checker/inlining/inlining.factor @@ -17,7 +17,12 @@ IN: stack-checker.inlining : (inline-word) ( word label -- ) [ [ def>> ] keep ] dip infer-quot-recursive ; -TUPLE: inline-recursive word enter-out return calls fixed-point introductions ; +TUPLE: inline-recursive +word +enter-out enter-recursive +return calls +fixed-point +introductions ; : ( word -- label ) inline-recursive new swap >>word ;