Enforce that usages of >r/r> must be balanced within a quotation

basis/compiler/tree/checker/checker.factor

@@ -36,12 +36,9 @@ M: #r> check-node* inputs/outputs 2array check-lengths ;
 M: #return-recursive check-node* inputs/outputs 2array check-lengths ;
 
 M: #phi check-node*
-    {
     [ [ phi-in-d>> <flipped> ] [ out-d>> ] bi 2array check-lengths ]
-        [ [ phi-in-r>> <flipped> ] [ out-r>> ] bi 2array check-lengths ]
     [ phi-in-d>> check-lengths ]
-        [ phi-in-r>> check-lengths ]
+    bi ;
-    } cleave ;
 
 M: #enter-recursive check-node*
     [ [ in-d>> ] [ out-d>> ] bi 2array check-lengths ]

basis/compiler/tree/cleanup/cleanup.factor

@@ -119,12 +119,9 @@ M: #branch cleanup*
 
 M: #phi cleanup*
     #! Remove #phi function inputs which no longer exist.
-    live-branches get {
+    live-branches get
     [ '[ , select-children sift ] change-phi-in-d ]
-        [ '[ , select-children sift ] change-phi-in-r ]
+    [ '[ , select-children sift ] change-phi-info-d ] bi
-        [ '[ , select-children sift ] change-phi-info-d ]
-        [ '[ , select-children sift ] change-phi-info-r ]
-    } cleave
     live-branches off ;
 
 : >copy ( node -- #copy ) [ in-d>> ] [ out-d>> ] bi #copy ;

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

@@ -16,9 +16,7 @@ M: #dispatch mark-live-values* look-at-inputs ;
 M: #phi compute-live-values*
     #! If any of the outputs of a #phi are live, then the
     #! corresponding inputs are live too.
-    [ [ out-d>> ] [ phi-in-d>> ] bi look-at-phi ]
+    [ out-d>> ] [ phi-in-d>> ] bi look-at-phi ;
-    [ [ out-r>> ] [ phi-in-r>> ] bi look-at-phi ]
-    2bi ;
 
 SYMBOL: if-node
 
@@ -28,45 +26,31 @@ M: #branch remove-dead-code*
     bi ;
 
 : remove-phi-inputs ( #phi -- )
-    dup [ out-d>> ] [ phi-in-d>> flip ] bi filter-corresponding flip >>phi-in-d
+    dup [ out-d>> ] [ phi-in-d>> flip ] bi
-    dup [ out-r>> ] [ phi-in-r>> flip ] bi filter-corresponding flip >>phi-in-r
+    filter-corresponding
+    flip >>phi-in-d
     drop ;
 
 : live-value-indices ( values -- indices )
     [ length ] keep live-values get
     '[ , nth , key? ] filter ; inline
 
-: drop-d-values ( values indices -- node )
+: drop-values ( values indices -- node )
     [ drop filter-live ] [ nths ] 2bi
     [ make-values ] keep
     [ drop ] [ zip ] 2bi
     #shuffle ;
 
-: drop-r-values ( values indices -- nodes ) 2drop f ;
+: insert-drops ( nodes values indices -- nodes' )
-!     [ dup make-values [ #r> ] keep ] dip
+    '[ , drop-values suffix ] 2map ;
-!     drop-d-values dup out-d>> dup make-values #>r
-!     3array ;
-
-: insert-drops ( nodes d-values r-values d-indices r-indices -- nodes' )
-    '[
-        [ , drop-d-values 1array ]
-        [ , drop-r-values ]
-        bi* 3append
-    ] 3map ;
 
 : hoist-drops ( #phi -- )
     if-node get swap
-    {
+    [ phi-in-d>> ] [ out-d>> live-value-indices ] bi
-        [ phi-in-d>> ]
+    '[ , , insert-drops ] change-children drop ;
-        [ phi-in-r>> ]
-        [ out-d>> live-value-indices ]
-        [ out-r>> live-value-indices ]
-    } cleave
-    '[ , , , , insert-drops ] change-children drop ;
 
 : remove-phi-outputs ( #phi -- )
     [ filter-live ] change-out-d
-    [ filter-live ] change-out-r
     drop ;
 
 M: #phi remove-dead-code*

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

@@ -39,9 +39,7 @@ 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
+M: #phi node-uses-values phi-in-d>> concat remove-bottom prune ;
-    [ phi-in-d>> ] [ phi-in-r>> ] bi
-    append concat remove-bottom prune ;
 M: #declare node-uses-values declaration>> keys ;
 M: #terminate node-uses-values [ in-d>> ] [ in-r>> ] bi append ;
 M: #alien-callback node-uses-values drop f ;
@@ -51,7 +49,6 @@ GENERIC: node-defs-values ( node -- values )
 
 M: #>r node-defs-values out-r>> ;
 M: #branch node-defs-values drop f ;
-M: #phi node-defs-values [ out-d>> ] [ out-r>> ] bi append ;
 M: #declare node-defs-values drop f ;
 M: #return node-defs-values drop f ;
 M: #recursive node-defs-values drop f ;

basis/compiler/tree/escape-analysis/branches/branches.factor

@@ -33,6 +33,4 @@ M: #branch escape-analysis*
     2bi ;
 
 M: #phi escape-analysis*
-    [ [ phi-in-d>> <flipped> ] [ out-d>> ] bi merge-allocations ]
+    [ phi-in-d>> <flipped> ] [ out-d>> ] bi merge-allocations ;
-    [ [ phi-in-r>> <flipped> ] [ out-r>> ] bi merge-allocations ]
-    bi ;

basis/compiler/tree/propagation/branches/branches.factor

@@ -70,13 +70,10 @@ SYMBOL: infer-children-data
     ] 2map ;
 
 : annotate-phi-inputs ( #phi -- )
-    dup phi-in-d>> compute-phi-input-infos >>phi-info-d
+    dup phi-in-d>> compute-phi-input-infos >>phi-info-d drop ;
-    dup phi-in-r>> compute-phi-input-infos >>phi-info-r
-    drop ;
 
 : annotate-phi-outputs ( #phi -- )
-    dup [ out-d>> ] [ out-r>> ] bi append extract-value-info
+    dup out-d>> extract-value-info >>info drop ;
-    >>info drop ;
 
 : merge-value-infos ( infos outputs -- )
     [ [ value-infos-union ] map ] dip set-value-infos ;
@@ -84,12 +81,10 @@ SYMBOL: infer-children-data
 SYMBOL: condition-value
 
 M: #phi propagate-before ( #phi -- )
-    {
     [ annotate-phi-inputs ]
     [ [ phi-info-d>> <flipped> ] [ out-d>> ] bi merge-value-infos ]
-        [ [ phi-info-r>> <flipped> ] [ out-r>> ] bi merge-value-infos ]
     [ annotate-phi-outputs ]
-    } cleave ;
+    tri ;
 
 : branch-phi-constraints ( output values booleans -- )
      {

basis/compiler/tree/propagation/copy/copy.factor

@@ -49,8 +49,7 @@ M: #renaming compute-copy-equiv* inputs/outputs are-copies-of ;
     ] 2each ;
 
 M: #phi compute-copy-equiv*
-    [ [ phi-in-d>> <flipped> ] [ out-d>> ] bi compute-phi-equiv ]
+    [ phi-in-d>> <flipped> ] [ out-d>> ] bi compute-phi-equiv ;
-    [ [ phi-in-r>> <flipped> ] [ out-r>> ] bi compute-phi-equiv ] bi ;
 
 M: node compute-copy-equiv* drop ;
 

basis/compiler/tree/propagation/propagation-tests.factor

@@ -274,10 +274,6 @@ IN: compiler.tree.propagation.tests
     [ 0 dup 100 < not [ 1+ ] [ 1- ] if ] final-literals
 ] unit-test
 
-[ V{ fixnum } ] [
-    [ [ 1 >r ] [ 2 >r ] if r> 3 + ] final-classes
-] unit-test
-
 [ V{ 2 } ] [
     [ [ 1 ] [ 1 ] if 1 + ] final-literals
 ] unit-test

basis/compiler/tree/tree.factor

@@ -90,13 +90,11 @@ TUPLE: #dispatch < #branch ;
 : #dispatch ( n branches -- node )
     \ #dispatch new-branch ;
 
-TUPLE: #phi < node phi-in-d phi-info-d phi-in-r phi-info-r out-d out-r terminated ;
+TUPLE: #phi < node phi-in-d phi-info-d out-d terminated ;
 
-: #phi ( d-phi-in d-phi-out r-phi-in r-phi-out terminated -- node )
+: #phi ( d-phi-in d-phi-out terminated -- node )
     \ #phi new
         swap >>terminated
-        swap >>out-r
-        swap >>phi-in-r
         swap >>out-d
         swap >>phi-in-d ;
 

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

@@ -100,9 +100,7 @@ M: #terminate unbox-tuples*
 
 M: #phi unbox-tuples*
     [ [ flatten-values ] map pad-with-bottom ] change-phi-in-d
-    [ [ flatten-values ] map pad-with-bottom ] change-phi-in-r
+    [ flatten-values ] change-out-d ;
-    [ flatten-values ] change-out-d 
-    [ flatten-values ] change-out-r ;
 
 M: #recursive unbox-tuples*
     [ flatten-values ] change-in-d ;

basis/math/partial-dispatch/partial-dispatch.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors kernel kernel.private math math.private words
-sequences parser namespaces assocs quotations arrays
+sequences parser namespaces assocs quotations arrays locals
 generic generic.math hashtables effects compiler.units ;
 IN: math.partial-dispatch
 
@@ -12,29 +12,26 @@ IN: math.partial-dispatch
 PREDICATE: math-partial < word
     "derived-from" word-prop >boolean ;
 
-: fixnum-integer-op ( a b fix-word big-word -- c )
+:: fixnum-integer-op ( a b fix-word big-word -- c )
-    pick tag 0 eq? [
+    b tag 0 eq? [
-        drop execute
+        a b fix-word execute
     ] [
-        >r drop >r fixnum>bignum r> r> execute
+       a fixnum>bignum b big-word execute
     ] if ; inline
 
-: integer-fixnum-op ( a b fix-word big-word -- c )
+:: integer-fixnum-op ( a b fix-word big-word -- c )
-    >r pick tag 0 eq? [
+    a tag 0 eq? [
-        r> drop execute
+        a b fix-word execute
     ] [
-        drop fixnum>bignum r> execute
+        a b fixnum>bignum big-word execute
     ] if ; inline
 
-: integer-integer-op ( a b fix-word big-word -- c )
+:: integer-integer-op ( a b fix-word big-word -- c )
-    pick tag 0 eq? [
+    b tag 0 eq? [
-        integer-fixnum-op
+        a b fix-word big-word integer-fixnum-op
     ] [
-        >r drop over tag 0 eq? [
+        a dup tag 0 eq? [ fixnum>bignum ] when
-            >r fixnum>bignum r> r> execute
+        b big-word execute
-        ] [
-            r> execute
-        ] if
     ] if ; inline
 
 : integer-op-combinator ( triple -- word )

basis/stack-checker/branches/branches.factor

@@ -61,23 +61,12 @@ SYMBOL: quotations
     unify-branches
     [ d-in set ] [ ] [ dup >vector meta-d set ] tri* ;
 
-! : retainstack-phi ( seq -- phi-in phi-out )
-!     [ length 0 <repetition> ] [ meta-r active-variable ] bi
-!     unify-branches
-!     [ drop ] [ ] [ dup >vector meta-r set ] tri* ;
-
 : terminated-phi ( seq -- terminated )
     terminated? branch-variable ;
 
 : compute-phi-function ( seq -- )
     [ quotation active-variable sift quotations set ]
-    [
+    [ [ datastack-phi ] [ terminated-phi ] bi #phi, ]
-        [ datastack-phi ]
-        ! [ retainstack-phi ]
-        [ drop f f ]
-        [ terminated-phi ]
-        tri #phi,
-    ]
     [ [ terminated? swap at ] all? terminated? set ]
     tri ;
 

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

@@ -17,7 +17,7 @@ M: f #return-recursive, 3drop ;
 M: f #terminate, 2drop ;
 M: f #if, 3drop ;
 M: f #dispatch, 2drop ;
-M: f #phi, drop drop drop drop drop ;
+M: f #phi, 3drop ;
 M: f #declare, drop ;
 M: f #recursive, 3drop ;
 M: f #copy, 2drop ;

basis/stack-checker/visitor/visitor.factor

@@ -20,7 +20,7 @@ HOOK: #r>, stack-visitor ( inputs outputs -- )
 HOOK: #terminate, stack-visitor ( in-d in-r -- )
 HOOK: #if, stack-visitor ( ? true false -- )
 HOOK: #dispatch, stack-visitor ( n branches -- )
-HOOK: #phi, stack-visitor ( d-phi-in d-phi-out r-phi-in r-phi-out terminated -- )
+HOOK: #phi, stack-visitor ( d-phi-in d-phi-out terminated -- )
 HOOK: #declare, stack-visitor ( declaration -- )
 HOOK: #return, stack-visitor ( stack -- )
 HOOK: #enter-recursive, stack-visitor ( label inputs outputs -- )