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

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

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@
+    in-d>> first value-info literal>> 1 eq? ;
-    [ { [ literal>> 1 = ] [ class>> fixnum class<= ] } 1&& ]
-    [ class>> fixnum class<= ]
-    bi* and ;
 
 \ shift [
-     2^? [
+    2^? [
         cell-bits tag-bits get - 1 -
         '[
             >fixnum dup 0 < [ 2drop 0 ] [

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 )
+:: ?flag ( n mask symbol -- n )
-    pick rot bitand 0 > [ , ] [ drop ] if ;
+    n mask bitand 0 > [ symbol , ] when n ;

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

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

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>
 

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 ;

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 ,

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

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*

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

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" [
+    "factor" [ save-git-id delete-git-tree download-images ] with-directory ;
-        ".git" delete-tree
-        images [ download-image ] each
-    ] with-directory ;
 
 : package-name ( version -- string )
     "factor-src-" ".zip" surround ;