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

Conflicts:
	basis/io/launcher/launcher.factor

basis/alien/arrays/arrays.factor

@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: alien alien.strings alien.c-types alien.accessors alien.structs
 arrays words sequences math kernel namespaces fry libc cpu.architecture
-io.encodings.utf8 io.encodings.utf16n ;
+io.encodings.utf8 ;
 IN: alien.arrays
 
 UNION: value-type array struct-type ;
@@ -95,5 +95,4 @@ M: string-type c-type-setter
 
 { "char*" utf8 } "char*" typedef
 "char*" "uchar*" typedef
-{ "char*" utf16n } "wchar_t*" typedef
 

basis/alien/c-types/c-types.factor

@@ -259,8 +259,9 @@ M: long-long-type box-return ( type -- )
     [ dup c-setter '[ _ <c-object> [ 0 @ ] keep ] ] bi
     (( value -- c-ptr )) define-inline ;
 
-: c-bool> ( int -- ? )
+: >c-bool ( ? -- int ) 1 0 ? ; inline
-    0 = not ; inline
+
+: c-bool> ( int -- ? ) 0 = not ; inline
 
 : define-primitive-type ( type name -- )
     [ typedef ]
@@ -409,8 +410,8 @@ CONSTANT: primitive-types
     "uchar" define-primitive-type
 
     <c-type>
-        [ alien-unsigned-1 zero? not ] >>getter
+        [ alien-unsigned-1 c-bool> ] >>getter
-        [ [ 1 0 ? ] 2dip set-alien-unsigned-1 ] >>setter
+        [ [ >c-bool ] 2dip set-alien-unsigned-1 ] >>setter
         1 >>size
         1 >>align
         "box_boolean" >>boxer

basis/base64/base64-tests.factor

@@ -4,7 +4,7 @@ IN: base64.tests
 
 [ "abcdefghijklmnopqrstuvwxyz" ] [ "abcdefghijklmnopqrstuvwxyz" ascii encode >base64 base64> ascii decode
 ] unit-test
-[ f ] [ "" ascii encode >base64 base64> ascii decode ] unit-test
+[ "" ] [ "" ascii encode >base64 base64> ascii decode ] unit-test
 [ "a" ] [ "a" ascii encode >base64 base64> ascii decode ] unit-test
 [ "ab" ] [ "ab" ascii encode >base64 base64> ascii decode ] unit-test
 [ "abc" ] [ "abc" ascii encode >base64 base64> ascii decode ] unit-test

basis/bootstrap/image/image.factor

@@ -52,6 +52,9 @@ GENERIC: (eql?) ( obj1 obj2 -- ? )
 
 M: integer (eql?) = ;
 
+M: float (eql?)
+    over float? [ fp-bitwise= ] [ 2drop f ] if ;
+
 M: sequence (eql?)
     over sequence? [
         2dup [ length ] bi@ =
@@ -445,7 +448,6 @@ M: quotation '
         array>> '
         quotation [
             emit ! array
-            f ' emit ! compiled
             f ' emit ! cached-effect
             f ' emit ! cache-counter
             0 emit ! xt

basis/bootstrap/stage2.factor

@@ -12,6 +12,16 @@ SYMBOL: core-bootstrap-time
 
 SYMBOL: bootstrap-time
 
+: strip-encodings ( -- )
+    os unix? [
+        [
+            P" resource:core/io/encodings/utf16/utf16.factor" 
+            P" resource:core/io/encodings/utf16n/utf16n.factor" [ forget ] bi@
+            "io.encodings.utf16" 
+            "io.encodings.utf16n" [ child-vocabs [ forget-vocab ] each ] bi@
+        ] with-compilation-unit
+    ] when ;
+
 : default-image-name ( -- string )
     vm file-name os windows? [ "." split1-last drop ] when
     ".image" append resource-path ;
@@ -55,6 +65,8 @@ SYMBOL: bootstrap-time
     "math compiler threads help io tools ui ui.tools unicode handbook" "include" set-global
     "" "exclude" set-global
 
+    strip-encodings
+
     (command-line) parse-command-line
 
     ! Set dll paths

basis/checksums/common/common.factor

@@ -9,6 +9,9 @@ SYMBOL: bytes-read
 : calculate-pad-length ( length -- length' )
     [ 56 < 55 119 ? ] keep - ;
 
+: calculate-pad-length-long ( length -- length' )
+    [ 120 < 119 247 ? ] keep - ;
+
 : pad-last-block ( str big-endian? length -- str )
     [
         [ % ] 2dip HEX: 80 ,

basis/checksums/sha2/sha2-tests.factor

@@ -1,7 +1,42 @@
-USING: arrays kernel math namespaces sequences tools.test checksums.sha2 checksums ;
+USING: arrays kernel math namespaces sequences tools.test
-[ "e3b0c44298fc1c149afbf4c8996fb92427ae41e4649b934ca495991b7852b855" ] [ "" sha-256 checksum-bytes hex-string ] unit-test
+checksums.sha2 checksums ;
-[ "ba7816bf8f01cfea414140de5dae2223b00361a396177a9cb410ff61f20015ad" ] [ "abc" sha-256 checksum-bytes hex-string ] unit-test
+IN: checksums.sha2.tests
-[ "f7846f55cf23e14eebeab5b4e1550cad5b509e3348fbc4efa3a1413d393cb650" ] [ "message digest" sha-256 checksum-bytes hex-string ] unit-test
+
-[ "71c480df93d6ae2f1efad1447c66c9525e316218cf51fc8d9ed832f2daf18b73" ] [ "abcdefghijklmnopqrstuvwxyz" sha-256 checksum-bytes hex-string ] unit-test
+: test-checksum ( text identifier -- checksum )
-[ "db4bfcbd4da0cd85a60c3c37d3fbd8805c77f15fc6b1fdfe614ee0a7c8fdb4c0" ] [ "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789" sha-256 checksum-bytes hex-string ] unit-test
+    checksum-bytes hex-string ;
-[ "f371bc4a311f2b009eef952dd83ca80e2b60026c8e935592d0f9c308453c813e" ] [ "12345678901234567890123456789012345678901234567890123456789012345678901234567890" sha-256 checksum-bytes hex-string ] unit-test
+
+[ "75388b16512776cc5dba5da1fd890150b0c6455cb4f58b1952522525" ]
+[
+    "abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq"
+    sha-224 test-checksum
+] unit-test
+
+[ "e3b0c44298fc1c149afbf4c8996fb92427ae41e4649b934ca495991b7852b855" ]
+[ "" sha-256 test-checksum ] unit-test
+
+[ "ba7816bf8f01cfea414140de5dae2223b00361a396177a9cb410ff61f20015ad" ]
+[ "abc" sha-256 test-checksum ] unit-test
+
+[ "f7846f55cf23e14eebeab5b4e1550cad5b509e3348fbc4efa3a1413d393cb650" ]
+[ "message digest" sha-256 test-checksum ] unit-test
+
+[ "71c480df93d6ae2f1efad1447c66c9525e316218cf51fc8d9ed832f2daf18b73" ]
+[ "abcdefghijklmnopqrstuvwxyz" sha-256 test-checksum ] unit-test
+
+[ "db4bfcbd4da0cd85a60c3c37d3fbd8805c77f15fc6b1fdfe614ee0a7c8fdb4c0" ]
+[
+    "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789"
+    sha-256 test-checksum
+] unit-test
+
+[ "f371bc4a311f2b009eef952dd83ca80e2b60026c8e935592d0f9c308453c813e" ]
+[
+    "12345678901234567890123456789012345678901234567890123456789012345678901234567890"
+    sha-256 test-checksum
+] unit-test
+
+
+
+
+! [ "8e959b75dae313da8cf4f72814fc143f8f7779c6eb9f7fa17299aeadb6889018501d289e4900f7e4331b99dec4b5433ac7d329eeb6dd26545e96e55b874be909" ]
+! [ "abcdefghbcdefghicdefghijdefghijkefghijklfghijklmghijklmnhijklmnoijklmnopjklmnopqklmnopqrlmnopqrsmnopqrstnopqrstu" sha-512 test-checksum ] unit-test

basis/checksums/sha2/sha2.factor

@@ -2,12 +2,27 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel splitting grouping math sequences namespaces make
 io.binary math.bitwise checksums checksums.common
-sbufs strings ;
+sbufs strings combinators.smart math.ranges fry combinators
+accessors locals ;
 IN: checksums.sha2
 
-<PRIVATE
+SINGLETON: sha-224
+SINGLETON: sha-256
 
-SYMBOLS: vars M K H S0 S1 process-M word-size block-size ;
+INSTANCE: sha-224 checksum
+INSTANCE: sha-256 checksum
+
+TUPLE: sha2-state K H word-size block-size ;
+
+TUPLE: sha2-short < sha2-state ;
+
+TUPLE: sha2-long < sha2-state ;
+
+TUPLE: sha-224-state < sha2-short ;
+
+TUPLE: sha-256-state < sha2-short ;
+
+<PRIVATE
 
 CONSTANT: a 0
 CONSTANT: b 1
@@ -18,13 +33,43 @@ CONSTANT: f 5
 CONSTANT: g 6
 CONSTANT: h 7
 
-: initial-H-256 ( -- seq )
+CONSTANT: initial-H-224
+    {
+        HEX: c1059ed8 HEX: 367cd507 HEX: 3070dd17 HEX: f70e5939
+        HEX: ffc00b31 HEX: 68581511 HEX: 64f98fa7 HEX: befa4fa4
+    }
+
+CONSTANT: initial-H-256
     {
         HEX: 6a09e667 HEX: bb67ae85 HEX: 3c6ef372 HEX: a54ff53a
         HEX: 510e527f HEX: 9b05688c HEX: 1f83d9ab HEX: 5be0cd19
-    } ;
+    }
 
-: K-256 ( -- seq )
+CONSTANT: initial-H-384
+    {
+        HEX: cbbb9d5dc1059ed8
+        HEX: 629a292a367cd507
+        HEX: 9159015a3070dd17
+        HEX: 152fecd8f70e5939
+        HEX: 67332667ffc00b31
+        HEX: 8eb44a8768581511
+        HEX: db0c2e0d64f98fa7
+        HEX: 47b5481dbefa4fa4
+    }
+
+CONSTANT: initial-H-512
+    {
+        HEX: 6a09e667f3bcc908
+        HEX: bb67ae8584caa73b
+        HEX: 3c6ef372fe94f82b
+        HEX: a54ff53a5f1d36f1
+        HEX: 510e527fade682d1
+        HEX: 9b05688c2b3e6c1f
+        HEX: 1f83d9abfb41bd6b
+        HEX: 5be0cd19137e2179
+    }
+
+CONSTANT: K-256
     {
         HEX: 428a2f98 HEX: 71374491 HEX: b5c0fbcf HEX: e9b5dba5
         HEX: 3956c25b HEX: 59f111f1 HEX: 923f82a4 HEX: ab1c5ed5
@@ -42,62 +87,163 @@ CONSTANT: h 7
         HEX: 391c0cb3 HEX: 4ed8aa4a HEX: 5b9cca4f HEX: 682e6ff3
         HEX: 748f82ee HEX: 78a5636f HEX: 84c87814 HEX: 8cc70208
         HEX: 90befffa HEX: a4506ceb HEX: bef9a3f7 HEX: c67178f2
-    } ;
+    }
+
+CONSTANT: K-384
+    {
+
+        HEX: 428a2f98d728ae22 HEX: 7137449123ef65cd HEX: b5c0fbcfec4d3b2f HEX: e9b5dba58189dbbc 
+        HEX: 3956c25bf348b538 HEX: 59f111f1b605d019 HEX: 923f82a4af194f9b HEX: ab1c5ed5da6d8118 
+        HEX: d807aa98a3030242 HEX: 12835b0145706fbe HEX: 243185be4ee4b28c HEX: 550c7dc3d5ffb4e2
+        HEX: 72be5d74f27b896f HEX: 80deb1fe3b1696b1 HEX: 9bdc06a725c71235 HEX: c19bf174cf692694 
+        HEX: e49b69c19ef14ad2 HEX: efbe4786384f25e3 HEX: 0fc19dc68b8cd5b5 HEX: 240ca1cc77ac9c65 
+        HEX: 2de92c6f592b0275 HEX: 4a7484aa6ea6e483 HEX: 5cb0a9dcbd41fbd4 HEX: 76f988da831153b5 
+        HEX: 983e5152ee66dfab HEX: a831c66d2db43210 HEX: b00327c898fb213f HEX: bf597fc7beef0ee4 
+        HEX: c6e00bf33da88fc2 HEX: d5a79147930aa725 HEX: 06ca6351e003826f HEX: 142929670a0e6e70 
+        HEX: 27b70a8546d22ffc HEX: 2e1b21385c26c926 HEX: 4d2c6dfc5ac42aed HEX: 53380d139d95b3df 
+        HEX: 650a73548baf63de HEX: 766a0abb3c77b2a8 HEX: 81c2c92e47edaee6 HEX: 92722c851482353b 
+        HEX: a2bfe8a14cf10364 HEX: a81a664bbc423001 HEX: c24b8b70d0f89791 HEX: c76c51a30654be30 
+        HEX: d192e819d6ef5218 HEX: d69906245565a910 HEX: f40e35855771202a HEX: 106aa07032bbd1b8 
+        HEX: 19a4c116b8d2d0c8 HEX: 1e376c085141ab53 HEX: 2748774cdf8eeb99 HEX: 34b0bcb5e19b48a8 
+        HEX: 391c0cb3c5c95a63 HEX: 4ed8aa4ae3418acb HEX: 5b9cca4f7763e373 HEX: 682e6ff3d6b2b8a3 
+        HEX: 748f82ee5defb2fc HEX: 78a5636f43172f60 HEX: 84c87814a1f0ab72 HEX: 8cc702081a6439ec 
+        HEX: 90befffa23631e28 HEX: a4506cebde82bde9 HEX: bef9a3f7b2c67915 HEX: c67178f2e372532b 
+        HEX: ca273eceea26619c HEX: d186b8c721c0c207 HEX: eada7dd6cde0eb1e HEX: f57d4f7fee6ed178 
+        HEX: 06f067aa72176fba HEX: 0a637dc5a2c898a6 HEX: 113f9804bef90dae HEX: 1b710b35131c471b 
+        HEX: 28db77f523047d84 HEX: 32caab7b40c72493 HEX: 3c9ebe0a15c9bebc HEX: 431d67c49c100d4c 
+        HEX: 4cc5d4becb3e42b6 HEX: 597f299cfc657e2a HEX: 5fcb6fab3ad6faec HEX: 6c44198c4a475817
+    }
+
+ALIAS: K-512 K-384
 
 : s0-256 ( x -- x' )
-    [ -7 bitroll-32 ] keep
+    [
-    [ -18 bitroll-32 ] keep
+        [ -7 bitroll-32 ]
-    -3 shift bitxor bitxor ; inline
+        [ -18 bitroll-32 ]
+        [ -3 shift ] tri
+    ] [ bitxor ] reduce-outputs ; inline
 
 : s1-256 ( x -- x' )
-    [ -17 bitroll-32 ] keep
+    [
-    [ -19 bitroll-32 ] keep
+        [ -17 bitroll-32 ]
-    -10 shift bitxor bitxor ; inline
+        [ -19 bitroll-32 ]
-
+        [ -10 shift ] tri
-: process-M-256 ( seq n -- )
+    ] [ bitxor ] reduce-outputs ; inline
-    [ 16 - swap nth ] 2keep
-    [ 15 - swap nth s0-256 ] 2keep
-    [ 7 - swap nth ] 2keep
-    [ 2 - swap nth s1-256 ] 2keep
-    [ + + w+ ] 2dip swap set-nth ; inline
-
-: prepare-message-schedule ( seq -- w-seq )
-    word-size get group [ be> ] map block-size get 0 pad-tail
-    dup 16 64 dup <slice> [
-        process-M-256
-    ] with each ;
-
-: ch ( x y z -- x' )
-    [ bitxor bitand ] keep bitxor ;
-
-: maj ( x y z -- x' )
-    [ [ bitand ] 2keep bitor ] dip bitand bitor ;
 
 : S0-256 ( x -- x' )
-    [ -2 bitroll-32 ] keep
+    [
-    [ -13 bitroll-32 ] keep
+        [ -2 bitroll-32 ]
-    -22 bitroll-32 bitxor bitxor ; inline
+        [ -13 bitroll-32 ]
+        [ -22 bitroll-32 ] tri
+    ] [ bitxor ] reduce-outputs ; inline
 
 : S1-256 ( x -- x' )
-    [ -6 bitroll-32 ] keep
+    [
-    [ -11 bitroll-32 ] keep
+        [ -6 bitroll-32 ]
-    -25 bitroll-32 bitxor bitxor ; inline
+        [ -11 bitroll-32 ]
+        [ -25 bitroll-32 ] tri
+    ] [ bitxor ] reduce-outputs ; inline
 
-: slice3 ( n seq -- a b c ) [ dup 3 + ] dip <slice> first3 ; inline
+: s0-512 ( x -- x' )
+    [
+        [ -1 bitroll-64 ]
+        [ -8 bitroll-64 ]
+        [ -7 shift ] tri
+    ] [ bitxor ] reduce-outputs ; inline
 
-: T1 ( W n -- T1 )
+: s1-512 ( x -- x' )
-    [ swap nth ] keep
+    [
-    K get nth +
+        [ -19 bitroll-64 ]
-    e vars get slice3 ch +
+        [ -61 bitroll-64 ]
-    e vars get nth S1-256 +
+        [ -6 shift ] tri
-    h vars get nth w+ ;
+    ] [ bitxor ] reduce-outputs ; inline
 
-: T2 ( -- T2 )
+: S0-512 ( x -- x' )
-    a vars get nth S0-256
+    [
-    a vars get slice3 maj w+ ;
+        [ -28 bitroll-64 ]
+        [ -34 bitroll-64 ]
+        [ -39 bitroll-64 ] tri
+    ] [ bitxor ] reduce-outputs ; inline
 
-: update-vars ( T1 T2 -- )
+: S1-512 ( x -- x' )
-    vars get
+    [
+        [ -14 bitroll-64 ]
+        [ -18 bitroll-64 ]
+        [ -41 bitroll-64 ] tri
+    ] [ bitxor ] reduce-outputs ; inline
+
+: process-M-256 ( n seq -- )
+    {
+        [ [ 16 - ] dip nth ]
+        [ [ 15 - ] dip nth s0-256 ]
+        [ [ 7 - ] dip nth ]
+        [ [ 2 - ] dip nth s1-256 w+ w+ w+ ]
+        [ ]
+    } 2cleave set-nth ; inline
+
+: process-M-512 ( n seq -- )
+    {
+        [ [ 16 - ] dip nth ]
+        [ [ 15 - ] dip nth s0-512 ]
+        [ [ 7 - ] dip nth ]
+        [ [ 2 - ] dip nth s1-512 w+ w+ w+ ]
+        [ ]
+    } 2cleave set-nth ; inline
+
+: ch ( x y z -- x' )
+    [ bitxor bitand ] keep bitxor ; inline
+
+: maj ( x y z -- x' )
+    [ [ bitand ] [ bitor ] 2bi ] dip bitand bitor ; inline
+
+: slice3 ( n seq -- a b c )
+    [ dup 3 + ] dip <slice> first3 ; inline
+
+GENERIC: pad-initial-bytes ( string sha2 -- padded-string )
+
+M: sha2-short pad-initial-bytes ( string sha2 -- padded-string )
+    drop
+    dup [
+        HEX: 80 ,
+        length
+        [ 64 mod calculate-pad-length 0 <string> % ]
+        [ 3 shift 8 >be % ] bi
+    ] "" make append ;
+
+M: sha2-long pad-initial-bytes ( string sha2 -- padded-string )
+    drop dup [
+        HEX: 80 ,
+        length
+        [ 128 mod calculate-pad-length-long 0 <string> % ]
+        [ 3 shift 8 >be % ] bi
+    ] "" make append ;
+
+: seq>byte-array ( seq n -- string )
+    '[ _ >be ] map B{ } join ;
+
+:: T1-256 ( n M H sha2 -- T1 )
+    n M nth
+    n sha2 K>> nth +
+    e H slice3 ch w+
+    e H nth S1-256 w+
+    h H nth w+ ; inline
+
+: T2-256 ( H -- T2 )
+    [ a swap nth S0-256 ]
+    [ a swap slice3 maj w+ ] bi ; inline
+
+:: T1-512 ( n M H sha2 -- T1 )
+    n M nth
+    n sha2 K>> nth +
+    e H slice3 ch w+
+    e H nth S1-512 w+
+    h H nth w+ ; inline
+
+: T2-512 ( H -- T2 )
+    [ a swap nth S0-512 ]
+    [ a swap slice3 maj w+ ] bi ; inline
+
+: update-H ( T1 T2 H -- )
     h g pick exchange
     g f pick exchange
     f e pick exchange
@@ -105,42 +251,56 @@ CONSTANT: h 7
     d c pick exchange
     c b pick exchange
     b a pick exchange
-    [ w+ a ] dip set-nth ;
+    [ w+ a ] dip set-nth ; inline
 
-: process-chunk ( M -- )
+: prepare-message-schedule ( seq sha2 -- w-seq )
-    H get clone vars set
+    [ word-size>> <sliced-groups> [ be> ] map ]
-    prepare-message-schedule block-size get [
+    [
-        T1 T2 update-vars
+        block-size>> [ 0 pad-tail 16 ] keep [a,b) over
-    ] with each vars get H get [ w+ ] 2map H set ;
+        '[ _ process-M-256 ] each
+    ] bi ; inline
 
-: seq>byte-array ( n seq -- string )
+:: process-chunk ( M block-size cloned-H sha2 -- )
-    [ swap [ >be % ] curry each ] B{ } make ;
+    block-size [
+        M cloned-H sha2 T1-256
+        cloned-H T2-256
+        cloned-H update-H
+    ] each
+    cloned-H sha2 H>> [ w+ ] 2map sha2 (>>H) ; inline
 
-: preprocess-plaintext ( string big-endian? -- padded-string )
+: sha2-steps ( sliced-groups state -- )
-    #! pad 0x80 then 00 til 8 bytes left, then 64bit length in bits
+    '[
-    [ >sbuf ] dip over [
+        _
-        HEX: 80 ,
+        [ prepare-message-schedule ]
-        dup length HEX: 3f bitand
+        [ [ block-size>> ] [ H>> clone ] [ ] tri process-chunk ] bi
-        calculate-pad-length 0 <string> %
+    ] each ;
-        length 3 shift 8 rot [ >be ] [ >le ] if %
-    ] "" make over push-all ;
 
-: byte-array>sha2 ( byte-array -- string )
+: byte-array>sha2 ( bytes state -- )
-    t preprocess-plaintext
+    [ [ pad-initial-bytes ] [ nip block-size>> ] 2bi <sliced-groups> ]
-    block-size get group [ process-chunk ] each
+    [ sha2-steps ] bi ;
-    4 H get seq>byte-array ;
+
+: <sha-224-state> ( -- sha2-state )
+    sha-224-state new
+        K-256 >>K
+        initial-H-224 >>H
+        4 >>word-size
+        64 >>block-size ;
+
+: <sha-256-state> ( -- sha2-state )
+    sha-256-state new
+        K-256 >>K
+        initial-H-256 >>H
+        4 >>word-size
+        64 >>block-size ;
 
 PRIVATE>
 
-SINGLETON: sha-256
+M: sha-224 checksum-bytes
-
+    drop <sha-224-state>
-INSTANCE: sha-256 checksum
+    [ byte-array>sha2 ]
+    [ H>> 7 head 4 seq>byte-array ] bi ;
 
 M: sha-256 checksum-bytes
-    drop [
+    drop <sha-256-state>
-        K-256 K set
+    [ byte-array>sha2 ]
-        initial-H-256 H set
+    [ H>> 4 seq>byte-array ] bi ;
-        4 word-size set
-        64 block-size set
-        byte-array>sha2
-    ] with-scope ;

basis/circular/circular-docs.factor

@@ -43,6 +43,11 @@ HELP: push-growing-circular
      { "elt" object } { "circular" circular } }
 { $description "Pushes an element onto a " { $link growing-circular } " object." } ;
 
+HELP: rotate-circular
+{ $values
+    { "circular" circular } }
+{ $description "Advances the start index of a circular object by one." } ;
+
 ARTICLE: "circular" "Circular sequences"
 "The " { $vocab-link "circular" } " vocabulary implements the " { $link "sequence-protocol" } " to allow an arbitrary start index and wrap-around indexing." $nl
 "Creating a new circular object:"
@@ -51,6 +56,7 @@ ARTICLE: "circular" "Circular sequences"
 { $subsection <growing-circular> }
 "Changing the start index:"
 { $subsection change-circular-start }
+{ $subsection rotate-circular }
 "Pushing new elements:"
 { $subsection push-circular }
 { $subsection push-growing-circular } ;

basis/circular/circular-tests.factor

@@ -12,6 +12,7 @@ circular strings ;
 [ CHAR: e ] [ "test" <circular> 5 swap nth-unsafe ] unit-test
  
 [ [ 1 2 3 ] ] [ { 1 2 3 } <circular> [ ] like ] unit-test
+[ [ 2 3 1 ] ] [ { 1 2 3 } <circular> [ rotate-circular ] keep [ ] like ] unit-test
 [ [ 2 3 1 ] ] [ { 1 2 3 } <circular> 1 over change-circular-start [ ] like ] unit-test
 [ [ 3 1 2 ] ] [ { 1 2 3 } <circular> 1 over change-circular-start 1 over change-circular-start [ ] like ] unit-test
 [ [ 3 1 2 ] ] [ { 1 2 3 } <circular> -100 over change-circular-start [ ] like ] unit-test

basis/circular/circular.factor

@@ -27,6 +27,9 @@ M: circular virtual-seq seq>> ;
     #! change start to (start + n) mod length
     circular-wrap (>>start) ;
 
+: rotate-circular ( circular -- )
+    [ start>> 1 + ] keep circular-wrap (>>start) ;
+
 : push-circular ( elt circular -- )
     [ set-first ] [ 1 swap change-circular-start ] bi ;
 

basis/cocoa/application/application.factor

@@ -14,7 +14,7 @@ NSApplicationDelegateReplyCancel
 NSApplicationDelegateReplyFailure ;
 
 : with-autorelease-pool ( quot -- )
-    NSAutoreleasePool -> new slip -> release ; inline
+    NSAutoreleasePool -> new [ call ] [ -> release ] bi* ; inline
 
 : NSApp ( -- app ) NSApplication -> sharedApplication ;
 

basis/cocoa/messages/messages.factor

@@ -68,7 +68,7 @@ MACRO: (send) ( selector super? -- quot )
     [ dup lookup-method ] dip
     [ make-prepare-send ] 2keep
     super-message-senders message-senders ? get at
-    '[ _ call _ execute ] ;
+    1quotation append ;
 
 : send ( receiver args... selector -- return... ) f (send) ; inline
 

basis/combinators/smart/smart.factor

@@ -11,8 +11,8 @@ MACRO: output>sequence ( quot exemplar -- newquot )
     [ dup infer out>> ] dip
     '[ @ _ _ nsequence ] ;
 
-: output>array ( quot -- newquot )
+MACRO: output>array ( quot -- newquot )
-    { } output>sequence ; inline
+    '[ _ { } output>sequence ] ;
 
 MACRO: input<sequence ( quot -- newquot )
     [ infer in>> ] keep
@@ -25,8 +25,8 @@ MACRO: input<sequence-unsafe ( quot -- newquot )
 MACRO: reduce-outputs ( quot operation -- newquot )
     [ dup infer out>> 1 [-] ] dip n*quot compose ;
 
-: sum-outputs ( quot -- n )
+MACRO: sum-outputs ( quot -- n )
-    [ + ] reduce-outputs ; inline
+    '[ _ [ + ] reduce-outputs ] ;
 
 MACRO: map-reduce-outputs ( quot mapper reducer -- newquot )
     [ dup infer out>> ] 2dip
@@ -37,5 +37,5 @@ MACRO: map-reduce-outputs ( quot mapper reducer -- newquot )
 MACRO: append-outputs-as ( quot exemplar -- newquot )
     [ dup infer out>> ] dip '[ @ _ _ nappend-as ] ;
 
-: append-outputs ( quot -- seq )
+MACRO: append-outputs ( quot -- seq )
-    { } append-outputs-as ; inline
+    '[ _ { } append-outputs-as ] ;

basis/compiler/codegen/codegen.factor

@@ -444,8 +444,7 @@ TUPLE: callback-context ;
 
 : do-callback ( quot token -- )
     init-catchstack
-    dup 2 setenv
+    [ 2 setenv call ] keep
-    slip
     wait-to-return ; inline
 
 : callback-return-quot ( ctype -- quot )

basis/compiler/constants/constants.factor

@@ -20,7 +20,7 @@ CONSTANT: deck-bits 18
 : underlying-alien-offset ( -- n ) bootstrap-cell alien tag-number - ; inline
 : tuple-class-offset ( -- n ) bootstrap-cell tuple tag-number - ; inline
 : word-xt-offset ( -- n ) 10 bootstrap-cells \ word tag-number - ; inline
-: quot-xt-offset ( -- n ) 5 bootstrap-cells quotation tag-number - ; inline
+: quot-xt-offset ( -- n ) 4 bootstrap-cells quotation tag-number - ; inline
 : word-code-offset ( -- n ) 11 bootstrap-cells \ word tag-number - ; inline
 : array-start-offset ( -- n ) 2 bootstrap-cells array tag-number - ; inline
 : compiled-header-size ( -- n ) 4 bootstrap-cells ; inline

basis/compiler/tests/curry.factor

@@ -33,7 +33,7 @@ IN: compiler.tests.curry
 ] unit-test
 
 : foobar ( quot: ( -- ) -- )
-    dup slip swap [ foobar ] [ drop ] if ; inline recursive
+    [ call ] keep swap [ foobar ] [ drop ] if ; inline recursive
 
 [ ] [ [ [ f ] foobar ] compile-call ] unit-test
 

basis/compiler/tests/optimizer.factor

@@ -396,3 +396,19 @@ DEFER: loop-bbb
 
 [ 1 ] [ 257 modular-arithmetic-bug ] unit-test
 [ -10 ] [ -10 modular-arithmetic-bug ] unit-test
+
+! Optimizer needs to ignore invalid generics
+GENERIC# bad-dispatch-position-test* 3 ( -- )
+
+M: object bad-dispatch-position-test* ;
+
+: bad-dispatch-position-test ( -- ) bad-dispatch-position-test* ;
+
+[ 1 2 3 4 bad-dispatch-position-test ] must-fail
+
+[ ] [
+    [
+        \ bad-dispatch-position-test forget
+        \ bad-dispatch-position-test* forget
+    ] with-compilation-unit
+] unit-test

basis/compiler/tree/escape-analysis/escape-analysis-tests.factor

@@ -302,7 +302,7 @@ C: <ro-box> ro-box
 [ 0 ] [ [ 1 cons boa "x" get slot ] count-unboxed-allocations ] unit-test
 
 : impeach-node ( quot: ( node -- ) -- )
-    dup slip impeach-node ; inline recursive
+    [ call ] keep impeach-node ; inline recursive
 
 : bleach-node ( quot: ( node -- ) -- )
     [ bleach-node ] curry [ ] compose impeach-node ; inline recursive

basis/compiler/tree/propagation/inlining/inlining.factor

@@ -59,9 +59,11 @@ M: callable splicing-nodes splicing-body ;
 
 : inlining-standard-method ( #call word -- class/f method/f )
     dup "methods" word-prop assoc-empty? [ 2drop f f ] [
+        2dup [ in-d>> length ] [ dispatch# ] bi* <= [ 2drop f f ] [
             [ in-d>> <reversed> ] [ [ dispatch# ] keep ] bi*
             [ swap nth value-info class>> dup ] dip
             specific-method
+        ] if
     ] if ;
 
 : inline-standard-method ( #call word -- ? )

basis/compiler/tree/tuple-unboxing/tuple-unboxing-tests.factor

@@ -39,7 +39,7 @@ TUPLE: empty-tuple ;
 
 ! A more complicated example
 : impeach-node ( quot: ( node -- ) -- )
-    dup slip impeach-node ; inline recursive
+    [ call ] keep impeach-node ; inline recursive
 
 : bleach-node ( quot: ( node -- ) -- )
     [ bleach-node ] curry [ ] compose impeach-node ; inline recursive

basis/cpu/ppc/ppc.factor

@@ -2,11 +2,11 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors assocs sequences kernel combinators make math
 math.order math.ranges system namespaces locals layouts words
-alien alien.c-types literals cpu.architecture cpu.ppc.assembler
+alien alien.accessors alien.c-types literals cpu.architecture
-cpu.ppc.assembler.backend literals compiler.cfg.registers
+cpu.ppc.assembler cpu.ppc.assembler.backend literals compiler.cfg.registers
 compiler.cfg.instructions compiler.constants compiler.codegen
 compiler.codegen.fixup compiler.cfg.intrinsics
-compiler.cfg.stack-frame ;
+compiler.cfg.stack-frame compiler.units ;
 IN: cpu.ppc
 
 ! PowerPC register assignments:
@@ -713,4 +713,14 @@ USE: vocabs.loader
 } cond
 
 "complex-double" c-type t >>return-in-registers? drop
-"bool" c-type 4 >>size 4 >>align drop
+
+[
+    <c-type>
+        [ alien-unsigned-4 c-bool> ] >>getter
+        [ [ >c-bool ] 2dip set-alien-unsigned-4 ] >>setter
+        4 >>size
+        4 >>align
+        "box_boolean" >>boxer
+        "to_boolean" >>unboxer
+    "bool" define-primitive-type
+] with-compilation-unit

basis/dlists/dlists-docs.factor

@@ -15,6 +15,7 @@ $nl
 "Iterating over elements:"
 { $subsection dlist-each }
 { $subsection dlist-find }
+{ $subsection dlist-filter }
 { $subsection dlist-any? }
 "Deleting a node matching a predicate:"
 { $subsection delete-node-if* }
@@ -40,6 +41,11 @@ HELP: dlist-find
     "This operation is O(n)."
 } ;
 
+HELP: dlist-filter
+{ $values { "dlist" { $link dlist } } { "quot" quotation } { "dlist" { $link dlist } } }
+{ $description "Applies the quotation to each element of the " { $link dlist } " in turn, removing the corresponding nodes if the quotation returns " { $link f } "." }
+{ $side-effects { "dlist" } } ;
+
 HELP: dlist-any?
 { $values { "dlist" { $link dlist } } { "quot" quotation } { "?" "a boolean" } }
 { $description "Just like " { $link dlist-find } " except it doesn't return the object." }

basis/dlists/dlists-tests.factor

@@ -79,3 +79,8 @@ IN: dlists.tests
 [ V{ f 3 1 f } ] [ <dlist> 1 over push-front 3 over push-front f over push-front f over push-back dlist>seq ] unit-test
 
 [ V{ } ] [ <dlist> dlist>seq ] unit-test
+
+[ V{ 0 2 4 } ] [ <dlist> { 0 1 2 3 4 } over push-all-back [ even? ] dlist-filter dlist>seq ] unit-test
+[ V{ 2 4 } ] [ <dlist> { 1 2 3 4 } over push-all-back [ even? ] dlist-filter dlist>seq ] unit-test
+[ V{ 2 4 } ] [ <dlist> { 1 2 3 4 5 } over push-all-back [ even? ] dlist-filter dlist>seq ] unit-test
+[ V{ 0 2 4 } ] [ <dlist> { 0 1 2 3 4 5 } over push-all-back [ even? ] dlist-filter dlist>seq ] unit-test

basis/dlists/dlists.factor

@@ -95,7 +95,7 @@ M: dlist pop-front* ( dlist -- )
     [
         [
             [ empty-dlist ] unless*
-            [ f ] change-next drop
+            next>>
             f over set-prev-when
         ] change-front drop
     ] keep
@@ -108,7 +108,7 @@ M: dlist pop-back* ( dlist -- )
     [
         [
             [ empty-dlist ] unless*
-            [ f ] change-prev drop
+            prev>>
             f over set-next-when
         ] change-back drop
     ] keep
@@ -157,6 +157,9 @@ M: dlist clear-deque ( dlist -- )
 
 : 1dlist ( obj -- dlist ) <dlist> [ push-front ] keep ;
 
+: dlist-filter ( dlist quot -- dlist )
+    over [ '[ dup obj>> @ [ drop ] [ _ delete-node ] if ] dlist-each-node ] keep ; inline
+
 M: dlist clone
     <dlist> [ '[ _ push-back ] dlist-each ] keep ;
 

basis/fry/fry-docs.factor

@@ -57,7 +57,6 @@ $nl
 "Here are some built-in combinators rewritten in terms of fried quotations:"
 { $table
     { { $link literalize } { $snippet ": literalize '[ _ ] ;" } }
-    { { $link slip } { $snippet ": slip '[ @ _ ] call ;" } }
     { { $link curry } { $snippet ": curry '[ _ @ ] ;" } }
     { { $link compose } { $snippet ": compose '[ @ @ ] ;" } }
     { { $link bi@ } { $snippet ": bi@ tuck '[ _ @ _ @ ] call ;" } }

basis/game-input/game-input-tests.factor

@@ -0,0 +1,8 @@
+IN: game-input.tests
+USING: ui game-input tools.test kernel system threads calendar ;
+
+os windows? os macosx? or [
+    [ ] [ open-game-input ] unit-test
+    [ ] [ 1 seconds sleep ] unit-test
+    [ ] [ close-game-input ] unit-test
+] when

basis/generalizations/generalizations-docs.factor

@@ -161,22 +161,6 @@ HELP: ndip
     }
 } ;
 
-HELP: nslip
-{ $values { "n" integer } }
-{ $description "A generalization of " { $link slip } " that can work " 
-"for any stack depth. The first " { $snippet "n" } " items after the quotation will be "
-"removed from the stack, the quotation called, and the items restored."
-} 
-{ $examples
-  { $example "USING: generalizations kernel prettyprint ;" "[ 99 ] 1 2 3 4 5 5 nslip 6 narray ." "{ 99 1 2 3 4 5 }" }
-  "Some core words expressed in terms of " { $link nslip } ":"
-    { $table
-        { { $link slip } { $snippet "1 nslip" } }
-        { { $link 2slip } { $snippet "2 nslip" } }
-        { { $link 3slip } { $snippet "3 nslip" } }
-    }
-} ;
-
 HELP: nkeep
 { $values { "quot" quotation } { "n" integer } }
 { $description "A generalization of " { $link keep } " that can work " 
@@ -339,7 +323,6 @@ ARTICLE: "shuffle-generalizations" "Generalized shuffle words"
 
 ARTICLE: "combinator-generalizations" "Generalized combinators"
 { $subsection ndip }
-{ $subsection nslip }
 { $subsection nkeep }
 { $subsection napply }
 { $subsection ncleave }

basis/generalizations/generalizations-tests.factor

@@ -26,8 +26,6 @@ IN: generalizations.tests
 [ [ 1 ] 5 ndip ] must-infer
 [ 1 2 3 4 ] [ 2 3 4 [ 1 ] 3 ndip ] unit-test
 
-[ [ 99 ] 1 2 3 4 5 5 nslip ] must-infer
-{ 99 1 2 3 4 5 } [ [ 99 ] 1 2 3 4 5 5 nslip ] unit-test
 [ 1 2 3 4 5 [ drop drop drop drop drop 2 ] 5 nkeep ] must-infer
 { 2 1 2 3 4 5 } [ 1 2 3 4 5 [ drop drop drop drop drop 2 ] 5 nkeep ] unit-test
 [ [ 1 2 3 + ] ] [ 1 2 3 [ + ] 3 ncurry ] unit-test

basis/generalizations/generalizations.factor

@@ -60,9 +60,6 @@ MACRO: ntuck ( n -- )
 MACRO: ndip ( quot n -- )
     [ '[ _ dip ] ] times ;
 
-MACRO: nslip ( n -- )
-    '[ [ call ] _ ndip ] ;
-
 MACRO: nkeep ( quot n -- )
     tuck '[ _ ndup _ _ ndip ] ;
 

basis/io/backend/unix/unix.factor

@@ -173,10 +173,11 @@ M: stdin refill
         size-read-fd <fd> init-fd <input-port> >>size
         data-read-fd <fd> >>data ;
 
-M: unix (init-stdio)
+M: unix init-stdio
     <stdin> <input-port>
     1 <fd> <output-port>
-    2 <fd> <output-port> t ;
+    2 <fd> <output-port>
+    set-stdio ;
 
 ! mx io-task for embedding an fd-based mx inside another mx
 TUPLE: mx-port < port mx ;

basis/io/backend/windows/nt/nt.factor

@@ -1,9 +1,9 @@
-USING: alien alien.c-types arrays assocs combinators
+USING: alien alien.c-types arrays assocs combinators continuations
-continuations destructors io io.backend io.ports io.timeouts
+destructors io io.backend io.ports io.timeouts io.backend.windows
-io.backend.windows io.files.windows io.files.windows.nt io.files
+io.files.windows io.files.windows.nt io.files io.pathnames io.buffers
-io.pathnames io.buffers io.streams.c libc kernel math namespaces
+io.streams.c io.streams.null libc kernel math namespaces sequences
-sequences threads windows windows.errors windows.kernel32
+threads windows windows.errors windows.kernel32 strings splitting
-strings splitting ascii system accessors locals ;
+ascii system accessors locals ;
 QUALIFIED: windows.winsock
 IN: io.backend.windows.nt
 
@@ -140,7 +140,9 @@ M: winnt (wait-to-read) ( port -- )
 
 : console-app? ( -- ? ) GetConsoleWindow >boolean ;
 
-M: winnt (init-stdio)
+M: winnt init-stdio
-    console-app? [ init-c-stdio t ] [ f f f f ] if ;
+    console-app?
+    [ init-c-stdio ]
+    [ null-reader null-writer null-writer set-stdio ] if ;
 
 winnt set-io-backend

basis/io/directories/search/search-docs.factor

@@ -1,6 +1,6 @@
 ! Copyright (C) 2009 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: help.markup help.syntax kernel quotations ;
+USING: help.markup help.syntax kernel quotations sequences ;
 IN: io.directories.search
 
 HELP: each-file
@@ -57,6 +57,32 @@ HELP: find-all-in-directories
 }
 { $description "Finds all files in the input directories matching the predicate quotation in a breadth-first or depth-first traversal." } ;
 
+HELP: find-by-extension
+{ $values
+    { "path" "a pathname string" } { "extension" "a file extension" }
+    { "seq" sequence }
+}
+{ $description "Searches a directory for all files with the given extension. File extension and filenames are converted to lower-case and compared using the " { $link tail? } " word. The file extension should contain the period." }
+{ $examples
+    { $unchecked-example
+        "USING: io.directories.search ;"
+        "\"/\" \".mp3\" find-by-extension"
+    }
+} ;
+
+HELP: find-by-extensions
+{ $values
+    { "path" "a pathname string" } { "extensions" "a sequence of file extensions" }
+    { "seq" sequence }
+}
+{ $description "Searches a directory for all files in the given list of extensions. File extensions and filenames are converted to lower-case and compared using the " { $link tail? } " word. File extensions should contain the period." }
+{ $examples
+    { $unchecked-example
+        "USING: io.directories.search ;"
+        "\"/\" { \".jpg\" \".gif\" \".tiff\" \".png\" \".bmp\" } find-by-extensions"
+    }
+} ;
+
 { find-file find-all-files find-in-directories find-all-in-directories } related-words
 
 ARTICLE: "io.directories.search" "Searching directories"
@@ -65,10 +91,13 @@ ARTICLE: "io.directories.search" "Searching directories"
 { $subsection recursive-directory-files }
 { $subsection recursive-directory-entries }
 { $subsection each-file }
-"Finding files:"
+"Finding files by name:"
 { $subsection find-file }
 { $subsection find-all-files }
 { $subsection find-in-directories }
-{ $subsection find-all-in-directories } ;
+{ $subsection find-all-in-directories }
+"Finding files by extension:"
+{ $subsection find-by-extension }
+{ $subsection find-by-extensions } ;
 
 ABOUT: "io.directories.search"

basis/io/directories/search/search.factor

@@ -3,7 +3,7 @@
 USING: accessors arrays continuations deques dlists fry
 io.directories io.files io.files.info io.pathnames kernel
 sequences system vocabs.loader locals math namespaces
-sorting assocs calendar threads io math.parser ;
+sorting assocs calendar threads io math.parser unicode.case ;
 IN: io.directories.search
 
 : qualified-directory-entries ( path -- seq )
@@ -106,4 +106,11 @@ ERROR: file-not-found path bfs? quot ;
         ] { } map>assoc
     ] with-qualified-directory-entries sort-values ;
 
+: find-by-extensions ( path extensions -- seq )
+    [ >lower ] map
+    '[ >lower _ [ tail? ] with any? ] find-all-files ;
+    
+: find-by-extension ( path extension -- seq )
+    1array find-by-extensions ;
+
 os windows? [ "io.directories.search.windows" require ] when

basis/io/directories/unix/linux/linux.factor

@@ -0,0 +1,10 @@
+! Copyright (C) 2009 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: alien.c-types io.directories.unix kernel system unix ;
+IN: io.directories.unix.linux
+
+M: unix find-next-file ( DIR* -- byte-array )
+    "dirent" <c-object>
+    f <void*>
+    [ readdir64_r 0 = [ (io-error) ] unless ] 2keep
+    *void* [ drop f ] unless ;

basis/io/directories/unix/linux/tags.txt

@@ -0,0 +1 @@
+unportable

basis/io/directories/unix/unix.factor

@@ -4,7 +4,7 @@ USING: accessors alien.c-types alien.strings combinators
 continuations destructors fry io io.backend io.backend.unix
 io.directories io.encodings.binary io.encodings.utf8 io.files
 io.pathnames io.files.types kernel math.bitwise sequences system
-unix unix.stat ;
+unix unix.stat vocabs.loader ;
 IN: io.directories.unix
 
 : touch-mode ( -- n )
@@ -34,7 +34,9 @@ M: unix copy-file ( from to -- )
     [ opendir dup [ (io-error) ] unless ] dip
     dupd curry swap '[ _ closedir io-error ] [ ] cleanup ; inline
 
-: find-next-file ( DIR* -- byte-array )
+HOOK: find-next-file os ( DIR* -- byte-array )
+
+M: unix find-next-file ( DIR* -- byte-array )
     "dirent" <c-object>
     f <void*>
     [ readdir_r 0 = [ (io-error) ] unless ] 2keep
@@ -54,8 +56,10 @@ M: unix copy-file ( from to -- )
     } case ;
 
 M: unix >directory-entry ( byte-array -- directory-entry )
+    {
         [ dirent-d_name utf8 alien>string ]
-    [ dirent-d_type dirent-type>file-type ] bi directory-entry boa ;
+        [ dirent-d_type dirent-type>file-type ]
+    } cleave directory-entry boa ;
 
 M: unix (directory-entries) ( path -- seq )
     [
@@ -63,3 +67,5 @@ M: unix (directory-entries) ( path -- seq )
         [ >directory-entry ]
         produce nip
     ] with-unix-directory ;
+
+os linux? [ "io.directories.unix.linux" require ] when

basis/io/files/info/info.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2008 Doug Coleman, Eduardo Cavazos.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors kernel system sequences combinators
-vocabs.loader io.files.types ;
+vocabs.loader io.files.types math ;
 IN: io.files.info
 
 ! File info
@@ -14,6 +14,9 @@ HOOK: link-info os ( path -- info )
 
 : directory? ( file-info -- ? ) type>> +directory+ = ;
 
+: sparse-file? ( file-info -- ? )
+    [ size-on-disk>> ] [ size>> ] bi < ;
+
 ! File systems
 HOOK: file-systems os ( -- array )
 

basis/io/launcher/launcher.factor

@@ -1,11 +1,11 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: system kernel namespaces strings hashtables sequences 
+USING: system kernel namespaces strings hashtables sequences assocs
-assocs combinators vocabs.loader init threads continuations
+combinators vocabs.loader init threads continuations math accessors
-math accessors concurrency.flags destructors environment
+concurrency.flags destructors environment io io.encodings.ascii
-io io.encodings.utf8 io.backend io.timeouts io.pipes
+io.backend io.timeouts io.pipes io.pipes.private io.encodings
-io.pipes.private io.encodings io.streams.duplex io.ports
+io.encodings.utf8 io.streams.duplex io.ports debugger prettyprint
-debugger prettyprint summary calendar io.pathnames ;
+summary calendar ;
 IN: io.launcher
 
 TUPLE: process < identity-tuple
@@ -254,6 +254,21 @@ M: object run-pipeline-element
     swap [ with-stream ] dip
     wait-for-success ; inline
 
+ERROR: output-process-error { output string } { process process } ;
+
+M: output-process-error error.
+    [ "Process:" print process>> . nl ]
+    [ "Output:" print output>> print ]
+    bi ;
+
+: try-output-process ( command -- )
+    >process
+    +stdout+ >>stderr
+    +closed+ >>stdin
+    utf8 <process-reader*>
+    [ stream-contents ] [ dup wait-for-process ] bi*
+    0 = [ 2drop ] [ output-process-error ] if ;
+
 : notify-exit ( process status -- )
     >>status
     [ processes get delete-at* drop [ resume ] each ] keep

basis/io/launcher/unix/unix-tests.factor

@@ -48,7 +48,7 @@ concurrency.promises threads unix.process ;
     try-process
 ] unit-test
 
-[ f ] [
+[ "" ] [
     "cat"
     "launcher-test-1" temp-file
     2array

basis/io/streams/string/string-tests.factor

@@ -2,6 +2,8 @@ USING: io.streams.string io kernel arrays namespaces make
 tools.test ;
 IN: io.streams.string.tests
 
+[ "" ] [ "" [ contents ] with-string-reader ] unit-test
+
 [ "line 1" CHAR: l ]
 [
     "line 1\nline 2\nline 3" <string-reader>

basis/math/bitwise/bitwise.factor

@@ -35,6 +35,11 @@ IN: math.bitwise
 : w- ( int int -- int ) - 32 bits ; inline
 : w* ( int int -- int ) * 32 bits ; inline
 
+! 64-bit arithmetic
+: W+ ( int int -- int ) + 64 bits ; inline
+: W- ( int int -- int ) - 64 bits ; inline
+: W* ( int int -- int ) * 64 bits ; inline
+
 ! flags
 MACRO: flags ( values -- )
     [ 0 ] [ [ ?execute bitor ] curry compose ] reduce ;
@@ -106,3 +111,10 @@ PRIVATE>
 : >signed ( x n -- y )
     2dup neg 1 + shift 1 = [ 2^ - ] [ drop ] if ;
 
+: >odd ( n -- int ) 0 set-bit ; foldable
+
+: >even ( n -- int ) 0 clear-bit ; foldable
+
+: next-even ( m -- n ) >even 2 + ; foldable
+
+: next-odd ( m -- n ) dup even? [ 1 + ] [ 2 + ] if ; foldable

basis/math/miller-rabin/miller-rabin-docs.factor

@@ -1,100 +0,0 @@
-! Copyright (C) 2009 Doug Coleman.
-! See http://factorcode.org/license.txt for BSD license.
-USING: help.markup help.syntax kernel sequences math ;
-IN: math.miller-rabin
-
-HELP: find-relative-prime
-{ $values
-    { "n" integer }
-    { "p" integer }
-}
-{ $description "Returns a number that is relatively prime to " { $snippet "n" } "." } ;
-
-HELP: find-relative-prime*
-{ $values
-    { "n" integer } { "guess" integer }
-    { "p" integer }
-}
-{ $description "Returns a number that is relatively prime to " { $snippet "n" } ", starting by trying " { $snippet "guess" } "." } ;
-
-HELP: miller-rabin
-{ $values
-    { "n" integer }
-    { "?" "a boolean" }
-}
-{ $description "Returns true if the number is a prime. Calls " { $link miller-rabin* } " with a default of 10 Miller-Rabin tests." } ;
-
-{ miller-rabin miller-rabin* } related-words
-
-HELP: miller-rabin*
-{ $values
-    { "n" integer } { "numtrials" integer }
-    { "?" "a boolean" }
-}
-{ $description "Performs " { $snippet "numtrials" } " trials of the Miller-Rabin probabilistic primality test algorithm and returns true if prime." } ;
-
-HELP: next-prime
-{ $values
-    { "n" integer }
-    { "p" integer }
-}
-{ $description "Tests consecutive numbers for primality with " { $link miller-rabin } " and returns the next prime." } ;
-
-HELP: next-safe-prime
-{ $values
-    { "n" integer }
-    { "q" integer }
-}
-{ $description "Tests consecutive numbers and returns the next safe prime. A safe prime is desirable in cryptography applications such as Diffie-Hellman and SRP6." } ;
-
-HELP: random-bits*
-{ $values
-    { "numbits" integer }
-    { "n" integer }
-}
-{ $description "Returns an integer exactly " { $snippet "numbits" } " in length, with the topmost bit set to one." } ;
-
-HELP: random-prime
-{ $values
-    { "numbits" integer }
-    { "p" integer }
-}
-{ $description "Returns a prime number exactly " { $snippet "numbits" } " bits in length, with the topmost bit set to one." } ;
-
-HELP: random-safe-prime
-{ $values
-    { "numbits" integer }
-    { "p" integer }
-}
-{ $description "Returns a safe prime number " { $snippet "numbits" } " bits in length, with the topmost bit set to one." } ;
-
-HELP: safe-prime?
-{ $values
-    { "q" integer }
-    { "?" "a boolean" }
-}
-{ $description "Tests whether the number is a safe prime. A safe prime " { $snippet "p" } " must be prime, as must " { $snippet "(p - 1) / 2" } "." } ;
-
-HELP: unique-primes
-{ $values
-    { "numbits" integer } { "n" integer }
-    { "seq" sequence }
-}
-{ $description "Generates a sequence of " { $snippet "n" } " unique prime numbers with exactly " { $snippet "numbits" } " bits." } ;
-
-ARTICLE: "math.miller-rabin" "Miller-Rabin probabilistic primality test"
-"The " { $vocab-link "math.miller-rabin" } " vocabulary implements the Miller-Rabin probabilistic primality test and utility words that use it in order to generate random prime numbers." $nl
-"The Miller-Rabin probabilistic primality test:"
-{ $subsection miller-rabin }
-{ $subsection miller-rabin* }
-"Generating relative prime numbers:"
-{ $subsection find-relative-prime }
-{ $subsection find-relative-prime* }
-"Generating prime numbers:"
-{ $subsection next-prime }
-{ $subsection random-prime }
-"Generating safe prime numbers:"
-{ $subsection next-safe-prime }
-{ $subsection random-safe-prime } ;
-
-ABOUT: "math.miller-rabin"

basis/math/miller-rabin/miller-rabin-tests.factor

@@ -1,29 +0,0 @@
-USING: math.miller-rabin tools.test kernel sequences
-math.miller-rabin.private math ;
-IN: math.miller-rabin.tests
-
-[ f ] [ 473155932665450549999756893736999469773678960651272093993257221235459777950185377130233556540099119926369437865330559863 miller-rabin ] unit-test
-[ t ] [ 2 miller-rabin ] unit-test
-[ t ] [ 3 miller-rabin ] unit-test
-[ f ] [ 36 miller-rabin ] unit-test
-[ t ] [ 37 miller-rabin ] unit-test
-[ 2 ] [ 1 next-prime ] unit-test
-[ 3 ] [ 2 next-prime ] unit-test
-[ 5 ] [ 3 next-prime ] unit-test
-[ 101 ] [ 100 next-prime ] unit-test
-[ t ] [ 2135623355842621559 miller-rabin ] unit-test
-[ 100000000000031 ] [ 100000000000000 next-prime ] unit-test
-
-[ 863 ] [ 862 next-safe-prime ] unit-test
-[ f ] [ 862 safe-prime? ] unit-test
-[ t ] [ 7 safe-prime? ] unit-test
-[ f ] [ 31 safe-prime? ] unit-test
-[ t ] [ 47 safe-prime-candidate? ] unit-test
-[ t ] [ 47 safe-prime? ] unit-test
-[ t ] [ 863 safe-prime? ] unit-test
-
-[ f ] [ 1000 [ drop 15 miller-rabin ] any? ] unit-test
-
-[ 47 ] [ 31 next-safe-prime ] unit-test
-[ 49 ] [ 50 random-prime log2 ] unit-test
-[ 49 ] [ 50 random-bits* log2 ] unit-test

basis/math/miller-rabin/miller-rabin.factor

@@ -1,114 +0,0 @@
-! Copyright (c) 2008-2009 Doug Coleman.
-! See http://factorcode.org/license.txt for BSD license.
-USING: combinators kernel locals math math.functions math.ranges
-random sequences sets combinators.short-circuit math.bitwise
-math math.order ;
-IN: math.miller-rabin
-
-: >odd ( n -- int ) 0 set-bit ; foldable
-
-: >even ( n -- int ) 0 clear-bit ; foldable
-
-: next-even ( m -- n ) >even 2 + ;
-
-: next-odd ( m -- n ) dup even? [ 1 + ] [ 2 + ] if ;
-
-<PRIVATE
-
-:: (miller-rabin) ( n trials -- ? )
-    n 1 - :> n-1
-    n-1 factor-2s :> s :> r
-    0 :> a!
-    trials [
-        drop
-        2 n 2 - [a,b] random a!
-        a s n ^mod 1 = [
-            f
-        ] [
-            r iota [
-                2^ s * a swap n ^mod n - -1 =
-            ] any? not
-        ] if
-    ] any? not ;
-
-PRIVATE>
-
-: miller-rabin* ( n numtrials -- ? )
-    over {
-        { [ dup 1 <= ] [ 3drop f ] }
-        { [ dup 2 = ] [ 3drop t ] }
-        { [ dup even? ] [ 3drop f ] }
-        [ drop (miller-rabin) ]
-    } cond ;
-
-: miller-rabin ( n -- ? ) 10 miller-rabin* ;
-
-ERROR: prime-range-error n ;
-
-: next-prime ( n -- p )
-    dup 1 < [ prime-range-error ] when
-    dup 1 = [
-        drop 2
-    ] [
-        next-odd dup miller-rabin [ next-prime ] unless
-    ] if ;
-
-: random-bits* ( numbits -- n )
-    1 - [ random-bits ] keep set-bit ;
-
-: random-prime ( numbits -- p )
-    random-bits* next-prime ;
-
-ERROR: no-relative-prime n ;
-
-<PRIVATE
-
-: (find-relative-prime) ( n guess -- p )
-    over 1 <= [ over no-relative-prime ] when
-    dup 1 <= [ drop 3 ] when
-    2dup gcd nip 1 > [ 2 + (find-relative-prime) ] [ nip ] if ;
-
-PRIVATE>
-
-: find-relative-prime* ( n guess -- p )
-    #! find a prime relative to n with initial guess
-    >odd (find-relative-prime) ;
-
-: find-relative-prime ( n -- p )
-    dup random find-relative-prime* ;
-
-ERROR: too-few-primes ;
-
-: unique-primes ( numbits n -- seq )
-    #! generate two primes
-    swap
-    dup 5 < [ too-few-primes ] when
-    2dup [ random-prime ] curry replicate
-    dup all-unique? [ 2nip ] [ drop unique-primes ] if ;
-
-! Safe primes are of the form p = 2q + 1, p,q are prime
-! See http://en.wikipedia.org/wiki/Safe_prime
-
-<PRIVATE
-
-: safe-prime-candidate? ( n -- ? )
-    1 + 6 divisor? ;
-
-: next-safe-prime-candidate ( n -- candidate )
-    next-prime dup safe-prime-candidate?
-    [ next-safe-prime-candidate ] unless ;
-
-PRIVATE>
-
-: safe-prime? ( q -- ? )
-    {
-        [ 1 - 2 / dup integer? [ miller-rabin ] [ drop f ] if ]
-        [ miller-rabin ]
-    } 1&& ;
-
-: next-safe-prime ( n -- q )
-    next-safe-prime-candidate
-    dup safe-prime? [ next-safe-prime ] unless ;
-
-: random-safe-prime ( numbits -- p )
-    random-bits* next-safe-prime ;

basis/math/polynomials/polynomials-docs.factor

@@ -93,7 +93,13 @@ HELP: pdiff
 { $description "Finds the derivative of " { $snippet "p" } "." } ;
 
 HELP: polyval
-{ $values { "p" "a polynomial" } { "x" number } { "p[x]" number } }
+{ $values { "x" number } { "p" "a polynomial" } { "p[x]" number } }
 { $description "Evaluate " { $snippet "p" } " with the input " { $snippet "x" } "." }
-{ $examples { $example "USING: math.polynomials prettyprint ;" "{ 1 0 1 } 2 polyval ." "5" } } ;
+{ $examples { $example "USING: math.polynomials prettyprint ;" "2 { 1 0 1 } polyval ." "5" } } ;
 
+HELP: polyval*
+{ $values { "p" "a literal polynomial" } }
+{ $description "Macro version of " { $link polyval } ". Evaluates the literal polynomial " { $snippet "p" } " at the value off the top of the stack." }
+{ $examples { $example "USING: math.polynomials prettyprint ;" "2 { 1 0 1 } polyval* ." "5" } } ;
+
+{ polyval polyval* } related-words

basis/math/polynomials/polynomials.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2008 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: arrays kernel make math math.order math.vectors sequences
-    splitting vectors ;
+    splitting vectors macros combinators ;
 IN: math.polynomials
 
 <PRIVATE
@@ -80,6 +80,12 @@ PRIVATE>
 : pdiff ( p -- p' )
     dup length v* { 0 } ?head drop ;
 
-: polyval ( p x -- p[x] )
+: polyval ( x p -- p[x] )
-    [ dup length ] dip powers v. ;
+    [ length swap powers ] [ nip ] 2bi v. ;
+
+MACRO: polyval* ( p -- )
+    reverse
+    [ 1 tail [ \ * swap \ + [ ] 3sequence ] map ]
+    [ first \ drop swap [ ] 2sequence ] bi
+    prefix \ cleave [ ] 2sequence ;
 

basis/math/primes/factors/factors.factor

@@ -1,6 +1,7 @@
 ! Copyright (C) 2007-2009 Samuel Tardieu.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: arrays combinators kernel make math math.functions math.primes sequences ;
+USING: arrays combinators kernel make math math.functions
+math.primes sequences ;
 IN: math.primes.factors
 
 <PRIVATE

basis/math/primes/lucas-lehmer/authors.txt

@@ -0,0 +1 @@
+Doug Coleman

basis/math/primes/lucas-lehmer/lucas-lehmer-docs.factor

@@ -0,0 +1,25 @@
+! Copyright (C) 2009 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: help.markup help.syntax kernel ;
+IN: math.primes.lucas-lehmer
+
+HELP: lucas-lehmer
+{ $values
+    { "p" "a prime number" }
+    { "?" "a boolean" }
+}
+{ $description "Runs the Lucas-Lehmer test on the prime " { $snippet "p" } " and returns " { $link t } " if " { $snippet "(2 ^ p) - 1" } " is prime." }
+{ $examples
+    { $example "! Test that (2 ^ 61) - 1 is prime:"
+               "USING: math.primes.lucas-lehmer prettyprint ;"
+               "61 lucas-lehmer ."
+               "t"
+    }
+} ;
+
+ARTICLE: "math.primes.lucas-lehmer" "Lucas-Lehmer Mersenne Primality test"
+"The " { $vocab-link "math.primes.lucas-lehmer" } " vocabulary tests numbers of the form " { $snippet "(2 ^ p) - 1" } " for primality, where " { $snippet "p" } " is prime." $nl
+"Run the Lucas-Lehmer test:"
+{ $subsection lucas-lehmer } ;
+
+ABOUT: "math.primes.lucas-lehmer"

basis/math/primes/lucas-lehmer/lucas-lehmer-tests.factor

@@ -0,0 +1,13 @@
+! Copyright (C) 2009 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: tools.test math.primes.lucas-lehmer ;
+IN: math.primes.lucas-lehmer.tests
+
+[ t ] [ 2 lucas-lehmer ] unit-test
+[ t ] [ 3 lucas-lehmer ] unit-test
+[ f ] [ 4 lucas-lehmer ] unit-test
+[ t ] [ 5 lucas-lehmer ] unit-test
+[ f ] [ 6 lucas-lehmer ] unit-test
+[ f ] [ 11 lucas-lehmer ] unit-test
+[ t ] [ 13 lucas-lehmer ] unit-test
+[ t ] [ 61 lucas-lehmer ] unit-test

basis/math/primes/lucas-lehmer/lucas-lehmer.factor

@@ -0,0 +1,27 @@
+! Copyright (C) 2009 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: combinators fry kernel locals math
+math.primes combinators.short-circuit ;
+IN: math.primes.lucas-lehmer
+
+ERROR: invalid-lucas-lehmer-candidate obj ;
+
+<PRIVATE
+
+: do-lucas-lehmer ( p -- ? )
+    [ drop 4 ] [ 2 - ] [ 2^ 1 - ] tri
+    '[ sq 2 - _ mod ] times 0 = ;
+
+: lucas-lehmer-guard ( obj -- obj )
+    dup { [ integer? ] [ 0 > ] } 1&&
+    [ invalid-lucas-lehmer-candidate ] unless ;
+
+PRIVATE>
+
+: lucas-lehmer ( p -- ? )
+    lucas-lehmer-guard
+    {
+        { [ dup 2 = ] [ drop t ] }
+        { [ dup prime? ] [ do-lucas-lehmer ] }
+        [ drop f ]
+    } cond ;

basis/math/primes/miller-rabin/miller-rabin-docs.factor

@@ -0,0 +1,28 @@
+! Copyright (C) 2009 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: help.markup help.syntax kernel sequences math ;
+IN: math.primes.miller-rabin
+
+HELP: miller-rabin
+{ $values
+    { "n" integer }
+    { "?" "a boolean" }
+}
+{ $description "Returns true if the number is a prime. Calls " { $link miller-rabin* } " with a default of 10 Miller-Rabin tests." } ;
+
+{ miller-rabin miller-rabin* } related-words
+
+HELP: miller-rabin*
+{ $values
+    { "n" integer } { "numtrials" integer }
+    { "?" "a boolean" }
+}
+{ $description "Performs " { $snippet "numtrials" } " trials of the Miller-Rabin probabilistic primality test algorithm and returns true if prime." } ;
+
+ARTICLE: "math.primes.miller-rabin" "Miller-Rabin probabilistic primality test"
+"The " { $vocab-link "math.primes.miller-rabin" } " vocabulary implements the Miller-Rabin probabilistic primality test and utility words that use it in order to generate random prime numbers." $nl
+"The Miller-Rabin probabilistic primality test:"
+{ $subsection miller-rabin }
+{ $subsection miller-rabin* } ;
+
+ABOUT: "math.primes.miller-rabin"

basis/math/primes/miller-rabin/miller-rabin-tests.factor

@@ -0,0 +1,11 @@
+USING: kernel math.primes.miller-rabin sequences tools.test ;
+IN: math.primes.miller-rabin.tests
+
+[ f ] [ 473155932665450549999756893736999469773678960651272093993257221235459777950185377130233556540099119926369437865330559863 miller-rabin ] unit-test
+[ t ] [ 2 miller-rabin ] unit-test
+[ t ] [ 3 miller-rabin ] unit-test
+[ f ] [ 36 miller-rabin ] unit-test
+[ t ] [ 37 miller-rabin ] unit-test
+[ t ] [ 2135623355842621559 miller-rabin ] unit-test
+
+[ f ] [ 1000 [ drop 15 miller-rabin ] any? ] unit-test

basis/math/primes/miller-rabin/miller-rabin.factor

@@ -0,0 +1,35 @@
+! Copyright (c) 2008-2009 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: combinators combinators.short-circuit kernel locals math
+math.functions math.ranges random sequences sets ;
+IN: math.primes.miller-rabin
+
+<PRIVATE
+
+:: (miller-rabin) ( n trials -- ? )
+    n 1 - :> n-1
+    n-1 factor-2s :> s :> r
+    0 :> a!
+    trials [
+        drop
+        2 n 2 - [a,b] random a!
+        a s n ^mod 1 = [
+            f
+        ] [
+            r iota [
+                2^ s * a swap n ^mod n - -1 =
+            ] any? not
+        ] if
+    ] any? not ;
+
+PRIVATE>
+
+: miller-rabin* ( n numtrials -- ? )
+    over {
+        { [ dup 1 <= ] [ 3drop f ] }
+        { [ dup 2 = ] [ 3drop t ] }
+        { [ dup even? ] [ 3drop f ] }
+        [ drop (miller-rabin) ]
+    } cond ;
+
+: miller-rabin ( n -- ? ) 10 miller-rabin* ;

basis/math/primes/primes-docs.factor

@@ -1,10 +1,10 @@
-USING: help.markup help.syntax ;
+USING: help.markup help.syntax math sequences ;
 IN: math.primes
 
 { next-prime prime? } related-words
 
 HELP: next-prime
-{ $values { "n" "an integer not smaller than 2" } { "p" "a prime number" } }
+{ $values { "n" integer } { "p" "a prime number" } }
 { $description "Return the next prime number greater than " { $snippet "n" } "." } ;
 
 HELP: prime?
@@ -20,3 +20,48 @@ HELP: primes-upto
 HELP: primes-between
 { $values { "low" "an integer" } { "high" "an integer" } { "seq" "a sequence" } }
 { $description "Return a sequence containing all the prime numbers between " { $snippet "low" } " and " { $snippet "high" } "." } ;
+
+HELP: find-relative-prime
+{ $values
+    { "n" integer }
+    { "p" integer }
+}
+{ $description "Returns a number that is relatively prime to " { $snippet "n" } "." } ;
+
+HELP: find-relative-prime*
+{ $values
+    { "n" integer } { "guess" integer }
+    { "p" integer }
+}
+{ $description "Returns a number that is relatively prime to " { $snippet "n" } ", starting by trying " { $snippet "guess" } "." } ;
+
+HELP: random-prime
+{ $values
+    { "numbits" integer }
+    { "p" integer }
+}
+{ $description "Returns a prime number exactly " { $snippet "numbits" } " bits in length, with the topmost bit set to one." } ;
+
+HELP: unique-primes
+{ $values
+    { "numbits" integer } { "n" integer }
+    { "seq" sequence }
+}
+{ $description "Generates a sequence of " { $snippet "n" } " unique prime numbers with exactly " { $snippet "numbits" } " bits." } ;
+
+ARTICLE: "math.primes" "Prime numbers"
+"The " { $vocab-link "math.primes" } " vocabulary implements words related to prime numbers. Serveral useful vocabularies exist for testing primality. The Sieve of Eratosthenes in " { $vocab-link "math.primes.erato" } " is useful for testing primality below five million. For larger integers, " { $vocab-link "math.primes.miller-rabin" } " is a fast probabilstic primality test. The " { $vocab-link "math.primes.lucas-lehmer" } " vocabulary implements an algorithm for finding huge Mersenne prime numbers." $nl
+"Testing if a number is prime:"
+{ $subsection prime? }
+"Generating prime numbers:"
+{ $subsection next-prime }
+{ $subsection primes-upto }
+{ $subsection primes-between }
+{ $subsection random-prime }
+"Generating relative prime numbers:"
+{ $subsection find-relative-prime }
+{ $subsection find-relative-prime* }
+"Make a sequence of random prime numbers:"
+{ $subsection unique-primes } ;
+
+ABOUT: "math.primes"

basis/math/primes/primes-tests.factor

@@ -1,4 +1,6 @@
-USING: arrays math.primes tools.test ;
+USING: arrays math math.primes math.primes.miller-rabin
+tools.test ;
+IN: math.primes.tests
 
 { 1237 } [ 1234 next-prime ] unit-test
 { f t } [ 1234 prime? 1237 prime? ] unit-test
@@ -7,3 +9,12 @@ USING: arrays math.primes tools.test ;
 
 { { 4999963 4999999 5000011 5000077 5000081 } }
 [ 4999962 5000082 primes-between >array ] unit-test
+
+[ 2 ] [ 1 next-prime ] unit-test
+[ 3 ] [ 2 next-prime ] unit-test
+[ 5 ] [ 3 next-prime ] unit-test
+[ 101 ] [ 100 next-prime ] unit-test
+[ t ] [ 2135623355842621559 miller-rabin ] unit-test
+[ 100000000000031 ] [ 100000000000000 next-prime ] unit-test
+
+[ 49 ] [ 50 random-prime log2 ] unit-test

basis/math/primes/primes.factor

@@ -1,7 +1,8 @@
 ! Copyright (C) 2007-2009 Samuel Tardieu.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: combinators kernel math math.functions math.miller-rabin
+USING: combinators kernel math math.bitwise math.functions
-math.order math.primes.erato math.ranges sequences ;
+math.order math.primes.erato math.primes.miller-rabin
+math.ranges random sequences sets fry ;
 IN: math.primes
 
 <PRIVATE
@@ -21,7 +22,11 @@ PRIVATE>
     } cond ; foldable
 
 : next-prime ( n -- p )
-    next-odd [ dup really-prime? ] [ 2 + ] until ; foldable
+    dup 2 < [
+        drop 2
+    ] [
+        next-odd [ dup really-prime? ] [ 2 + ] until
+    ] if ; foldable
 
 : primes-between ( low high -- seq )
     [ dup 3 max dup even? [ 1 + ] when ] dip
@@ -31,3 +36,34 @@ PRIVATE>
 : primes-upto ( n -- seq ) 2 swap primes-between ;
 
 : coprime? ( a b -- ? ) gcd nip 1 = ; foldable
+
+: random-prime ( numbits -- p )
+    random-bits* next-prime ;
+
+: estimated-primes ( m -- n )
+    dup log / ; foldable
+
+ERROR: no-relative-prime n ;
+
+<PRIVATE
+
+: (find-relative-prime) ( n guess -- p )
+    over 1 <= [ over no-relative-prime ] when
+    dup 1 <= [ drop 3 ] when
+    2dup gcd nip 1 > [ 2 + (find-relative-prime) ] [ nip ] if ;
+
+PRIVATE>
+
+: find-relative-prime* ( n guess -- p )
+    #! find a prime relative to n with initial guess
+    >odd (find-relative-prime) ;
+
+: find-relative-prime ( n -- p )
+    dup random find-relative-prime* ;
+
+ERROR: too-few-primes n numbits ;
+
+: unique-primes ( n numbits -- seq )
+    2dup 2^ estimated-primes > [ too-few-primes ] when
+    2dup '[ _ random-prime ] replicate
+    dup all-unique? [ 2nip ] [ drop unique-primes ] if ;

basis/math/primes/safe/authors.txt

@@ -0,0 +1 @@
+Doug Coleman

basis/math/primes/safe/safe-docs.factor

@@ -0,0 +1,38 @@
+! Copyright (C) 2009 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: combinators.short-circuit help.markup help.syntax kernel
+math math.functions math.primes random ;
+IN: math.primes.safe
+
+HELP: next-safe-prime
+{ $values
+    { "n" integer }
+    { "q" integer }
+}
+{ $description "Tests consecutive numbers and returns the next safe prime. A safe prime is desirable in cryptography applications such as Diffie-Hellman and SRP6." } ;
+
+HELP: random-safe-prime
+{ $values
+    { "numbits" integer }
+    { "p" integer }
+}
+{ $description "Returns a safe prime number " { $snippet "numbits" } " bits in length, with the topmost bit set to one." } ;
+
+HELP: safe-prime?
+{ $values
+    { "q" integer }
+    { "?" "a boolean" }
+}
+{ $description "Tests whether the number is a safe prime. A safe prime " { $snippet "p" } " must be prime, as must " { $snippet "(p - 1) / 2" } "." } ;
+
+
+ARTICLE: "math.primes.safe" "Safe prime numbers"
+"The " { $vocab-link "math.primes.safe" } " vocabulary implements words to calculate safe prime numbers. Safe primes are of the form p = 2q + 1, where p,q are prime. Safe primes have desirable qualities for cryptographic applications." $nl
+
+"Testing if a number is a safe prime:"
+{ $subsection safe-prime? }
+"Generating safe prime numbers:"
+{ $subsection next-safe-prime }
+{ $subsection random-safe-prime } ;
+
+ABOUT: "math.primes.safe"

basis/math/primes/safe/safe-tests.factor

@@ -0,0 +1,14 @@
+! Copyright (C) 2009 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: math.primes.safe math.primes.safe.private tools.test ;
+IN: math.primes.safe.tests
+
+[ 863 ] [ 862 next-safe-prime ] unit-test
+[ f ] [ 862 safe-prime? ] unit-test
+[ t ] [ 7 safe-prime? ] unit-test
+[ f ] [ 31 safe-prime? ] unit-test
+[ t ] [ 47 safe-prime-candidate? ] unit-test
+[ t ] [ 47 safe-prime? ] unit-test
+[ t ] [ 863 safe-prime? ] unit-test
+
+[ 47 ] [ 31 next-safe-prime ] unit-test

basis/math/primes/safe/safe.factor

@@ -0,0 +1,29 @@
+! Copyright (C) 2009 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: combinators.short-circuit kernel math math.functions
+math.primes random ;
+IN: math.primes.safe
+
+<PRIVATE
+
+: safe-prime-candidate? ( n -- ? )
+    1 + 6 divisor? ;
+
+: next-safe-prime-candidate ( n -- candidate )
+    next-prime dup safe-prime-candidate?
+    [ next-safe-prime-candidate ] unless ;
+
+PRIVATE>
+
+: safe-prime? ( q -- ? )
+    {
+        [ 1 - 2 / dup integer? [ prime? ] [ drop f ] if ]
+        [ prime? ]
+    } 1&& ;
+
+: next-safe-prime ( n -- q )
+    next-safe-prime-candidate
+    dup safe-prime? [ next-safe-prime ] unless ;
+
+: random-safe-prime ( numbits -- p )
+    random-bits* next-safe-prime ;

basis/math/rectangles/prettyprint/authors.txt

@@ -0,0 +1 @@
+Slava Pestov

basis/math/rectangles/prettyprint/prettyprint.factor

@@ -0,0 +1,7 @@
+! Copyright (C) 2009 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors math.rectangles kernel prettyprint.custom prettyprint.backend ;
+IN: math.rectangles.prettyprint
+
+M: rect pprint*
+    \ RECT: [ [ loc>> ] [ dim>> ] bi [ pprint* ] bi@ ] pprint-prefix ;

basis/math/rectangles/rectangles.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2008, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel arrays sequences math math.vectors accessors
-parser prettyprint.custom prettyprint.backend ;
+parser ;
 IN: math.rectangles
 
 TUPLE: rect { loc initial: { 0 0 } } { dim initial: { 0 0 } } ;
@@ -10,9 +10,6 @@ TUPLE: rect { loc initial: { 0 0 } } { dim initial: { 0 0 } } ;
 
 SYNTAX: RECT: scan-object scan-object <rect> parsed ;
 
-M: rect pprint*
-    \ RECT: [ [ loc>> ] [ dim>> ] bi [ pprint* ] bi@ ] pprint-prefix ;
-
 : <zero-rect> ( -- rect ) rect new ; inline
 
 : point>rect ( loc -- rect ) { 0 0 } <rect> ; inline
@@ -64,3 +61,7 @@ M: rect contains-point?
     [ [ loc>> ] dip (>>loc) ]
     [ [ dim>> ] dip (>>dim) ]
     2bi ; inline
+
+USING: vocabs vocabs.loader ;
+
+"prettyprint" vocab [ "math.rectangles.prettyprint" require ] when

basis/math/vectors/vectors-tests.factor

@@ -14,3 +14,5 @@ USING: math.vectors tools.test ;
 [ { 1.75 1.75 } ] [ { 1.0 2.5 } { 2.5 1.0 } 0.5 vnlerp ] unit-test 
 
 [ { 1.75 2.125 } ] [ { 1.0 2.5 } { 2.5 1.0 } { 0.5 0.25 } vlerp ] unit-test 
+
+[ 1.125 ] [ 0.0 1.0 2.0 4.0 { 0.5 0.25 } bilerp ] unit-test

basis/math/vectors/vectors.factor

@@ -41,6 +41,17 @@ IN: math.vectors
 : set-axis ( u v axis -- w )
     [ [ zero? 2over ? ] dip swap nth ] map-index 2nip ;
 
+: 2tetra@ ( p q r s t u v w quot -- )
+    dup [ [ 2bi@ ] curry 4dip ] dip 2bi@ ; inline
+
+: trilerp ( aaa baa aba bba aab bab abb bbb {t,u,v} -- a_tuv )
+    [ first lerp ] [ second lerp ] [ third lerp ] tri-curry
+    [ 2tetra@ ] [ 2bi@ ] [ call ] tri* ;
+
+: bilerp ( aa ba ab bb {t,u} -- a_tu )
+    [ first lerp ] [ second lerp ] bi-curry
+    [ 2bi@ ] [ call ] bi* ;
+
 : vlerp ( a b t -- a_t )
     [ lerp ] 3map ;
 
@@ -68,3 +79,6 @@ HINTS: v. { array array } ;
 
 HINTS: vlerp { array array array } ;
 HINTS: vnlerp { array array object } ;
+
+HINTS: bilerp { object object object object array } ;
+HINTS: trilerp { object object object object object object object object array } ;

basis/none/deploy.factor

@@ -6,7 +6,6 @@ H{
     { deploy-name "none" }
     { "stop-after-last-window?" t }
     { deploy-c-types? f }
-    { deploy-compiler? f }
     { deploy-io 1 }
     { deploy-ui? f }
     { deploy-reflection 1 }