more fixes, fast fixnum branch intrinsics clean up, predicates over tuples are possib...

diff --git a/library/compiler/simplifier.factor b/library/compiler/simplifier.factor
index 17623e785c13b27bb0ff2ea49e329db5a003ac1c..d71a70c16d121f2f68a19265a00c134b3fc357e8 100644 (file)
--- a/library/compiler/simplifier.factor
+++ b/library/compiler/simplifier.factor
@@ -107,23 +107,17 @@ M: %immediate-d simplify-node ( linear vop -- linear ? )
     uncons >r dup vop-source swap vop-dest r> cdr
     uncons >r vop-label r> ;
 
-M: %fixnum<= simplify-node ( linear vop -- linear ? )
-    drop dup can-fast-branch? [
-        fast-branch-params >r
-        %jump-fixnum<= >r -1 %inc-d r>
+: make-fast-branch ( linear op -- linear ? )
+    >r dup can-fast-branch? [
+        fast-branch-params r> swap >r
+        execute >r -1 %inc-d r>
         r> cons cons t
     ] [
-        f
+        r> drop f
     ] ifte ;
 
-M: %eq? simplify-node ( linear vop -- linear ? )
-    drop dup can-fast-branch? [
-        fast-branch-params >r
-        %jump-eq? >r -1 %inc-d r>
-        r> cons cons t
-    ] [
-        f
-    ] ifte ;
+M: fast-branch simplify-node ( linear vop -- linear ? )
+    class fast-branch make-fast-branch ;
 
 : find-label ( label -- rest )
     simplifying get [
@@ -174,7 +168,8 @@ M: %call-label simplify-node ( linear vop -- ? )
 
 : useless-jump ( linear -- linear ? )
     #! A jump to a label immediately following is not needed.
-    dup car cdr find-label over cdr eq? [ cdr t ] [ f ] ifte ;
+    dup car vop-label find-label find-label
+    over cdr eq? [ cdr t ] [ f ] ifte ;
 
 : (dead-code) ( linear -- linear ? )
     #! Remove all nodes until the next #label.
@@ -200,31 +195,27 @@ M: %jump-label simplify-node ( linear vop -- linear ? )
             t
         ] [
             \ %jump dup double-jump
-            ! [
-            !     t
-            ! ] [
-            !     useless-jump [
-            !         t
-            !     ] [
-            !         dead-code
-            !     ] ifte
-            ! ] ifte
+            [
+                t
+            ] [
+                useless-jump [
+                    t
+                ] [
+                    dead-code
+                ] ifte
+            ] ifte
         ] ifte
     ] ifte ;
-! 
-! #jump-label [
-!     [ #return #return double-jump ]
-!     [ #jump-label #jump-label double-jump ]
-!     [ #jump #jump double-jump ]
-!     [ useless-jump ]
-!     [ dead-code ]
-! ] "simplifiers" set-word-prop
-! 
-! #target-label [
-!     [ #target-label #jump-label double-jump ]
-! !   [ #target #jump double-jump ]
-! ] "simplifiers" set-word-prop
-! 
-! #jump [ [ dead-code ] ] "simplifiers" set-word-prop
-! #return [ [ dead-code ] ] "simplifiers" set-word-prop
-! #end-dispatch [ [ dead-code ] ] "simplifiers" set-word-prop
+
+M: %target-label simplify-node ( linear vop -- linear ? )
+    drop
+    \ %target-label \ %jump-label double-jump ;
+
+M: %jump simplify-node ( linear vop -- linear ? )
+    drop dead-code ;
+
+M: %return simplify-node ( linear vop -- linear ? )
+    drop dead-code ;
+
+M: %end-dispatch simplify-node ( linear vop -- linear ? )
+    drop dead-code ;

diff --git a/library/compiler/vops.factor b/library/compiler/vops.factor
index ba2759e508c47a18c014486dfd53e810c9f56f38..8e9a75cf849e005df03fe7e15a5576731044a6d7 100644 (file)
--- a/library/compiler/vops.factor
+++ b/library/compiler/vops.factor
@@ -180,6 +180,11 @@ VOP: %jump-eq?      : %jump-eq? f swap <%jump-eq?> ;
         [[ %eq?      %jump-eq?      ]]
     }} hash ;
 
+PREDICATE: tuple fast-branch
+    #! Class of VOPs whose class is a key in fast-branch
+    #! hashtable.
+    class fast-branch ;
+
 ! some slightly optimized inline assembly
 VOP: %type
 : %type ( vreg ) <vreg> dest-vop <%type> ;

diff --git a/library/generic/predicate.factor b/library/generic/predicate.factor
index 7255472b0c99328a90f012c27e3e31e916d34278..b3bacd0c7e23a373d171ae274b0d7cf56140890a 100644 (file)
--- a/library/generic/predicate.factor
+++ b/library/generic/predicate.factor
@@ -31,7 +31,7 @@ predicate [
     ] each 2drop 2drop
 ] "add-method" set-word-prop
 
-predicate 25 "priority" set-word-prop
+predicate 5 "priority" set-word-prop
 
 predicate [
     2dup = [

diff --git a/library/test/tuple.factor b/library/test/tuple.factor
index 34afdac24331b2a4f4c47f4db7dcd799157bae69..7f158d1288e5ac951a1071510b7b87ca88aa5e29 100644 (file)
--- a/library/test/tuple.factor
+++ b/library/test/tuple.factor
@@ -56,3 +56,14 @@ TUPLE: predicate-test ;
 : predicate-test drop f ;
 
 [ t ] [ <predicate-test> predicate-test? ] unit-test
+
+PREDICATE: tuple silly-pred
+    class \ rect = ;
+
+GENERIC: area
+M: silly-pred area dup rect-w swap rect-h * ;
+
+TUPLE: circle radius ;
+M: circle area circle-radius sq pi * ;
+
+[ 200 ] [ << rect f 0 0 10 20 >> area ] unit-test