Trying to make PEGs compile faster by reducing the number of low level IR nodes: merge functionality of #>r and #r> into #shuffle, and generate 1 node instead of 3 for calls to get-local

basis/compiler/cfg/builder/builder.factor

@@ -221,21 +221,14 @@ M: #push emit-node
     literal>> ^^load-literal ds-push iterate-next ;
 
 ! #shuffle
-: emit-shuffle ( effect -- )
-    [ out>> ] [ in>> dup length ds-load zip ] bi
-    '[ _ at ] map ds-store ;
-
 M: #shuffle emit-node
-    shuffle-effect emit-shuffle iterate-next ;
+    dup
-
+    H{ } clone
-M: #>r emit-node
+    [ [ in-d>> [ length ds-load ] keep ] dip '[ _ set-at ] 2each ]
-    [ in-d>> length ] [ out-r>> empty? ] bi
+    [ [ in-r>> [ length rs-load ] keep ] dip '[ _ set-at ] 2each ]
-    [ neg ##inc-d ] [ ds-load rs-store ] if
+    [ nip ] 2tri
-    iterate-next ;
+    [ [ [ out-d>> ] [ mapping>> ] bi ] dip '[ _ at _ at ] map ds-store ]
-
+    [ [ [ out-r>> ] [ mapping>> ] bi ] dip '[ _ at _ at ] map rs-store ] 2bi
-M: #r> emit-node
-    [ in-r>> length ] [ out-d>> empty? ] bi
-    [ neg ##inc-r ] [ rs-load ds-store ] if
     iterate-next ;
 
 ! #return

basis/compiler/cfg/stacks/stacks.factor

@@ -15,16 +15,28 @@ IN: compiler.cfg.stacks
     1 ##inc-d D 0 ##replace ;
 
 : ds-load ( n -- vregs )
-    [ <reversed> [ <ds-loc> ^^peek ] map ] [ neg ##inc-d ] bi ;
+    dup 0 =
+    [ drop f ]
+    [ [ <reversed> [ <ds-loc> ^^peek ] map ] [ neg ##inc-d ] bi ] if ;
 
 : ds-store ( vregs -- )
-    <reversed> [ length ##inc-d ] [ [ <ds-loc> ##replace ] each-index ] bi ;
+    [
+        <reversed>
+        [ length ##inc-d ]
+        [ [ <ds-loc> ##replace ] each-index ] bi
+    ] unless-empty ;
 
 : rs-load ( n -- vregs )
-    [ <reversed> [ <rs-loc> ^^peek ] map ] [ neg ##inc-r ] bi ;
+    dup 0 =
+    [ drop f ]
+    [ [ <reversed> [ <rs-loc> ^^peek ] map ] [ neg ##inc-r ] bi ] if ;
 
 : rs-store ( vregs -- )
-    <reversed> [ length ##inc-r ] [ [ <rs-loc> ##replace ] each-index ] bi ;
+    [
+        <reversed>
+        [ length ##inc-r ]
+        [ [ <rs-loc> ##replace ] each-index ] bi
+    ] unless-empty ;
 
 : 2inputs ( -- vreg1 vreg2 )
     D 1 ^^peek D 0 ^^peek -2 ##inc-d ;

basis/compiler/tree/checker/checker.factor

@@ -22,8 +22,8 @@ ERROR: check-use-error value message ;
 GENERIC: check-node* ( node -- )
 
 M: #shuffle check-node*
-    [ [ mapping>> values ] [ in-d>> ] bi subset? [ "Bad mapping inputs" throw ] unless ]
+    [ [ mapping>> values ] [ [ in-d>> ] [ in-r>> ] bi append ] bi subset? [ "Bad mapping inputs" throw ] unless ]
-    [ [ mapping>> keys ] [ out-d>> ] bi set= [ "Bad mapping outputs" throw ] unless ]
+    [ [ mapping>> keys ] [ [ out-d>> ] [ out-r>> ] bi append ] bi set= [ "Bad mapping outputs" throw ] unless ]
     bi ;
 
 : check-lengths ( seq -- )
@@ -31,13 +31,6 @@ M: #shuffle check-node*
 
 M: #copy check-node* inputs/outputs 2array check-lengths ;
 
-: check->r/r> ( node -- )
-    inputs/outputs [ drop ] [ 2array check-lengths ] if-empty ;
-
-M: #>r check-node* check->r/r> ;
-
-M: #r> check-node* check->r/r> ;
-
 M: #return-recursive check-node* inputs/outputs 2array check-lengths ;
 
 M: #phi check-node*
@@ -113,11 +106,8 @@ M: #push check-stack-flow* check-out-d ;
 
 M: #call check-stack-flow* [ check-in-d ] [ check-out-d ] bi ;
 
-M: #shuffle check-stack-flow* [ check-in-d ] [ check-out-d ] bi ;
+M: #shuffle check-stack-flow*
-
+    { [ check-in-d ] [ check-in-r ] [ check-out-d ] [ check-out-r ] } cleave ;
-M: #>r check-stack-flow* [ check-in-d ] [ check-out-r ] bi ;
-
-M: #r> check-stack-flow* [ check-in-r ] [ check-out-d ] bi ;
 
 : assert-datastack-empty ( -- )
     datastack get empty? [ "Data stack not empty" throw ] unless ;

basis/compiler/tree/dead-code/branches/branches.factor

@@ -39,7 +39,7 @@ M: #branch remove-dead-code*
     [ drop filter-live ] [ swap nths ] 2bi
     [ make-values ] keep
     [ drop ] [ zip ] 2bi
-    #shuffle ;
+    #data-shuffle ;
 
 : insert-drops ( nodes values indices -- nodes' )
     '[

basis/compiler/tree/dead-code/simple/simple.factor

@@ -39,12 +39,6 @@ M: #copy compute-live-values*
 
 M: #call compute-live-values* nip look-at-inputs ;
 
-M: #>r compute-live-values*
-    [ out-r>> ] [ in-d>> ] bi look-at-mapping ;
-
-M: #r> compute-live-values*
-    [ out-d>> ] [ in-r>> ] bi look-at-mapping ;
-
 M: #shuffle compute-live-values*
     mapping>> at look-at-value ;
 
@@ -61,7 +55,7 @@ M: #alien-indirect compute-live-values* nip look-at-inputs ;
     zip filter-mapping values ;
 
 : filter-live ( values -- values' )
-    [ live-value? ] filter ;
+    dup empty? [ [ live-value? ] filter ] unless ;
 
 :: drop-values ( inputs outputs mapping-keys mapping-values -- #shuffle )
     inputs
@@ -69,7 +63,7 @@ M: #alien-indirect compute-live-values* nip look-at-inputs ;
     outputs
     mapping-keys
     mapping-values
-    filter-corresponding zip #shuffle ; inline
+    filter-corresponding zip #data-shuffle ; inline
 
 :: drop-dead-values ( outputs -- #shuffle )
     [let* | new-outputs [ outputs make-values ]
@@ -95,16 +89,6 @@ M: #alien-indirect compute-live-values* nip look-at-inputs ;
 M: #introduce remove-dead-code* ( #introduce -- nodes )
     maybe-drop-dead-outputs ;
 
-M: #>r remove-dead-code*
-    [ filter-live ] change-out-r
-    [ filter-live ] change-in-d
-    dup in-d>> empty? [ drop f ] when ;
-
-M: #r> remove-dead-code*
-    [ filter-live ] change-out-d
-    [ filter-live ] change-in-r
-    dup in-r>> empty? [ drop f ] when ;
-
 M: #push remove-dead-code*
     dup out-d>> first live-value? [ drop f ] unless ;
 
@@ -125,12 +109,14 @@ M: #call remove-dead-code*
 M: #shuffle remove-dead-code*
     [ filter-live ] change-in-d
     [ filter-live ] change-out-d
+    [ filter-live ] change-in-r
+    [ filter-live ] change-out-r
     [ filter-mapping ] change-mapping
-    dup in-d>> empty? [ drop f ] when ;
+    dup [ in-d>> empty? ] [ in-r>> empty? ] bi and [ drop f ] when ;
 
 M: #copy remove-dead-code*
     [ in-d>> ] [ out-d>> ] bi
-    2dup swap zip #shuffle
+    2dup swap zip #data-shuffle
     remove-dead-code* ;
 
 M: #terminate remove-dead-code*

basis/compiler/tree/debugger/debugger.factor

@@ -3,7 +3,7 @@
 USING: kernel assocs match fry accessors namespaces make effects
 sequences sequences.private quotations generic macros arrays
 prettyprint prettyprint.backend prettyprint.sections math words
-combinators io sorting hints qualified
+combinators combinators.short-circuit io sorting hints qualified
 compiler.tree
 compiler.tree.recursive
 compiler.tree.normalization
@@ -57,9 +57,41 @@ TUPLE: shuffle-node { effect effect } ;
 
 M: shuffle-node pprint* effect>> effect>string text ;
  
+: (shuffle-effect) ( in out #shuffle -- effect )
+    mapping>> '[ _ at ] map <effect> ;
+
+: shuffle-effect ( #shuffle -- effect )
+    [ in-d>> ] [ out-d>> ] [ ] tri (shuffle-effect) ;
+
+: #>r? ( #shuffle -- ? )
+    {
+        [ in-d>> length 1 = ]
+        [ out-r>> length 1 = ]
+        [ in-r>> empty? ]
+        [ out-d>> empty? ]
+    } 1&& ;
+
+: #r>? ( #shuffle -- ? )
+    {
+        [ in-d>> empty? ]
+        [ out-r>> empty? ]
+        [ in-r>> length 1 = ]
+        [ out-d>> length 1 = ]
+    } 1&& ;
+
 M: #shuffle node>quot
-    shuffle-effect dup pretty-shuffle
+    {
-    [ % ] [ shuffle-node boa , ] ?if ;
+        { [ dup #>r? ] [ drop \ >r , ] }
+        { [ dup #r>? ] [ drop \ r> , ] }
+        {
+            [ dup [ in-r>> empty? ] [ out-r>> empty? ] bi and ]
+            [
+                dup shuffle-effect pretty-shuffle
+                [ % ] [ shuffle-node boa , ] ?if
+            ]
+        }
+        [ drop "COMPLEX SHUFFLE" , ]
+    } cond ;
 
 M: #push node>quot literal>> , ;
 
@@ -82,16 +114,6 @@ M: #if node>quot
 M: #dispatch node>quot
     children>> [ nodes>quot ] map , \ dispatch , ;
 
-M: #>r node>quot
-    [ in-d>> length ] [ out-r>> empty? \ drop \ >r ? ] bi
-    <repetition> % ;
-
-DEFER: rdrop
-
-M: #r> node>quot
-    [ in-r>> length ] [ out-d>> empty? \ rdrop \ r> ? ] bi
-    <repetition> % ;
-
 M: #alien-invoke node>quot params>> , \ #alien-invoke , ;
 
 M: #alien-indirect node>quot params>> , \ #alien-indirect , ;

basis/compiler/tree/def-use/def-use.factor

@@ -38,16 +38,16 @@ GENERIC: node-uses-values ( node -- values )
 
 M: #introduce node-uses-values drop f ;
 M: #push node-uses-values drop f ;
-M: #r> node-uses-values in-r>> ;
 M: #phi node-uses-values phi-in-d>> concat remove-bottom prune ;
 M: #declare node-uses-values declaration>> keys ;
 M: #terminate node-uses-values [ in-d>> ] [ in-r>> ] bi append ;
+M: #shuffle node-uses-values [ in-d>> ] [ in-r>> ] bi append ;
 M: #alien-callback node-uses-values drop f ;
 M: node node-uses-values in-d>> ;
 
 GENERIC: node-defs-values ( node -- values )
 
-M: #>r node-defs-values out-r>> ;
+M: #shuffle node-defs-values [ out-d>> ] [ out-r>> ] bi append ;
 M: #branch node-defs-values drop f ;
 M: #declare node-defs-values drop f ;
 M: #return node-defs-values drop f ;

basis/compiler/tree/finalization/finalization.factor

@@ -1,6 +1,7 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel accessors sequences words memoize classes.builtin
+fry assocs
 compiler.tree
 compiler.tree.combinators
 compiler.tree.propagation.info
@@ -27,9 +28,10 @@ GENERIC: finalize* ( node -- nodes )
 M: #copy finalize* drop f ;
 
 M: #shuffle finalize*
-    dup shuffle-effect
+    dup
-    [ in>> ] [ out>> ] bi sequence=
+    [ [ in-d>> ] [ out-d>> ] [ mapping>> ] tri '[ _ at ] map sequence= ]
-    [ drop f ] when ;
+    [ [ in-r>> ] [ out-r>> ] [ mapping>> ] tri '[ _ at ] map sequence= ]
+    bi and [ drop f ] when ;
 
 : builtin-predicate? ( #call -- ? )
     word>> "predicating" word-prop builtin-class? ;

basis/compiler/tree/identities/identities.factor

@@ -79,7 +79,7 @@ GENERIC: apply-identities* ( node -- node )
 
 : select-input ( node n -- #shuffle )
     [ [ in-d>> ] [ out-d>> ] bi ] dip
-    pick nth over first associate #shuffle ;
+    pick nth over first associate #data-shuffle ;
 
 M: #call apply-identities*
     dup word>> "identities" word-prop [

basis/compiler/tree/normalization/renaming/renaming.factor

@@ -10,7 +10,7 @@ SYMBOL: rename-map
     [ rename-map get at ] keep or ;
 
 : rename-values ( values -- values' )
-    rename-map get '[ [ _ at ] keep or ] map ;
+    dup empty? [ rename-map get '[ [ _ at ] keep or ] map ] unless ;
 
 : add-renamings ( old new -- )
     [ rename-values ] dip
@@ -22,13 +22,11 @@ M: #introduce rename-node-values* ;
 
 M: #shuffle rename-node-values*
     [ rename-values ] change-in-d
+    [ rename-values ] change-in-r
     [ [ rename-value ] assoc-map ] change-mapping ;
 
 M: #push rename-node-values* ;
 
-M: #r> rename-node-values*
-    [ rename-values ] change-in-r ;
-
 M: #terminate rename-node-values*
     [ rename-values ] change-in-d
     [ rename-values ] change-in-r ;

basis/compiler/tree/tree.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2004, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: fry arrays generic assocs kernel math namespaces parser
-sequences words vectors math.intervals effects classes
+sequences words vectors math.intervals classes
 accessors combinators stack-checker.state stack-checker.visitor
 stack-checker.inlining ;
 IN: compiler.tree
@@ -42,30 +42,21 @@ TUPLE: #push < node literal out-d ;
 
 TUPLE: #renaming < node ;
 
-TUPLE: #shuffle < #renaming mapping in-d out-d ;
+TUPLE: #shuffle < #renaming mapping in-d out-d in-r out-r ;
 
-: #shuffle ( inputs outputs mapping -- node )
+: #shuffle ( in-d out-d in-r out-r mapping -- node )
     \ #shuffle new
         swap >>mapping
+        swap >>out-r
+        swap >>in-r
         swap >>out-d
         swap >>in-d ;
 
+: #data-shuffle ( in-d out-d mapping -- node )
+    [ f f ] dip #shuffle ; inline
+
 : #drop ( inputs -- node )
-    { } { } #shuffle ;
+    { } { } #data-shuffle ;
-
-TUPLE: #>r < #renaming in-d out-r ;
-
-: #>r ( inputs outputs -- node )
-    \ #>r new
-        swap >>out-r
-        swap >>in-d ;
-
-TUPLE: #r> < #renaming in-r out-d ;
-
-: #r> ( inputs outputs -- node )
-    \ #r> new
-        swap >>out-d
-        swap >>in-r ;
 
 TUPLE: #terminate < node in-d in-r ;
 
@@ -171,16 +162,9 @@ TUPLE: #alien-callback < #alien-node ;
 GENERIC: inputs/outputs ( #renaming -- inputs outputs )
 
 M: #shuffle inputs/outputs mapping>> unzip swap ;
-M: #>r inputs/outputs [ in-d>> ] [ out-r>> ] bi ;
-M: #r> inputs/outputs [ in-r>> ] [ out-d>> ] bi ;
 M: #copy inputs/outputs [ in-d>> ] [ out-d>> ] bi ;
 M: #return-recursive inputs/outputs [ in-d>> ] [ out-d>> ] bi ;
 
-: shuffle-effect ( #shuffle -- effect )
-    [ in-d>> ] [ out-d>> ] [ mapping>> ] tri
-    '[ _ at ] map
-    <effect> ;
-
 : recursive-phi-in ( #enter-recursive -- seq )
     [ label>> calls>> [ in-d>> ] map ] [ in-d>> ] bi suffix ;
 
@@ -193,8 +177,8 @@ M: vector #call, #call node, ;
 M: vector #push, #push node, ;
 M: vector #shuffle, #shuffle node, ;
 M: vector #drop, #drop node, ;
-M: vector #>r, #>r node, ;
+M: vector #>r, [ [ f f ] dip ] [ swap zip ] 2bi #shuffle, ;
-M: vector #r>, #r> node, ;
+M: vector #r>, [ swap [ f swap ] dip f ] [ swap zip ] 2bi #shuffle, ;
 M: vector #return, #return node, ;
 M: vector #enter-recursive, #enter-recursive node, ;
 M: vector #return-recursive, #return-recursive node, ;

basis/compiler/tree/tuple-unboxing/tuple-unboxing.factor

@@ -42,7 +42,7 @@ M: #push unbox-tuples* ( #push -- nodes )
     [ dup unboxed-allocation [ (flatten-values) ] [ ] ?if ] map ;
 
 : flatten-values ( values -- values' )
-    (flatten-values) flatten ;
+    dup empty? [ (flatten-values) flatten ] unless ;
 
 : prepare-slot-access ( #call -- tuple-values outputs slot-values )
     [ in-d>> flatten-values ]
@@ -54,7 +54,7 @@ M: #push unbox-tuples* ( #push -- nodes )
     ] tri ;
 
 : slot-access-shuffle ( tuple-values outputs slot-values -- #shuffle )
-    [ drop ] [ zip ] 2bi #shuffle ;
+    [ drop ] [ zip ] 2bi #data-shuffle ;
 
 : unbox-slot-access ( #call -- nodes )
     dup out-d>> first unboxed-slot-access? [
@@ -77,17 +77,11 @@ M: #copy unbox-tuples*
     [ flatten-values ] change-in-d
     [ flatten-values ] change-out-d ;
 
-M: #>r unbox-tuples*
-    [ flatten-values ] change-in-d
-    [ flatten-values ] change-out-r ;
-
-M: #r> unbox-tuples*
-    [ flatten-values ] change-in-r
-    [ flatten-values ] change-out-d ;
-
 M: #shuffle unbox-tuples*
     [ flatten-values ] change-in-d
     [ flatten-values ] change-out-d
+    [ flatten-values ] change-in-r
+    [ flatten-values ] change-out-r
     [ unzip [ flatten-values ] bi@ zip ] change-mapping ;
 
 M: #terminate unbox-tuples*

basis/locals/locals.factor

@@ -6,8 +6,7 @@ quotations debugger macros arrays macros splitting combinators
 prettyprint.backend definitions prettyprint hashtables
 prettyprint.sections sets sequences.private effects
 effects.parser generic generic.parser compiler.units accessors
-locals.backend memoize macros.expander lexer classes
+locals.backend memoize macros.expander lexer classes ;
-stack-checker.known-words ;
 IN: locals
 
 ! Inspired by
@@ -49,8 +48,7 @@ PREDICATE: local < word "local?" word-prop ;
 : <local> ( name -- word )
     #! Create a local variable identifier
     f <word>
-    dup t "local?" set-word-prop
+    dup t "local?" set-word-prop ;
-    dup { } { object } define-primitive ;
 
 PREDICATE: local-word < word "local-word?" word-prop ;
 
@@ -61,14 +59,12 @@ PREDICATE: local-reader < word "local-reader?" word-prop ;
 
 : <local-reader> ( name -- word )
     f <word>
-    dup t "local-reader?" set-word-prop
+    dup t "local-reader?" set-word-prop ;
-    dup { } { object } define-primitive ;
 
 PREDICATE: local-writer < word "local-writer?" word-prop ;
 
 : <local-writer> ( reader -- word )
     dup name>> "!" append f <word> {
-        [ nip { object } { } define-primitive ]
         [ nip t "local-writer?" set-word-prop ]
         [ swap "local-reader" set-word-prop ]
         [ "local-writer" set-word-prop ]

basis/stack-checker/known-words/known-words.factor

@@ -10,7 +10,8 @@ sequences sequences.private slots.private strings
 strings.private system threads.private classes.tuple
 classes.tuple.private vectors vectors.private words definitions
 words.private assocs summary compiler.units system.private
-combinators locals.backend words.private quotations.private
+combinators locals locals.backend locals.private words.private
+quotations.private
 stack-checker.state
 stack-checker.backend
 stack-checker.branches
@@ -48,7 +49,7 @@ IN: stack-checker.known-words
 : infer-shuffle ( shuffle -- )
     [ in>> length consume-d ] keep ! inputs shuffle
     [ drop ] [ shuffle dup copy-values dup output-d ] 2bi ! inputs outputs copies
-    [ nip ] [ swap zip ] 2bi ! inputs copies mapping
+    [ nip f f ] [ swap zip ] 2bi ! in-d out-d in-r out-r mapping
     #shuffle, ;
 
 : infer-shuffle-word ( word -- )
@@ -123,21 +124,23 @@ M: object infer-call*
 
 : infer-load-locals ( -- )
     pop-literal nip
-    [ dup reverse <effect> infer-shuffle ]
+    consume-d dup reverse copy-values dup output-r
-    [ infer->r ]
+    [ [ f f ] dip ] [ reverse swap zip ] 2bi #shuffle, ;
-    bi ;
 
 : infer-get-local ( -- )
-    pop-literal nip
+    [let* | n [ pop-literal nip ]
-    [ infer-r> ]
+            in-r [ n consume-r ]
-    [ dup 0 prefix <effect> infer-shuffle ]
+            out-d [ in-r first copy-value 1array ]
-    [ infer->r ]
+            out-r [ in-r copy-values ] |
-    tri ;
+         out-d output-d
+         out-r output-r
+         f out-d in-r out-r
+         out-r in-r zip out-d first in-r first 2array suffix
+         #shuffle,
+    ] ;
 
 : infer-drop-locals ( -- )
-    pop-literal nip
+    f f pop-literal nip consume-r f f #shuffle, ;
-    [ infer-r> ]
-    [ { } <effect> infer-shuffle ] bi ;
 
 : infer-special ( word -- )
     {
@@ -164,6 +167,12 @@ M: object infer-call*
         { \ alien-callback [ infer-alien-callback ] }
     } case ;
 
+: infer-local-reader ( word -- )
+    (( -- value )) apply-word/effect ;
+
+: infer-local-writer ( word -- )
+    (( value -- )) apply-word/effect ;
+
 {
     >r r> declare call (call) curry compose execute (execute) if
 dispatch <tuple-boa> (throw) load-locals get-local drop-locals
@@ -183,6 +192,9 @@ do-primitive alien-invoke alien-indirect alien-callback
         { [ dup "macro" word-prop ] [ apply-macro ] }
         { [ dup "cannot-infer" word-prop ] [ cannot-infer-effect ] }
         { [ dup "inferred-effect" word-prop ] [ cached-infer ] }
+        { [ dup local? ] [ infer-local-reader ] }
+        { [ dup local-reader? ] [ infer-local-reader ] }
+        { [ dup local-writer? ] [ infer-local-writer ] }
         { [ dup recursive-label ] [ call-recursive-word ] }
         [ dup infer-word apply-word/effect ]
     } cond ;

basis/stack-checker/visitor/dummy/dummy.factor

@@ -8,7 +8,7 @@ M: f #introduce, drop ;
 M: f #call, 3drop ;
 M: f #call-recursive, 3drop ;
 M: f #push, 2drop ;
-M: f #shuffle, 3drop ;
+M: f #shuffle, 2drop 2drop drop ;
 M: f #>r, 2drop ;
 M: f #r>, 2drop ;
 M: f #return, drop ;

basis/stack-checker/visitor/visitor.factor

@@ -13,7 +13,7 @@ HOOK: #introduce, stack-visitor ( values -- )
 HOOK: #call, stack-visitor ( inputs outputs word -- )
 HOOK: #call-recursive, stack-visitor ( inputs outputs word -- )
 HOOK: #push, stack-visitor ( literal value -- )
-HOOK: #shuffle, stack-visitor ( inputs outputs mapping -- )
+HOOK: #shuffle, stack-visitor ( in-d out-d in-r out-r mapping -- )
 HOOK: #drop, stack-visitor ( values -- )
 HOOK: #>r, stack-visitor ( inputs outputs -- )
 HOOK: #r>, stack-visitor ( inputs outputs -- )