a few regression fixes

TODO.FACTOR.txt

@@ -1,6 +1,6 @@
 - reader syntax for arrays, byte arrays, displaced aliens
 - out of memory error when printing global namespace
-- decompile is broken
+- removing unneeded #label
 
 + ui:
 
@@ -49,6 +49,7 @@
 - value type structs
 - bitfields in C structs
 - setting struct members that are not *
+- callbacks
 
 + compiler:
 

library/compiler/compiler.factor

@@ -50,8 +50,7 @@ M: compound (compile) ( word -- )
 
 : decompile ( word -- )
     dup compiled? [
-        "Decompiling " write dup .
+        "Decompiling " write dup . update-xt
-        [ word-primitive ] keep set-word-primitive
     ] [
         drop
     ] ifte ;

library/compiler/intrinsics.factor

@@ -201,7 +201,7 @@ sequences vectors words ;
 
 \ fixnum* [
     ! Turn multiplication by a power of two into a left shift.
-    dup node-peek dup literal-fixnum? [
+    dup node-peek dup literal-immediate? [
         literal-value dup power-of-2? [
             nip fast-fixnum*
         ] [

library/compiler/simplifier.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2004, 2005 Slava Pestov.
 ! See http://factor.sf.net/license.txt for BSD license.
 IN: compiler-backend
-USING: generic inference kernel lists math namespaces
+USING: generic kernel lists math namespaces
 prettyprint sequences strings words ;
 
 ! A peephole optimizer operating on the linear IR.

library/inference/optimizer.factor

@@ -82,20 +82,23 @@ M: #return optimize-node* ( node -- node/t )
     optimize-fold ;
 
 ! #label
-GENERIC: calls-label? ( label node -- ? )
+GENERIC: calls-label* ( label node -- ? )
 
-M: node calls-label? 2drop f ;
+M: node calls-label* 2drop f ;
 
-M: #call-label calls-label? node-param eq? ;
+M: #call-label calls-label* node-param eq? ;
 
-M: #label optimize-node* ( node -- node/t )
+: calls-label? ( label node -- ? )
-    dup node-param over node-children first calls-label? [
+    [ calls-label? not ] all-nodes-with? not ;
-        drop t
+
-    ] [
+! M: #label optimize-node* ( node -- node/t )
-        dup node-children first dup node-successor [
+!     dup node-param over node-children first calls-label? [
-            dup penultimate-node rot
+!         drop t
-            node-successor swap set-node-successor
+!     ] [
-        ] [
+!         dup node-children first dup node-successor [
-            drop node-successor
+!             dup penultimate-node rot
-        ] ifte
+!             node-successor swap set-node-successor
-    ] ifte ;
+!         ] [
+!             drop node-successor
+!         ] ifte
+!     ] ifte ;

library/test/gadgets/gradients.factor

@@ -1,22 +1,17 @@
 IN: temporary
 USING: gadgets namespaces styles test ;
 
-[
+[ { 255 0 0 } ] [ { 1 0 0 } red green <gradient> 0 gradient-color ] unit-test
-    0 x set
+[ { 0 255 0 } ] [ { 1 0 0 } red green <gradient> 1 gradient-color ] unit-test
-    0 y set
+
-    
+[ 0 100 0 { 255 0 0 } ]
-    [ { 255 0 0 } ] [ { 1 0 0 } red green <gradient> 0 gradient-color ] unit-test
+[ { 0 1 0 } red green <gradient> { 100 200 0 } 0 (gradient-x) ] unit-test
-    [ { 0 255 0 } ] [ { 1 0 0 } red green <gradient> 1 gradient-color ] unit-test
+
-    
+[ 0 100 100 { 255/2 255/2 0 } ]
-    [ 0 100 0 { 255 0 0 } ]
+[ { 0 1 0 } red green <gradient> { 100 200 0 } 100 (gradient-x) ] unit-test
-    [ { 0 1 0 } red green <gradient> { 100 200 0 } 0 (gradient-x) ] unit-test
+
-    
+[ 0 0 200 { 255 0 0 } ]
-    [ 0 100 100 { 255/2 255/2 0 } ]
+[ { 1 0 0 } red green <gradient> { 100 200 0 } 0 (gradient-y) ] unit-test
-    [ { 0 1 0 } red green <gradient> { 100 200 0 } 100 (gradient-x) ] unit-test
+
-    
+[ 50 0 200 { 255/2 255/2 0 } ]
-    [ 0 0 200 { 255 0 0 } ]
+[ { 1 0 0 } red green <gradient> { 100 200 0 } 50 (gradient-y) ] unit-test
-    [ { 1 0 0 } red green <gradient> { 100 200 0 } 0 (gradient-y) ] unit-test
-    
-    [ 50 0 200 { 255/2 255/2 0 } ]
-    [ { 1 0 0 } red green <gradient> { 100 200 0 } 50 (gradient-y) ] unit-test
-] with-scope

library/test/inspector.factor

@@ -1,11 +1,14 @@
 IN: temporary
-USING: inspector math namespaces prettyprint test ;
+USING: kernel inspector math namespaces prettyprint test
+sequences ;
 
-[[ "hello" "world" ]] inspect
+{ } clone inspector-stack set
 
-[ "hello" ] [ 0 get ] unit-test
+[[ "hello" "world" ]] (inspect)
-[ "world" ] [ 1 get ] unit-test
 
-[ 1 2 3 ] inspect
+[ "hello" ] [ 0 inspector-slots get nth ] unit-test
-f inspect
+[ "world" ] [ 1 inspector-slots get nth ] unit-test
-\ + inspect
+
+[ 1 2 3 ] (inspect)
+f (inspect)
+\ + (inspect)

library/test/lists/namespaces.factor

@@ -32,10 +32,3 @@ USE: sequences
     "hello" "x" unique@
     "x" get
 ] unit-test
-
-[ [ "xyz" #{ 3 2 }# 1/5 [ { } ] ] ] [
-    [ "xyz" , "xyz" unique,
-    #{ 3 2 }# , #{ 3 2 }# unique,
-    1/5 , 1/5 unique,
-    [ { } unique, ] [ ] make , ] [ ] make
-] unit-test

library/test/redefine.factor

@@ -1,7 +1,5 @@
 IN: temporary
-USING: compiler inference math generic parser ;
+USING: compiler inference math generic parser test ;
-
-USE: test
 
 : foo 1 2 ;
 : bar foo foo ; compiled

library/test/strings.factor

@@ -73,7 +73,7 @@ unit-test
 
 [ f ] [ [ 0 10 "hello" subseq ] [ not ] catch ] unit-test
 
-[ [ "hell" "o wo" "rld" ] ] [ 4 "hello world" group ] unit-test
+[ { "hell" "o wo" "rld" } ] [ 4 "hello world" group ] unit-test
 
 [ 4 ] [
     0 "There are Four Upper Case characters"