[ "ALIEN: 1234" ] [ 1234 <alien> unparse ] unit-test
[ ] [ 0 B{ 1 2 3 } <displaced-alien> drop ] unit-test
-[ ] [ 0 F{ 1 2 3 } <displaced-alien> drop ] unit-test
-[ ] [ 0 ?{ t f t } <displaced-alien> drop ] unit-test
[ 0 B{ 1 2 3 } <displaced-alien> alien-address ] must-fail
IN: assocs.tests
USING: kernel math namespaces tools.test vectors sequences
sequences.private hashtables io prettyprint assocs
-continuations ;
+continuations float-arrays ;
[ t ] [ H{ } dup assoc-subset? ] unit-test
[ f ] [ H{ { 1 3 } } H{ } assoc-subset? ] unit-test
+++ /dev/null
-Slava Pestov
+++ /dev/null
-USING: arrays help.markup help.syntax kernel
-kernel.private math prettyprint strings vectors sbufs ;
-IN: bit-arrays
-
-ARTICLE: "bit-arrays" "Bit arrays"
-"Bit array are a fixed-size mutable sequences (" { $link "sequence-protocol" } ") whose elements are either " { $link t } " or " { $link f } ". Each element only uses one bit of storage, hence the name. The literal syntax is covered in " { $link "syntax-bit-arrays" } "."
-$nl
-"Bit array words are in the " { $vocab-link "bit-arrays" } " vocabulary."
-$nl
-"Bit arrays play a special role in the C library interface; they can be used to pass binary data back and forth between Factor and C. See " { $link "c-byte-arrays" } "."
-$nl
-"Bit arrays form a class of objects:"
-{ $subsection bit-array }
-{ $subsection bit-array? }
-"Creating new bit arrays:"
-{ $subsection >bit-array }
-{ $subsection <bit-array> }
-"Efficiently setting and clearing all bits in a bit array:"
-{ $subsection set-bits }
-{ $subsection clear-bits }
-"Converting between unsigned integers and their binary representation:"
-{ $subsection integer>bit-array }
-{ $subsection bit-array>integer } ;
-
-ABOUT: "bit-arrays"
-
-HELP: bit-array
-{ $description "The class of fixed-length bit arrays. See " { $link "syntax-bit-arrays" } " for syntax and " { $link "bit-arrays" } " for general information." } ;
-
-HELP: <bit-array> ( n -- bit-array )
-{ $values { "n" "a non-negative integer" } { "bit-array" "a new " { $link bit-array } } }
-{ $description "Creates a new bit array with the given length and all elements initially set to " { $link f } "." } ;
-
-HELP: >bit-array
-{ $values { "seq" "a sequence" } { "bit-array" bit-array } }
-{ $description "Outputs a freshly-allocated bit array whose elements have the same boolean values as a given sequence." } ;
-
-HELP: clear-bits
-{ $values { "bit-array" bit-array } }
-{ $description "Sets all elements of the bit array to " { $link f } "." }
-{ $notes "Calling this word is more efficient than the following:"
- { $code "[ drop f ] change-each" }
-}
-{ $side-effects "bit-array" } ;
-
-HELP: set-bits
-{ $values { "bit-array" bit-array } }
-{ $description "Sets all elements of the bit array to " { $link t } "." }
-{ $notes "Calling this word is more efficient than the following:"
- { $code "[ drop t ] change-each" }
-}
-{ $side-effects "bit-array" } ;
-
-HELP: integer>bit-array
-{ $values { "integer" integer } { "bit-array" bit-array } }
-{ $description "Outputs a freshly-allocated bit array whose elements correspond to the bits in the binary representation of the given unsigned integer value." }
-{ $notes "The bits of the integer are stored in the resulting bit array in order of ascending significance, least significant bit first. This word will fail if passed a negative integer. If you want the two's-complement binary representation of a negative number, use " { $link bitnot } " to get the complement of the number first. This word works with fixnums or bignums of any size; it is not limited by fixnum size or machine word size." } ;
-
-HELP: bit-array>integer
-{ $values { "bit-array" bit-array } { "integer" integer } }
-{ $description "Outputs the unsigned integer whose binary representation corresponds to the contents of the given bit array." }
-{ $notes "The bits of the integer are taken from the bit array in order of ascending significance, least significant bit first. This word is able to return fixnums or bignums of any size; it is not limited by fixnum size or machine word size." } ;
+++ /dev/null
-USING: sequences arrays bit-arrays kernel tools.test math
-random ;
-IN: bit-arrays.tests
-
-[ 100 ] [ 100 <bit-array> length ] unit-test
-
-[
- { t f t }
-] [
- 3 <bit-array> t 0 pick set-nth t 2 pick set-nth
- >array
-] unit-test
-
-[
- { t f t }
-] [
- { t f t } >bit-array >array
-] unit-test
-
-[
- { t f t } { f t f }
-] [
- { t f t } >bit-array dup clone dup [ not ] change-each
- [ >array ] bi@
-] unit-test
-
-[
- { f f f f f }
-] [
- { t f t t f } >bit-array dup clear-bits >array
-] unit-test
-
-[
- { t t t t t }
-] [
- { t f t t f } >bit-array dup set-bits >array
-] unit-test
-
-[ t ] [
- 100 [
- drop 100 [ 2 random zero? ] replicate
- dup >bit-array >array =
- ] all?
-] unit-test
-
-[ ?{ f } ] [
- 1 2 { t f t f } <slice> >bit-array
-] unit-test
-
-[ ?{ t f t f f f } ] [ 6 ?{ t f t } resize-bit-array ] unit-test
-
-[ ?{ t t } ] [ 2 ?{ t t f t f t f t t t f t } resize-bit-array ] unit-test
-
-[ -10 ?{ } resize-bit-array ] must-fail
-
-[ -1 integer>bit-array ] must-fail
-[ ?{ f t } ] [ 2 integer>bit-array ] unit-test
-[ ?{ t t t t t t t t t } ] [ 511 integer>bit-array ] unit-test
-[ ?{
- t t t t t t t t t t t t t t t t t t t t t t t t t t t t t t t t
- t t t t t t t t t t t t t t t t t t t t t t t t t t t t t t t t
- t t t t t t t t t t t t t t t t t t t t t t t t t t t t t t t t
- t t t t t t t t t t t t t t t t t t t t t t t t t t t t t t t t
-} ] [
- HEX: ffffffffffffffffffffffffffffffff integer>bit-array
-] unit-test
-
-[ 14 ] [ ?{ f t t t } bit-array>integer ] unit-test
-[ HEX: ffffffffffffffffffffffffffffffff ] [ ?{
- t t t t t t t t t t t t t t t t t t t t t t t t t t t t t t t t
- t t t t t t t t t t t t t t t t t t t t t t t t t t t t t t t t
- t t t t t t t t t t t t t t t t t t t t t t t t t t t t t t t t
- t t t t t t t t t t t t t t t t t t t t t t t t t t t t t t t t
-} bit-array>integer ] unit-test
+++ /dev/null
-! Copyright (C) 2007, 2008 Slava Pestov.
-! See http://factorcode.org/license.txt for BSD license.
-USING: math alien.accessors kernel kernel.private sequences
-sequences.private ;
-IN: bit-arrays
-
-<PRIVATE
-
-: n>byte -3 shift ; inline
-
-: byte/bit ( n alien -- byte bit )
- over n>byte alien-unsigned-1 swap 7 bitand ; inline
-
-: set-bit ( ? byte bit -- byte )
- 2^ rot [ bitor ] [ bitnot bitand ] if ; inline
-
-: bits>cells 31 + -5 shift ; inline
-
-: (set-bits) ( bit-array n -- )
- over length bits>cells -rot [
- spin 4 * set-alien-unsigned-4
- ] 2curry each ; inline
-
-PRIVATE>
-
-M: bit-array length array-capacity ;
-
-M: bit-array nth-unsafe
- >r >fixnum r> byte/bit bit? ;
-
-M: bit-array set-nth-unsafe
- >r >fixnum r>
- [ byte/bit set-bit ] 2keep
- swap n>byte set-alien-unsigned-1 ;
-
-: clear-bits ( bit-array -- ) 0 (set-bits) ;
-
-: set-bits ( bit-array -- ) -1 (set-bits) ;
-
-M: bit-array clone (clone) ;
-
-: >bit-array ( seq -- bit-array ) ?{ } clone-like ; inline
-
-M: bit-array like drop dup bit-array? [ >bit-array ] unless ;
-
-M: bit-array new-sequence drop <bit-array> ;
-
-M: bit-array equal?
- over bit-array? [ sequence= ] [ 2drop f ] if ;
-
-M: bit-array resize
- resize-bit-array ;
-
-: integer>bit-array ( int -- bit-array )
- [ log2 1+ <bit-array> 0 ] keep
- [ dup zero? not ] [
- [ -8 shift ] [ 255 bitand ] bi
- -roll [ [ set-alien-unsigned-1 ] 2keep 1+ ] dip
- ] [ ] while
- 2drop ;
-
-: bit-array>integer ( bit-array -- int )
- dup >r length 7 + n>byte 0 r> [
- swap alien-unsigned-1 swap 8 shift bitor
- ] curry reduce ;
-
-INSTANCE: bit-array sequence
+++ /dev/null
-Fixed-size bit arrays
+++ /dev/null
-collections
TUPLE: boa-coercer-test { x array-capacity } ;
-[ fixnum ] [ 0 >bignum boa-coercer-test boa x>> ] unit-test
+[ fixnum ] [ 0 >bignum boa-coercer-test boa x>> class ] unit-test
USING: accessors arrays compiler.units kernel kernel.private math
math.constants math.private sequences strings tools.test words
continuations sequences.private hashtables.private byte-arrays
-strings.private system random layouts vectors.private
-sbufs.private strings.private slots.private alien math.order
+strings.private system random layouts vectors
+sbufs strings.private slots.private alien math.order
alien.accessors alien.c-types alien.syntax alien.strings
namespaces libc sequences.private io.encodings.ascii ;
IN: compiler.tests
+++ /dev/null
-Slava Pestov
+++ /dev/null
-USING: arrays bit-arrays vectors strings sbufs
-kernel help.markup help.syntax math ;
-IN: float-arrays
-
-ARTICLE: "float-arrays" "Float arrays"
-"Float arrays are fixed-size mutable sequences (" { $link "sequence-protocol" } ") whose elements are instances of " { $link float } ". Elements are unboxed, hence the memory usage is lower than an equivalent " { $link array } " of floats. The literal syntax is covered in " { $link "syntax-float-arrays" } "."
-$nl
-"Float array words are in the " { $vocab-link "float-arrays" } " vocabulary."
-$nl
-"Float arrays play a special role in the C library interface; they can be used to pass binary data back and forth between Factor and C. See " { $link "c-byte-arrays" } "."
-$nl
-"Float arrays form a class of objects."
-{ $subsection float-array }
-{ $subsection float-array? }
-"There are several ways to construct float arrays."
-{ $subsection >float-array }
-{ $subsection <float-array> }
-"Creating a float array from several elements on the stack:"
-{ $subsection 1float-array }
-{ $subsection 2float-array }
-{ $subsection 3float-array }
-{ $subsection 4float-array } ;
-
-ABOUT: "float-arrays"
-
-HELP: float-array
-{ $description "The class of float arrays. See " { $link "syntax-float-arrays" } " for syntax and " { $link "float-arrays" } " for general information." } ;
-
-HELP: <float-array> ( n initial -- float-array )
-{ $values { "n" "a non-negative integer" } { "initial" float } { "float-array" "a new float array" } }
-{ $description "Creates a new float array holding " { $snippet "n" } " floats with the specified initial element." } ;
-
-HELP: >float-array
-{ $values { "seq" "a sequence" } { "float-array" float-array } }
-{ $description "Outputs a freshly-allocated float array whose elements have the same floating-point values as a given sequence." }
-{ $errors "Throws an error if the sequence contains elements other than real numbers." } ;
-
-HELP: 1float-array
-{ $values { "x" object } { "array" float-array } }
-{ $description "Create a new float array with one element." } ;
-
-{ 1array 2array 3array 4array } related-words
-
-HELP: 2float-array
-{ $values { "x" object } { "y" object } { "array" float-array } }
-{ $description "Create a new float array with two elements, with " { $snippet "x" } " appearing first." } ;
-
-HELP: 3float-array
-{ $values { "x" object } { "y" object } { "z" object } { "array" float-array } }
-{ $description "Create a new float array with three elements, with " { $snippet "x" } " appearing first." } ;
-
-HELP: 4float-array
-{ $values { "w" object } { "x" object } { "y" object } { "z" object } { "array" float-array } }
-{ $description "Create a new float array with four elements, with " { $snippet "w" } " appearing first." } ;
+++ /dev/null
-IN: float-arrays.tests
-USING: float-arrays tools.test ;
-
-[ F{ 1.0 1.0 1.0 } ] [ 3 1.0 <float-array> ] unit-test
-
-[ F{ 1 2 3 0 0 0 } ] [ 6 F{ 1 2 3 } resize-float-array ] unit-test
-
-[ F{ 1 2 } ] [ 2 F{ 1 2 3 4 5 6 7 8 9 } resize-float-array ] unit-test
-
-[ -10 F{ } resize-float-array ] must-fail
+++ /dev/null
-! Copyright (C) 2007, 2008 Slava Pestov.
-! See http://factorcode.org/license.txt for BSD license.
-USING: kernel kernel.private alien.accessors sequences
-sequences.private math math.private ;
-IN: float-arrays
-
-<PRIVATE
-
-: float-array@ swap >fixnum 8 fixnum*fast ; inline
-
-PRIVATE>
-
-M: float-array clone (clone) ;
-M: float-array length array-capacity ;
-
-M: float-array nth-unsafe
- float-array@ alien-double ;
-
-M: float-array set-nth-unsafe
- >r >r >float r> r> float-array@ set-alien-double ;
-
-: >float-array ( seq -- float-array ) F{ } clone-like ; inline
-
-M: float-array like
- drop dup float-array? [ >float-array ] unless ;
-
-M: float-array new-sequence drop 0.0 <float-array> ;
-
-M: float-array equal?
- over float-array? [ sequence= ] [ 2drop f ] if ;
-
-M: float-array resize
- resize-float-array ;
-
-INSTANCE: float-array sequence
-
-: 1float-array ( x -- array ) 1 swap <float-array> ; flushable
-
-: 2float-array ( x y -- array ) F{ } 2sequence ; flushable
-
-: 3float-array ( x y z -- array ) F{ } 3sequence ; flushable
-
-: 4float-array ( w x y z -- array ) F{ } 4sequence ; flushable
+++ /dev/null
-Efficient fixed-length floating point number arrays
+++ /dev/null
-collections
sequences words inference.class quotations alien
alien.c-types strings sbufs sequences.private
slots.private combinators definitions compiler.units
-system layouts vectors optimizer.math.partial accessors
-optimizer.inlining math.order hashtables classes ;
+system layouts vectors optimizer.math.partial
+optimizer.inlining optimizer.backend math.order
+accessors hashtables classes assocs ;
[ t ] [ T{ literal-constraint f 1 2 } T{ literal-constraint f 1 2 } equal? ] unit-test
] unit-test
[ t ] [
- [ hashtable instance? ] \ instance? inlined?
+ [ { hashtable } declare hashtable instance? ] \ instance? inlined?
+] unit-test
+
+[ t ] [
+ [ { vector } declare hashtable instance? ] \ instance? inlined?
+] unit-test
+
+[ f ] [
+ [ { assoc } declare hashtable instance? ] \ instance? inlined?
] unit-test
TUPLE: declared-fixnum { x fixnum } ;
[ f ] [ f V{ } like f V{ } like eq? ] unit-test
-[ ?{ f t } ] [ 0 2 ?{ f t f } subseq ] unit-test
-
[ V{ f f f } ] [ 3 V{ } new-sequence ] unit-test
[ SBUF" \0\0\0" ] [ 3 SBUF" " new-sequence ] unit-test
USING: namespaces math sequences splitting grouping
-kernel columns ;
+kernel columns float-arrays bit-arrays ;
IN: benchmark.dispatch2
: sequences ( -- seq )
USING: sequences math mirrors splitting grouping
-kernel namespaces assocs alien.syntax columns ;
+kernel namespaces assocs alien.syntax columns
+float-arrays bit-arrays ;
IN: benchmark.dispatch3
GENERIC: g ( obj -- str )
! Based on http://shootout.alioth.debian.org/gp4/benchmark.php?test=fasta&lang=java&id=2
USING: math kernel io io.files locals multiline assocs sequences
sequences.private benchmark.reverse-complement hints io.encodings.ascii
-byte-arrays ;
+byte-arrays float-arrays ;
IN: benchmark.fasta
: IM 139968 ; inline
1 2 { t f t f } <slice> >bit-array
] unit-test
+[ ?{ f t } ] [ 0 2 ?{ f t f } subseq ] unit-test
+
[ ?{ t f t f f f } ] [ 6 ?{ t f t } resize ] unit-test
[ ?{ t t } ] [ 2 ?{ t t f t f t f t t t f t } resize ] unit-test
USING: arrays bit-arrays help.markup help.syntax kernel\r
-bit-vectors.private combinators ;\r
+combinators ;\r
IN: bit-vectors\r
\r
ARTICLE: "bit-vectors" "Bit vectors"\r
USING: arrays float-arrays help.markup help.syntax kernel\r
-float-vectors.private combinators ;\r
+combinators ;\r
IN: float-vectors\r
\r
ARTICLE: "float-vectors" "Float vectors"\r
! See http://factorcode.org/license.txt for BSD license.
USING: system kernel namespaces strings hashtables sequences
assocs combinators vocabs.loader init threads continuations
-math accessors concurrency.flags destructors inspector
+math accessors concurrency.flags destructors
io io.backend io.timeouts io.pipes io.pipes.private io.encodings
io.streams.duplex io.ports debugger prettyprint summary ;
IN: io.launcher
M: process-failed error.
dup "Process exited with error code " write code>> . nl
"Launch descriptor:" print nl
- process>> describe ;
+ process>> . ;
: try-process ( desc -- )
run-process dup wait-for-process dup zero?
! Copyright (C) 2007 Alex Chapman
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors alien.c-types colors jamshred.game jamshred.oint jamshred.player jamshred.tunnel kernel math math.constants math.functions math.vectors opengl opengl.gl opengl.glu sequences ;
+USING: accessors alien.c-types colors jamshred.game
+jamshred.oint jamshred.player jamshred.tunnel kernel math
+math.constants math.functions math.vectors opengl opengl.gl
+opengl.glu sequences float-arrays ;
IN: jamshred.gl
: min-vertices 6 ; inline
! Copyright (C) 2007, 2008 Alex Chapman
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors colors combinators jamshred.log jamshred.oint jamshred.sound jamshred.tunnel kernel locals math math.constants math.order math.ranges math.vectors math.matrices shuffle sequences system ;
-USE: tools.walker
+USING: accessors colors combinators jamshred.log jamshred.oint
+jamshred.sound jamshred.tunnel kernel locals math math.constants
+math.order math.ranges math.vectors math.matrices shuffle
+sequences system float-arrays ;
IN: jamshred.player
TUPLE: player < oint name sounds tunnel nearest-segment last-move speed ;
! Copyright (C) 2007 Alex Chapman
! See http://factorcode.org/license.txt for BSD license.
-USING: arrays jamshred.oint jamshred.tunnel kernel math.vectors sequences tools.test ;
+USING: arrays jamshred.oint jamshred.tunnel kernel math.vectors sequences tools.test float-arrays ;
IN: jamshred.tunnel.tests
[ 0 ] [ T{ segment f { 0 0 0 } f f f 0 }
USING: tools.deploy.config ;
H{
- { deploy-name "Maze" }
- { deploy-word-props? f }
+ { deploy-reflection 1 }
+ { deploy-math? t }
{ deploy-ui? t }
- { deploy-c-types? f }
+ { deploy-name "Maze" }
{ deploy-compiler? t }
- { deploy-io 1 }
- { deploy-random? t }
+ { deploy-threads? t }
{ deploy-word-defs? f }
- { deploy-math? t }
+ { deploy-c-types? f }
+ { deploy-io 1 }
{ "stop-after-last-window?" t }
- { deploy-reflection 1 }
- { deploy-threads? t }
+ { deploy-random? t }
+ { deploy-word-props? f }
}
-USING: alien.c-types io io.files io.ports kernel
-namespaces random io.encodings.binary init
-accessors system ;
+USING: alien.c-types io io.files kernel namespaces random
+io.encodings.binary init accessors system ;
IN: random.unix
-TUPLE: unix-random path ;
+TUPLE: unix-random reader ;
-C: <unix-random> unix-random
-
-: file-read-unbuffered ( n path -- bytes )
- over default-buffer-size [
- binary [ read ] with-file-reader
- ] with-variable ;
+: <unix-random> ( path -- random )
+ binary <file-reader> unix-random boa ;
M: unix-random random-bytes* ( n tuple -- byte-array )
- path>> file-read-unbuffered ;
+ reader>> stream-read ;
os openbsd? [
[
! See http://factorcode.org/license.txt for BSD license.
!
USING: tools.test kernel serialize io io.streams.byte-array math
-alien arrays byte-arrays sequences math prettyprint parser
-classes math.constants io.encodings.binary random
-assocs ;
+alien arrays byte-arrays bit-arrays float-arrays sequences math
+prettyprint parser classes math.constants io.encodings.binary
+random assocs ;
IN: serialize.tests
: test-serialize-cell
: deserialize-byte-array ( -- byte-array )
B{ } [ read1 ] (deserialize-seq) ;
-: deserialize-bit-array ( -- bit-array )
- ?{ } [ (deserialize) ] (deserialize-seq) ;
-
-: deserialize-float-array ( -- float-array )
- F{ } [ 8 read be> bits>double ] (deserialize-seq) ;
-
: deserialize-hashtable ( -- hashtable )
H{ } clone
[ intern-object ]
{ CHAR: T [ deserialize-tuple ] }
{ CHAR: W [ deserialize-wrapper ] }
{ CHAR: a [ deserialize-array ] }
- { CHAR: b [ deserialize-bit-array ] }
{ CHAR: c [ deserialize-complex ] }
- { CHAR: f [ deserialize-float-array ] }
{ CHAR: h [ deserialize-hashtable ] }
{ CHAR: m [ deserialize-negative-integer ] }
{ CHAR: n [ deserialize-false ] }
] unit-test\r
\r
[ t ] [\r
- cell 8 = 40 20 ? 100000 * small-enough?\r
+ cell 8 = 35 17 ? 100000 * small-enough?\r
] unit-test\r
\r
[ ] [ "maze" shake-and-bake ] unit-test\r
QUALIFIED: vocabs
IN: tools.deploy.shaker
+! This file is some hairy shit.
+
: strip-init-hooks ( -- )
"Stripping startup hooks" show
+ "cpu.x86" init-hooks get delete-at
"command-line" init-hooks get delete-at
"libc" init-hooks get delete-at
deploy-threads? get [
[ "no-def-strip" word-prop not ] filter
[ [ ] >>def drop ] each ;
+: sift-assoc ( assoc -- assoc' ) [ nip ] assoc-filter ;
+
: strip-word-props ( stripped-props words -- )
"Stripping word properties" show
[
[
props>> swap
'[ drop , member? not ] assoc-filter
- f assoc-like
+ sift-assoc f assoc-like
] keep (>>props)
] with each ;
global swap
'[ drop , member? not ] assoc-filter
[ drop string? not ] assoc-filter ! strip CLI args
+ sift-assoc
dup keys unparse show
21 setenv
] [ drop ] if ;
sent-messages off
super-sent-messages off
+ alien>objc-types off
+ objc>alien-types off
+
! We need this for strip-stack-traces to work fully
{ message-senders super-message-senders }
[ get values compile ] each
USING: alien ui.gadgets.panes ui.gadgets namespaces
kernel sequences io io.styles io.streams.string tools.test
prettyprint definitions help help.syntax help.markup
-help.stylesheet splitting tools.test.ui models math summary ;
+help.stylesheet splitting tools.test.ui models math summary
+inspector ;
: #children "pane" get gadget-children length ;
dup hand-last-button get = ;
: multi-click-position? ( -- ? )
- hand-loc get hand-click-loc get v- norm 10 <= ;
+ hand-loc get hand-click-loc get v- norm-sq 100 <= ;
: multi-click? ( button -- ? )
{
projects / factor.git / commitdiff