Fix various test failures

library/collections/virtual-sequences.factor

@@ -6,7 +6,9 @@ USING: errors generic kernel math sequences-internals vectors ;
 ! A reversal of an underlying sequence.
 TUPLE: reversed ;
 
-C: reversed [ set-delegate ] keep ;
+C: reversed
+    #! A delegate f means no delegate...
+    [ >r [ { } ] unless* r> set-delegate ] keep ;
 
 : reversed@ delegate [ length swap - 1- ] keep ; inline
 

library/compiler/inference/branches.factor

@@ -54,8 +54,8 @@ namespaces parser prettyprint sequences strings vectors words ;
 
 : callstack-effect ( seq -- )
     dup length 0 <array>
-    swap meta-r active-variable
-    unify-effect meta-r set drop ;
+    swap meta-c active-variable
+    unify-effect meta-c set drop ;
 
 : unify-effects ( seq -- )
     dup datastack-effect dup callstack-effect
@@ -65,7 +65,7 @@ namespaces parser prettyprint sequences strings vectors words ;
     [ [ dataflow-graph get ] bind ] map ;
 
 : copy-inference ( -- )
-    meta-r [ clone ] change
+    meta-c [ clone ] change
     meta-d [ clone ] change
     d-in [ ] change
     dataflow-graph off
@@ -73,7 +73,7 @@ namespaces parser prettyprint sequences strings vectors words ;
 
 : infer-branch ( value -- namespace )
     #! Return a namespace with inferencer variables:
-    #! meta-d, meta-r, d-in. They are set to f if
+    #! meta-d, meta-c, d-in. They are set to f if
     #! terminate was called.
     [
         [

library/compiler/inference/dataflow.factor

@@ -34,7 +34,7 @@ M: node = eq? ;
 : meta-d-node meta-d get clone in-node ;
 
 : d-tail ( n -- list ) meta-d get tail* ;
-: r-tail ( n -- list ) meta-r get tail* ;
+: c-tail ( n -- list ) meta-c get tail* ;
 
 : node-child node-children first ;
 
@@ -97,12 +97,12 @@ C: #declare make-node ;
 
 : node-inputs ( d-count r-count node -- )
     tuck
-    >r r-tail r> set-node-in-r
+    >r c-tail r> set-node-in-r
     >r d-tail r> set-node-in-d ;
 
 : node-outputs ( d-count r-count node -- )
     tuck
-    >r r-tail r> set-node-out-r
+    >r c-tail r> set-node-out-r
     >r d-tail r> set-node-out-d ;
 
 ! Variable holding dataflow graph being built.

library/compiler/inference/inference.factor

@@ -15,7 +15,7 @@ SYMBOL: base-case-continuation
 TUPLE: inference-error message rstate data-stack call-stack ;
 
 : inference-error ( msg -- )
-    recursive-state get meta-d get meta-r get
+    recursive-state get meta-d get meta-c get
     <inference-error> throw ;
 
 M: inference-error error. ( error -- )
@@ -64,7 +64,7 @@ SYMBOL: terminated?
 
 : init-inference ( recursive-state -- )
     terminated? off
-    V{ } clone meta-r set
+    V{ } clone meta-c set
     V{ } clone meta-d set
     0 d-in set
     recursive-state set

library/kernel.factor

@@ -23,7 +23,7 @@ M: object clone ;
 
 : set-boot ( quot -- ) 8 setenv ;
 
-: num-types ( -- n ) 20 ; inline
+: num-types ( -- n ) 19 ; inline
 
 : ? ( cond t f -- t/f ) rot [ drop ] [ nip ] if ; inline
 

library/test/continuations.factor

@@ -5,15 +5,17 @@ USE: math
 USE: namespaces
 USE: io
 USE: test
+USE: sequences
+USE: vectors
 
 : (callcc1-test)
-    swap 1- tuck swons
+    swap 1- tuck swap ?push
     over 0 = [ "test-cc" get continue-with ] when
     (callcc1-test) ;
 
 : callcc1-test ( x -- list )
     [
-        "test-cc" set [ ] (callcc1-test)
+        "test-cc" set V{ } clone (callcc1-test)
     ] callcc1 nip ;
 
 : callcc-namespace-test ( -- ? )
@@ -25,5 +27,5 @@ USE: test
         ] with-scope
     ] callcc0 "x" get 5 = ;
 
-[ t ] [ 10 callcc1-test 10 >list = ] unit-test
+[ t ] [ 10 callcc1-test 10 reverse >vector = ] unit-test
 [ t ] [ callcc-namespace-test ] unit-test

library/test/generic.factor

@@ -39,7 +39,7 @@ M: object sorting-test drop "object" ;
 [ "object" ] [ f sorting-test ] unit-test
 
 ! Testing unions
-UNION: funnies ratio complex ;
+UNION: funnies quotation ratio complex ;
 
 GENERIC: funny
 M: funnies funny drop 2 ;

library/test/init.factor

@@ -13,26 +13,3 @@ USE: hashtables
     
     [ "sdl.factor" ] [ "sdl.factor" cli-arg ] unit-test
 ] with-scope
-
-: traverse-path ( name object -- object )
-    dup hashtable? [ hash ] [ 2drop f ] if ;
-
-: (object-path) ( object list -- object )
-    [ uncons >r swap traverse-path r> (object-path) ] when* ;
-
-: object-path ( list -- object )
-    #! An object path is a list of strings. Each string is a
-    #! variable name in the object namespace at that level.
-    #! Returns f if any of the objects are not set.
-    namespace swap (object-path) ;
-
-[
-    5 [ "test" "object" "path" ] set-path
-    [ 5 ] [ [ "test" "object" "path" ] object-path ] unit-test
-
-    7 [ "test" "object" "pathe" ] set-path
-    [ 7 ] [ [ "test" "object" "pathe" ] object-path ] unit-test
-
-    9 [ "teste" "object" "pathe" ] set-path
-    [ 9 ] [ [ "teste" "object" "pathe" ] object-path ] unit-test
-] with-scope

library/test/interpreter.factor

@@ -1,18 +1,19 @@
+IN: temporary
 USING: errors interpreter io kernel lists math math-internals
 namespaces prettyprint sequences test ;
-IN: temporary
 
 : done-cf? ( -- ? ) meta-cf get not ;
-: done? ( -- ? ) done-cf? meta-r get length 0 = and ;
+: done? ( -- ? ) done-cf? meta-c get empty? and ;
 
 : run ( -- )
     done? [ next do run ] unless ;
 
 : init-interpreter ( -- )
-    V{ } clone meta-r set
     V{ } clone meta-d set
-    namestack meta-n set
-    catchstack meta-c set
+    V{ } clone meta-r set
+    V{ } clone meta-c set
+    namestack meta-name set
+    catchstack meta-catch set
     meta-cf off
     meta-executing off ;
 

library/tools/interpreter.factor

@@ -8,17 +8,21 @@ namespaces prettyprint sequences strings vectors words ;
 ! continuation to and from the primary interpreter. Used by
 ! compiler for partial evaluation, also by the walker. 
 
-! Meta-stacks
-SYMBOL: meta-r
-: push-r meta-r get push ;
-: pop-r meta-r get pop ;
-: peek-r meta-r get peek ;
+! Meta-stacks;
 SYMBOL: meta-d
 : push-d meta-d get push ;
 : pop-d meta-d get pop ;
 : peek-d meta-d get peek ;
-SYMBOL: meta-n
+SYMBOL: meta-r
+: push-r meta-r get push ;
+: pop-r meta-r get pop ;
+: peek-r meta-r get peek ;
 SYMBOL: meta-c
+: push-c meta-c get push ;
+: pop-c meta-c get pop ;
+: peek-c meta-c get peek ;
+SYMBOL: meta-name
+SYMBOL: meta-catch
 
 ! Call frame
 SYMBOL: meta-cf
@@ -27,28 +31,34 @@ SYMBOL: meta-cf
 SYMBOL: meta-executing
 
 ! Callframe.
-: up ( -- ) pop-r meta-cf set  pop-r drop ;
+: up ( -- ) pop-c meta-cf set  pop-c drop ;
 
 : next ( -- obj )
     meta-cf get [ meta-cf [ uncons ] change ] [ up next ] if ;
 
 : meta-interp ( -- interp )
-    meta-d get meta-r get meta-n get meta-c get <continuation> ;
+    meta-d get meta-r get meta-c get
+    meta-name get meta-catch get <continuation> ;
 
 : set-meta-interp ( interp -- )
-    >continuation< meta-c set meta-n set meta-r set meta-d set ;
+    >continuation<
+    meta-catch set
+    meta-name set
+    meta-c set
+    meta-r set
+    meta-d set ;
 
 : host-word ( word -- )
     [
-        \ call push-r
-        [ continuation swap continue-with ] cons cons push-r
+        \ call push-c
+        [ continuation swap continue-with ] cons cons push-c
         meta-interp continue
     ] callcc1 set-meta-interp pop-d 2drop ;
 
 : meta-call ( quot -- )
     #! Note we do tail call optimization here.
     meta-cf [
-        [ meta-executing get push-r  push-r ] when*
+        [ meta-executing get push-c  push-c ] when*
     ] change ;
 
 GENERIC: do-1 ( object -- )

library/tools/walker.factor

@@ -7,12 +7,14 @@ vectors words ;
 
 : &s ( -- ) meta-d get stack. ;
 
-: meta-r*
-    [ meta-r get % meta-executing get , meta-cf get , ] { } make ;
+: &r ( -- ) meta-r get stack. ;
 
-: &r ( -- ) meta-r* stack. ;
+: meta-c*
+    [ meta-c get % meta-executing get , meta-cf get , ] { } make ;
 
-: &get ( var -- value ) meta-n get hash-stack ;
+: &c ( -- ) meta-c* stack. ;
+
+: &get ( var -- value ) meta-name get hash-stack ;
 
 : report ( -- ) meta-cf get . ;
 
@@ -21,10 +23,10 @@ vectors words ;
 : into ( -- ) next do report ;
 
 : end-walk ( -- )
-    \ call push-r meta-cf get push-r meta-interp continue ;
+    \ call push-c meta-cf get push-c meta-interp continue ;
 
 : walk-banner ( -- )
-    "&s &r show stepper stacks" print
+    "&s &r &c show stepper stacks" print
     "&get ( var -- value ) get stepper variable value" print
     "step -- single step over" print
     "into -- single step into" print
@@ -36,8 +38,16 @@ vectors words ;
     "walk " listener-prompt set ;
 
 : walk ( quot -- )
-    datastack dup pop* callstack namestack catchstack [
-        meta-c set meta-n set meta-r set meta-d set
+    datastack dup pop*
+    retainstack
+    callstack
+    namestack
+    catchstack [
+        meta-catch set
+        meta-name set
+        meta-c set
+        meta-r set
+        meta-d set
         meta-cf set
         meta-executing off
         set-walk-hooks