From 4266023639c0912afe93511953e32f4e53053ba1 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 15 Feb 2010 17:54:19 +1300 Subject: [PATCH 1/6] tools.deploy.shaker: strip out vm, image, current-directory to avoid leaking information from build environment --- basis/tools/deploy/shaker/shaker.factor | 16 +++++++++------- 1 file changed, 9 insertions(+), 7 deletions(-) diff --git a/basis/tools/deploy/shaker/shaker.factor b/basis/tools/deploy/shaker/shaker.factor index e5dddc5fe6..1060853343 100755 --- a/basis/tools/deploy/shaker/shaker.factor +++ b/basis/tools/deploy/shaker/shaker.factor @@ -1,11 +1,11 @@ ! Copyright (C) 2007, 2010 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: arrays accessors io.backend io.streams.c init fry -namespaces math make assocs kernel parser parser.notes lexer -strings.parser vocabs sequences sequences.deep sequences.private -words memory kernel.private continuations io vocabs.loader -system strings sets vectors quotations byte-arrays sorting -compiler.units definitions generic generic.standard +USING: arrays accessors io.backend io.pathnames io.streams.c +init fry namespaces math make assocs kernel parser parser.notes +lexer strings.parser vocabs sequences sequences.deep +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 ; QUALIFIED: bootstrap.stage2 @@ -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 , From 3e5e3a6d3fb6800dc178afdf4eff4964951d6484 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 15 Feb 2010 18:34:45 +1300 Subject: [PATCH 2/6] classes: call reset-generic on predicate word to avoid redefinition problems (reported by littledan) --- core/classes/classes-tests.factor | 6 ++++++ core/classes/classes.factor | 3 ++- 2 files changed, 8 insertions(+), 1 deletion(-) diff --git a/core/classes/classes-tests.factor b/core/classes/classes-tests.factor index 10a5f674bd..2b02d7c5a1 100644 --- 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 6d68ad7fb4..a730636ca9 100644 --- a/core/classes/classes.factor +++ b/core/classes/classes.factor @@ -60,7 +60,8 @@ PRIVATE> : classes ( -- seq ) implementors-map get keys ; : create-predicate-word ( word -- predicate ) - [ name>> "?" append ] [ vocabulary>> ] bi create ; + [ name>> "?" append ] [ vocabulary>> ] bi + create dup reset-generic ; : predicate-word ( word -- predicate ) "predicate" word-prop first ; From 97428db9212ecf7866459fa266b3148fc933066e Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 15 Feb 2010 19:01:19 +1300 Subject: [PATCH 3/6] mason.source: save git-id in source packages, just like binary packages --- extra/mason/source/source.factor | 14 ++++++++++---- 1 file changed, 10 insertions(+), 4 deletions(-) diff --git a/extra/mason/source/source.factor b/extra/mason/source/source.factor index 3a3d6a66b7..72c63660e3 100644 --- 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 ; From cd1986a906e06d333859232d9e1fc890e38a2906 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 15 Feb 2010 23:46:55 +1300 Subject: [PATCH 4/6] classes: fix regression from recent bug fix --- core/classes/classes.factor | 8 ++++---- core/classes/tuple/tuple-tests.factor | 6 ++++++ 2 files changed, 10 insertions(+), 4 deletions(-) diff --git a/core/classes/classes.factor b/core/classes/classes.factor index a730636ca9..28f0b192ee 100644 --- a/core/classes/classes.factor +++ b/core/classes/classes.factor @@ -59,15 +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 dup reset-generic ; + [ 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 f452d8fb28..36d402c61d 100644 --- 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 From 64a37d2db6827239a355088356a6e5958953a0db Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 16 Feb 2010 01:03:09 +1300 Subject: [PATCH 5/6] compiler.tree.propagation.transforms: tweak 2^ transform to fix performance regression in benchmark.beust2; introduced by 47d6507548a7bcbcf27af29d3fa9df00ed4f6130 --- .../compiler/tree/propagation/transforms/transforms.factor | 7 ++----- 1 file changed, 2 insertions(+), 5 deletions(-) diff --git a/basis/compiler/tree/propagation/transforms/transforms.factor b/basis/compiler/tree/propagation/transforms/transforms.factor index da3bd58f74..0077d0f123 100644 --- 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 ] [ From 4893ebf183da449a4bac116e4dd9333d54aecc88 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 16 Feb 2010 04:04:09 +1300 Subject: [PATCH 6/6] Small cleanups --- basis/io/backend/unix/unix.factor | 8 ++------ basis/io/directories/unix/linux/linux.factor | 2 +- basis/io/styles/styles.factor | 6 ------ basis/math/bitwise/bitwise.factor | 2 +- basis/prettyprint/stylesheet/stylesheet.factor | 7 +++++++ 5 files changed, 11 insertions(+), 14 deletions(-) diff --git a/basis/io/backend/unix/unix.factor b/basis/io/backend/unix/unix.factor index 1797edccf6..39f0a5fec3 100644 --- a/basis/io/backend/unix/unix.factor +++ b/basis/io/backend/unix/unix.factor @@ -22,10 +22,6 @@ TUPLE: fd < disposable fd ; ] with-destructors ; : ( 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 932cbe230b..3d69c5f890 100644 --- 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 f [ [ 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 ae493be849..d4e1d2c557 100644 --- 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 204f295944..6b301fa97b 100644 --- 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 42a701d60f..bd25438b74 100644 --- 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 ;