Merge branch 'master' of git://factorcode.org/git/factor

Conflicts:
	basis/tools/deploy/shaker/shaker.factor

diff --git a/basis/compiler/tree/propagation/transforms/transforms.factor b/basis/compiler/tree/propagation/transforms/transforms.factor
index da3bd58f74da06478f1cfb24cadd54c8828b7ea7..0077d0f1231b90af01b9da143d701d4b4e0a6841 100644 (file)
--- a/basis/compiler/tree/propagation/transforms/transforms.factor
+++ b/basis/compiler/tree/propagation/transforms/transforms.factor
@@ -103,13 +103,10 @@ IN: compiler.tree.propagation.transforms
 
 ! Speeds up 2^
 : 2^? ( #call -- ? )
-    in-d>> first2 [ value-info ] bi@
-    [ { [ literal>> 1 = ] [ class>> fixnum class<= ] } 1&& ]
-    [ class>> fixnum class<= ]
-    bi* and ;
+    in-d>> first value-info literal>> 1 eq? ;
 
 \ shift [
-     2^? [
+    2^? [
         cell-bits tag-bits get - 1 -
         '[
             >fixnum dup 0 < [ 2drop 0 ] [

diff --git a/basis/io/backend/unix/unix.factor b/basis/io/backend/unix/unix.factor
index 1797edccf61b8e4e9564bce0466bddb46ff382ad..39f0a5fec381bd1d2e2bebfbc41a0017ce74bcee 100644 (file)
--- a/basis/io/backend/unix/unix.factor
+++ b/basis/io/backend/unix/unix.factor
@@ -22,10 +22,6 @@ TUPLE: fd < disposable fd ;
     ] with-destructors ;
 
 : <fd> ( n -- fd )
-    #! We drop the error code rather than calling io-error,
-    #! since on OS X 10.3, this operation fails from init-io
-    #! when running the Factor.app (presumably because fd 0 and
-    #! 1 are closed).
     fd new-disposable swap >>fd ;
 
 M: fd dispose
@@ -197,5 +193,5 @@ TUPLE: mx-port < port mx ;
         [ drop 0 ] [ (io-error) ] if
     ] when ;
 
-: ?flag ( n mask symbol -- n )
-    pick rot bitand 0 > [ , ] [ drop ] if ;
+:: ?flag ( n mask symbol -- n )
+    n mask bitand 0 > [ symbol , ] when n ;

diff --git a/basis/io/directories/unix/linux/linux.factor b/basis/io/directories/unix/linux/linux.factor
index 932cbe230b85262286ca34185c5e8ed7c0125314..3d69c5f8908b8d874cb7aa3c92bb7e5d39fa844d 100644 (file)
--- a/basis/io/directories/unix/linux/linux.factor
+++ b/basis/io/directories/unix/linux/linux.factor
@@ -4,7 +4,7 @@ USING: alien.c-types io.directories.unix kernel system unix
 classes.struct unix.ffi ;
 IN: io.directories.unix.linux
 
-M: unix find-next-file ( DIR* -- dirent )
+M: linux find-next-file ( DIR* -- dirent )
     dirent <struct>
     f <void*>
     [ [ readdir64_r ] unix-system-call 0 = [ (io-error) ] unless ] 2keep

diff --git a/basis/io/styles/styles.factor b/basis/io/styles/styles.factor
index ae493be8490c26f97c741246ece4a79625d30663..d4e1d2c557a4df20e7382a0a7c2be2b3c79fc690 100644 (file)
--- a/basis/io/styles/styles.factor
+++ b/basis/io/styles/styles.factor
@@ -163,9 +163,3 @@ M: input summary
 : write-object ( str obj -- ) presented associate format ;
 
 : write-image ( image -- ) [ "" ] dip image associate format ;
-
-SYMBOL: stack-effect-style
-H{
-    { foreground COLOR: FactorDarkGreen }
-    { font-style plain }
-} stack-effect-style set-global

diff --git a/basis/math/bitwise/bitwise.factor b/basis/math/bitwise/bitwise.factor
index 204f2959447ac0e1e7ef4a56d99620f2abc1935c..6b301fa97bf071ca3eae841c015a5d12355bbead 100644 (file)
--- a/basis/math/bitwise/bitwise.factor
+++ b/basis/math/bitwise/bitwise.factor
@@ -99,7 +99,7 @@ M: bignum (bit-count)
     ] if ;
 
 : byte-array-bit-count ( byte-array -- n )
-    0 [ byte-bit-count + ] reduce ;
+    0 [ byte-bit-count + ] reduce ; inline
 
 PRIVATE>
 

diff --git a/basis/prettyprint/stylesheet/stylesheet.factor b/basis/prettyprint/stylesheet/stylesheet.factor
index 42a701d60f6639ad5e5068433a2b20fe70efaf85..bd25438b7499beea450244f356bdac0d133c06f1 100644 (file)
--- a/basis/prettyprint/stylesheet/stylesheet.factor
+++ b/basis/prettyprint/stylesheet/stylesheet.factor
@@ -42,5 +42,12 @@ PRIVATE>
 : vocab-style ( vocab -- style )
     dim-color colored-presentation-style ;
 
+SYMBOL: stack-effect-style
+
+H{
+    { foreground COLOR: FactorDarkGreen }
+    { font-style plain }
+} stack-effect-style set-global
+
 : effect-style ( effect -- style )
     presented associate stack-effect-style get assoc-union ;

diff --git a/basis/tools/deploy/shaker/shaker.factor b/basis/tools/deploy/shaker/shaker.factor
index f8c3b3b0319c1cfd2b796606d4e49ca4b1f3bc86..d8a653c02139d927edacaf954d287a9944b153be 100755 (executable)
--- a/basis/tools/deploy/shaker/shaker.factor
+++ b/basis/tools/deploy/shaker/shaker.factor
@@ -7,7 +7,7 @@ sequences.private words memory kernel.private continuations io
 vocabs.loader system strings sets vectors quotations byte-arrays
 sorting compiler.units definitions generic generic.standard
 generic.single tools.deploy.config combinators classes
-classes.builtin slots.private grouping command-line ;
+classes.builtin slots.private grouping command-line io.pathnames ;
 QUALIFIED: bootstrap.stage2
 QUALIFIED: classes.private
 QUALIFIED: compiler.crossref
@@ -48,7 +48,6 @@ IN: tools.deploy.shaker
     ] when
     strip-dictionary? [
         {
-            ! "compiler.units"
             "vocabs"
             "vocabs.cache"
             "source-files.errors"
@@ -293,6 +292,9 @@ IN: tools.deploy.shaker
             input-stream
             output-stream
             error-stream
+            vm
+            image
+            current-directory
         } %
 
         "io-thread" "io.thread" lookup ,

diff --git a/core/classes/classes-tests.factor b/core/classes/classes-tests.factor
index 10a5f674bd8fabfc68f50f8b38ddaa0c525b0c07..2b02d7c5a18363c9f650d065698f1b3f988682e7 100644 (file)
--- a/core/classes/classes-tests.factor
+++ b/core/classes/classes-tests.factor
@@ -119,3 +119,9 @@ TUPLE: forgotten-predicate-test ;
 
 [ ] [ [ \ forgotten-predicate-test forget ] with-compilation-unit ] unit-test
 [ f ] [ \ forgotten-predicate-test? predicate? ] unit-test
+
+GENERIC: generic-predicate? ( a -- b )
+
+[ ] [ "IN: classes.tests TUPLE: generic-predicate ;" eval( -- ) ] unit-test
+
+[ f ] [ \ generic-predicate? generic? ] unit-test

diff --git a/core/classes/classes.factor b/core/classes/classes.factor
index 6d68ad7fb4ef5a02d2a13f1d4679215d82718f04..28f0b192ee209dba6d286f4d6dc8d554349e75de 100644 (file)
--- a/core/classes/classes.factor
+++ b/core/classes/classes.factor
@@ -59,14 +59,15 @@ PRIVATE>
 
 : classes ( -- seq ) implementors-map get keys ;
 
+PREDICATE: predicate < word "predicating" word-prop >boolean ;
+
 : create-predicate-word ( word -- predicate )
-    [ name>> "?" append ] [ vocabulary>> ] bi create ;
+    [ name>> "?" append ] [ vocabulary>> ] bi create
+    dup predicate? [ dup reset-generic ] unless ;
 
 : predicate-word ( word -- predicate )
     "predicate" word-prop first ;
 
-PREDICATE: predicate < word "predicating" word-prop >boolean ;
-
 M: predicate flushable? drop t ;
 
 M: predicate forget*

diff --git a/core/classes/tuple/tuple-tests.factor b/core/classes/tuple/tuple-tests.factor
index f452d8fb28b8ddaec6a80898eea6b244e84bcc1e..36d402c61dbec55d849e9b42a50bc566c07c025f 100644 (file)
--- a/core/classes/tuple/tuple-tests.factor
+++ b/core/classes/tuple/tuple-tests.factor
@@ -764,3 +764,9 @@ DEFER: factor-crashes-anymore
 ] unit-test
 
 [ 31337 ] [ factor-crashes-anymore ] unit-test
+
+TUPLE: tuple-predicate-redefine-test ;
+
+[ ] [ "IN: classes.tuple.tests TUPLE: tuple-predicate-redefine-test ;" eval( -- ) ] unit-test
+
+[ t ] [ \ tuple-predicate-redefine-test? predicate? ] unit-test

diff --git a/extra/mason/source/source.factor b/extra/mason/source/source.factor
index 3a3d6a66b77c3384f6dad73c500d73d702e67f41..72c63660e310af3df1baa847eb29c35703fa3bb1 100644 (file)
--- a/extra/mason/source/source.factor
+++ b/extra/mason/source/source.factor
@@ -8,11 +8,17 @@ IN: mason.source
 : clone-factor ( -- )
     { "git" "clone" } home "factor" append-path suffix try-process ;
 
+: save-git-id ( -- )
+    git-id "git-id" to-file ;
+
+: delete-git-tree ( -- )
+    ".git" delete-tree ;
+
+: download-images ( -- )
+    images [ download-image ] each ;
+
 : prepare-source ( -- )
-    "factor" [
-        ".git" delete-tree
-        images [ download-image ] each
-    ] with-directory ;
+    "factor" [ save-git-id delete-git-tree download-images ] with-directory ;
 
 : package-name ( version -- string )
     "factor-src-" ".zip" surround ;