Merge branch 'master' of git://factorcode.org/git/factor
Conflicts: basis/tools/deploy/shaker/shaker.factordb4
commit
f06e278e17
|
@ -103,13 +103,10 @@ IN: compiler.tree.propagation.transforms
|
||||||
|
|
||||||
! Speeds up 2^
|
! Speeds up 2^
|
||||||
: 2^? ( #call -- ? )
|
: 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 [
|
\ shift [
|
||||||
2^? [
|
2^? [
|
||||||
cell-bits tag-bits get - 1 -
|
cell-bits tag-bits get - 1 -
|
||||||
'[
|
'[
|
||||||
>fixnum dup 0 < [ 2drop 0 ] [
|
>fixnum dup 0 < [ 2drop 0 ] [
|
||||||
|
|
|
@ -22,10 +22,6 @@ TUPLE: fd < disposable fd ;
|
||||||
] with-destructors ;
|
] with-destructors ;
|
||||||
|
|
||||||
: <fd> ( n -- fd )
|
: <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 ;
|
fd new-disposable swap >>fd ;
|
||||||
|
|
||||||
M: fd dispose
|
M: fd dispose
|
||||||
|
@ -197,5 +193,5 @@ TUPLE: mx-port < port mx ;
|
||||||
[ drop 0 ] [ (io-error) ] if
|
[ drop 0 ] [ (io-error) ] if
|
||||||
] when ;
|
] when ;
|
||||||
|
|
||||||
: ?flag ( n mask symbol -- n )
|
:: ?flag ( n mask symbol -- n )
|
||||||
pick rot bitand 0 > [ , ] [ drop ] if ;
|
n mask bitand 0 > [ symbol , ] when n ;
|
||||||
|
|
|
@ -4,7 +4,7 @@ USING: alien.c-types io.directories.unix kernel system unix
|
||||||
classes.struct unix.ffi ;
|
classes.struct unix.ffi ;
|
||||||
IN: io.directories.unix.linux
|
IN: io.directories.unix.linux
|
||||||
|
|
||||||
M: unix find-next-file ( DIR* -- dirent )
|
M: linux find-next-file ( DIR* -- dirent )
|
||||||
dirent <struct>
|
dirent <struct>
|
||||||
f <void*>
|
f <void*>
|
||||||
[ [ readdir64_r ] unix-system-call 0 = [ (io-error) ] unless ] 2keep
|
[ [ readdir64_r ] unix-system-call 0 = [ (io-error) ] unless ] 2keep
|
||||||
|
|
|
@ -163,9 +163,3 @@ M: input summary
|
||||||
: write-object ( str obj -- ) presented associate format ;
|
: write-object ( str obj -- ) presented associate format ;
|
||||||
|
|
||||||
: write-image ( image -- ) [ "" ] dip image 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
|
|
||||||
|
|
|
@ -99,7 +99,7 @@ M: bignum (bit-count)
|
||||||
] if ;
|
] if ;
|
||||||
|
|
||||||
: byte-array-bit-count ( byte-array -- n )
|
: byte-array-bit-count ( byte-array -- n )
|
||||||
0 [ byte-bit-count + ] reduce ;
|
0 [ byte-bit-count + ] reduce ; inline
|
||||||
|
|
||||||
PRIVATE>
|
PRIVATE>
|
||||||
|
|
||||||
|
|
|
@ -42,5 +42,12 @@ PRIVATE>
|
||||||
: vocab-style ( vocab -- style )
|
: vocab-style ( vocab -- style )
|
||||||
dim-color colored-presentation-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 )
|
: effect-style ( effect -- style )
|
||||||
presented associate stack-effect-style get assoc-union ;
|
presented associate stack-effect-style get assoc-union ;
|
||||||
|
|
|
@ -7,7 +7,7 @@ sequences.private words memory kernel.private continuations io
|
||||||
vocabs.loader system strings sets vectors quotations byte-arrays
|
vocabs.loader system strings sets vectors quotations byte-arrays
|
||||||
sorting compiler.units definitions generic generic.standard
|
sorting compiler.units definitions generic generic.standard
|
||||||
generic.single tools.deploy.config combinators classes
|
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: bootstrap.stage2
|
||||||
QUALIFIED: classes.private
|
QUALIFIED: classes.private
|
||||||
QUALIFIED: compiler.crossref
|
QUALIFIED: compiler.crossref
|
||||||
|
@ -48,7 +48,6 @@ IN: tools.deploy.shaker
|
||||||
] when
|
] when
|
||||||
strip-dictionary? [
|
strip-dictionary? [
|
||||||
{
|
{
|
||||||
! "compiler.units"
|
|
||||||
"vocabs"
|
"vocabs"
|
||||||
"vocabs.cache"
|
"vocabs.cache"
|
||||||
"source-files.errors"
|
"source-files.errors"
|
||||||
|
@ -293,6 +292,9 @@ IN: tools.deploy.shaker
|
||||||
input-stream
|
input-stream
|
||||||
output-stream
|
output-stream
|
||||||
error-stream
|
error-stream
|
||||||
|
vm
|
||||||
|
image
|
||||||
|
current-directory
|
||||||
} %
|
} %
|
||||||
|
|
||||||
"io-thread" "io.thread" lookup ,
|
"io-thread" "io.thread" lookup ,
|
||||||
|
|
|
@ -119,3 +119,9 @@ TUPLE: forgotten-predicate-test ;
|
||||||
|
|
||||||
[ ] [ [ \ forgotten-predicate-test forget ] with-compilation-unit ] unit-test
|
[ ] [ [ \ forgotten-predicate-test forget ] with-compilation-unit ] unit-test
|
||||||
[ f ] [ \ forgotten-predicate-test? predicate? ] 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
|
||||||
|
|
|
@ -59,14 +59,15 @@ PRIVATE>
|
||||||
|
|
||||||
: classes ( -- seq ) implementors-map get keys ;
|
: classes ( -- seq ) implementors-map get keys ;
|
||||||
|
|
||||||
|
PREDICATE: predicate < word "predicating" word-prop >boolean ;
|
||||||
|
|
||||||
: create-predicate-word ( word -- predicate )
|
: 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 ( word -- predicate )
|
||||||
"predicate" word-prop first ;
|
"predicate" word-prop first ;
|
||||||
|
|
||||||
PREDICATE: predicate < word "predicating" word-prop >boolean ;
|
|
||||||
|
|
||||||
M: predicate flushable? drop t ;
|
M: predicate flushable? drop t ;
|
||||||
|
|
||||||
M: predicate forget*
|
M: predicate forget*
|
||||||
|
|
|
@ -764,3 +764,9 @@ DEFER: factor-crashes-anymore
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
||||||
[ 31337 ] [ 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
|
||||||
|
|
|
@ -8,11 +8,17 @@ IN: mason.source
|
||||||
: clone-factor ( -- )
|
: clone-factor ( -- )
|
||||||
{ "git" "clone" } home "factor" append-path suffix try-process ;
|
{ "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 ( -- )
|
: 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 )
|
: package-name ( version -- string )
|
||||||
"factor-src-" ".zip" surround ;
|
"factor-src-" ".zip" surround ;
|
||||||
|
|
Loading…
Reference in New Issue