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

2009-05-18 11:35:21 -05:00 · 2009-05-18 11:35:21 -05:00 · 8175d6fe2b
parent 75f03e9a18 c045823182
commit 8175d6fe2b
319 changed files with 2993 additions and 1710 deletions
--- a/basis/alien/c-types/c-types.factor
+++ b/basis/alien/c-types/c-types.factor
@ -1,11 +1,11 @@
 ! Copyright (C) 2004, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: byte-arrays arrays assocs kernel kernel.private libc math
-namespaces make parser sequences strings words assocs splitting
-math.parser cpu.architecture alien alien.accessors alien.strings
-quotations layouts system compiler.units io io.files
-io.encodings.binary io.streams.memory accessors combinators effects
-continuations fry classes ;
+namespaces make parser sequences strings words splitting math.parser
+cpu.architecture alien alien.accessors alien.strings quotations
+layouts system compiler.units io io.files io.encodings.binary
+io.streams.memory accessors combinators effects continuations fry
+classes ;
 IN: alien.c-types

 DEFER: <int>
--- a/basis/alien/complex/functor/functor.factor
+++ b/basis/alien/complex/functor/functor.factor
@ -23,7 +23,7 @@ WHERE
 : *T ( alien -- z )
    [ T-real ] [ T-imaginary ] bi rect> ; inline

-T in get
+T current-vocab
 { { N "real" } { N "imaginary" } }
 define-struct

--- a/basis/alien/fortran/fortran.factor
+++ b/basis/alien/fortran/fortran.factor
@ -421,7 +421,7 @@ PRIVATE>
 : define-fortran-record ( name vocab fields -- )
    [ >lower ] [ ] [ fortran-record>c-struct ] tri* define-struct ;

-SYNTAX: RECORD: scan in get parse-definition define-fortran-record ;
+SYNTAX: RECORD: scan current-vocab parse-definition define-fortran-record ;

 : set-fortran-abi ( library -- )
    library-fortran-abis get-global at fortran-abi set ;
--- a/basis/alien/structs/structs-docs.factor
+++ b/basis/alien/structs/structs-docs.factor
@ -1,6 +1,5 @@
-USING: accessors alien.c-types strings help.markup help.syntax
-alien.syntax sequences io arrays kernel words assocs namespaces
-accessors ;
+USING: alien.c-types strings help.markup help.syntax alien.syntax
+sequences io arrays kernel words assocs namespaces ;
 IN: alien.structs

 ARTICLE: "c-structs" "C structure types"
--- a/basis/alien/syntax/syntax.factor
+++ b/basis/alien/syntax/syntax.factor
@ -22,7 +22,7 @@ SYNTAX: TYPEDEF:
    scan scan typedef ;

 SYNTAX: C-STRUCT:
-    scan in get parse-definition define-struct ;
+    scan current-vocab parse-definition define-struct ;

 SYNTAX: C-UNION:
    scan parse-definition define-union ;
--- a/basis/bitstreams/bitstreams-tests.factor
+++ b/basis/bitstreams/bitstreams-tests.factor
@ -5,23 +5,51 @@ grouping compression.lzw multiline byte-arrays io.encodings.binary
 io.streams.byte-array ;
 IN: bitstreams.tests

-[ 1 t ]
-[ B{ 254 } binary <byte-reader> <bitstream-reader> read-bit ] unit-test

-[ 254 8 t ]
-[ B{ 254 } binary <byte-reader> <bitstream-reader> 8 swap read-bits ] unit-test
-
-[ 4095 12 t ]
-[ B{ 255 255 } binary <byte-reader> <bitstream-reader> 12 swap read-bits ] unit-test
-
-[ B{ 254 } ]
+[ BIN: 1111111111 ]
 [
-    binary <byte-writer> <bitstream-writer> 254 8 rot
-    [ write-bits ] keep stream>> >byte-array
+    B{ HEX: 0f HEX: ff HEX: ff HEX: ff } <msb0-bit-reader>
+    2 >>byte-pos 6 >>bit-pos
+    10 swap peek
 ] unit-test

-[ 255 8 t ]
-[ B{ 255 } binary <byte-reader> <bitstream-reader> 8 swap read-bits ] unit-test
+[ BIN: 111111111 ]
+[
+    B{ HEX: 0f HEX: ff HEX: ff HEX: ff } <msb0-bit-reader>
+    2 >>byte-pos 6 >>bit-pos
+    9 swap peek
+] unit-test

-[ 255 8 f ]
-[ B{ 255 } binary <byte-reader> <bitstream-reader> 9 swap read-bits ] unit-test
+[ BIN: 11111111 ]
+[
+    B{ HEX: 0f HEX: ff HEX: ff HEX: ff } <msb0-bit-reader>
+    2 >>byte-pos 6 >>bit-pos
+    8 swap peek
+] unit-test
+
+[ BIN: 1111111 ]
+[
+    B{ HEX: 0f HEX: ff HEX: ff HEX: ff } <msb0-bit-reader>
+    2 >>byte-pos 6 >>bit-pos
+    7 swap peek
+] unit-test
+
+[ BIN: 111111 ]
+[
+    B{ HEX: 0f HEX: ff HEX: ff HEX: ff } <msb0-bit-reader>
+    2 >>byte-pos 6 >>bit-pos
+    6 swap peek
+] unit-test
+
+[ BIN: 11111 ]
+[
+    B{ HEX: 0f HEX: ff HEX: ff HEX: ff } <msb0-bit-reader>
+    2 >>byte-pos 6 >>bit-pos
+    5 swap peek
+] unit-test
+
+[ B{ } <msb0-bit-reader> 5 swap peek ] must-fail
+[ B{ } <msb0-bit-reader> 1 swap peek ] must-fail
+[ B{ } <msb0-bit-reader> 8 swap peek ] must-fail
+
+[ 0 ] [ B{ } <msb0-bit-reader> 0 swap peek ] unit-test
--- a/basis/bitstreams/bitstreams.factor
+++ b/basis/bitstreams/bitstreams.factor
@ -1,96 +1,160 @@
 ! Copyright (C) 2009 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors byte-arrays destructors fry io kernel locals
-math sequences ;
+USING: accessors alien.accessors assocs byte-arrays combinators
+constructors destructors fry io io.binary io.encodings.binary
+io.streams.byte-array kernel locals macros math math.ranges
+multiline sequences sequences.private vectors byte-vectors
+combinators.short-circuit math.bitwise ;
 IN: bitstreams

-TUPLE: bitstream stream end-of-stream? current-bits #bits disposed ;
-TUPLE: bitstream-reader < bitstream ;
+TUPLE: widthed { bits integer read-only } { #bits integer read-only } ;

-: reset-bitstream ( stream -- stream )
-    0 >>#bits 0 >>current-bits ; inline
+ERROR: invalid-widthed bits #bits ;

-: new-bitstream ( stream class -- bitstream )
+: check-widthed ( bits #bits -- bits #bits )
+    dup 0 < [ invalid-widthed ] when
+    2dup { [ nip 0 = ] [ drop 0 = not ] } 2&& [ invalid-widthed ] when
+    over 0 = [
+        2dup [ dup 0 < [ neg ] when log2 1 + ] dip > [ invalid-widthed ] when
+    ] unless ;
+
+: <widthed> ( bits #bits -- widthed )
+    check-widthed
+    widthed boa ;
+
+: zero-widthed ( -- widthed ) 0 0 <widthed> ;
+: zero-widthed? ( widthed -- ? ) zero-widthed = ;
+
+TUPLE: bit-reader
+    { bytes byte-array }
+    { byte-pos array-capacity initial: 0 }
+    { bit-pos array-capacity initial: 0 } ;
+
+TUPLE: bit-writer
+    { bytes byte-vector }
+    { widthed widthed } ;
+
+TUPLE: msb0-bit-reader < bit-reader ;
+TUPLE: lsb0-bit-reader < bit-reader ;
+CONSTRUCTOR: msb0-bit-reader ( bytes -- bs ) ;
+CONSTRUCTOR: lsb0-bit-reader ( bytes -- bs ) ;
+
+TUPLE: msb0-bit-writer < bit-writer ;
+TUPLE: lsb0-bit-writer < bit-writer ;
+
+: new-bit-writer ( class -- bs )
    new
-        swap >>stream
-        reset-bitstream ; inline
+        BV{ } clone >>bytes
+        0 0 <widthed> >>widthed ; inline

-M: bitstream-reader dispose ( stream -- )
-    stream>> dispose ;
+: <msb0-bit-writer> ( -- bs )
+    msb0-bit-writer new-bit-writer ;

-: <bitstream-reader> ( stream -- bitstream )
-    bitstream-reader new-bitstream ; inline
+: <lsb0-bit-writer> ( -- bs )
+    lsb0-bit-writer new-bit-writer ;

-: read-next-byte ( bitstream -- bitstream )
-    dup stream>> stream-read1 [
-        >>current-bits 8 >>#bits
+GENERIC: peek ( n bitstream -- value )
+GENERIC: poke ( value n bitstream -- )
+
+: seek ( n bitstream -- )
+    {
+        [ byte-pos>> 8 * ]
+        [ bit-pos>> + + 8 /mod ]
+        [ (>>bit-pos) ]
+        [ (>>byte-pos) ]
+    } cleave ; inline
+
+: read ( n bitstream -- value )
+    [ peek ] [ seek ] 2bi ; inline
+
+<PRIVATE
+
+ERROR: not-enough-bits widthed n ;
+
+: widthed-bits ( widthed n -- bits )
+    dup 0 < [ not-enough-bits ] when
+    2dup [ #bits>> ] dip < [ not-enough-bits ] when
+    [ [ bits>> ] [ #bits>> ] bi ] dip
+    [ - neg shift ] keep <widthed> ;
+
+: split-widthed ( widthed n -- widthed1 widthed2 )
+    2dup [ #bits>> ] dip < [
+        drop zero-widthed
    ] [
-        0 >>#bits
-        t >>end-of-stream?
-    ] if* ;
-
-: maybe-read-next-byte ( bitstream -- bitstream )
-    dup #bits>> 0 = [ read-next-byte ] when ; inline
-
-: shift-one-bit ( bitstream -- n )
-    [ current-bits>> ] [ #bits>> ] bi 1- neg shift 1 bitand ; inline
-
-: next-bit ( bitstream -- n/f ? )
-    maybe-read-next-byte
-    dup end-of-stream?>> [
-        drop f
-    ] [
-        [ shift-one-bit ]
-        [ [ 1- ] change-#bits maybe-read-next-byte drop ] bi
-    ] if dup >boolean ;
-
-: read-bit ( bitstream -- n ? )
-    dup #bits>> 1 = [
-        [ current-bits>> 1 bitand ]
-        [ read-next-byte drop ] bi t
-    ] [
-        next-bit
-    ] if ; inline
-
-: bits>integer ( seq -- n )
-    0 [ [ 1 shift ] dip bitor ] reduce ; inline
-
-: read-bits ( width bitstream -- n width ? )
-    [
-        '[ _ read-bit drop ] replicate
-        [ f = ] trim-tail
-        [ bits>integer ] [ length ] bi
-    ] 2keep drop over = ;
-
-TUPLE: bitstream-writer < bitstream ;
-
-: <bitstream-writer> ( stream -- bitstream )
-    bitstream-writer new-bitstream ; inline
-
-: write-bit ( n bitstream -- )
-    [ 1 shift bitor ] change-current-bits
-    [ 1+ ] change-#bits
-    dup #bits>> 8 = [
-        [ [ current-bits>> ] [ stream>> stream-write1 ] bi ]
-        [ reset-bitstream drop ] bi
-    ] [
-        drop
-    ] if ; inline
-
-ERROR: invalid-bit-width n ;
-
-:: write-bits ( n width bitstream -- )
-    n 0 < [ n invalid-bit-width ] when
-    n 0 = [
-        width [ 0 bitstream write-bit ] times
-    ] [
-        width n log2 1+ dup :> n-length - [ 0 bitstream write-bit ] times
-        n-length [
-            n-length swap - 1- neg n swap shift 1 bitand
-            bitstream write-bit
-        ] each
+        [ widthed-bits ]
+        [ [ [ bits>> ] [ #bits>> ] bi ] dip - [ bits ] keep <widthed> ] 2bi
    ] if ;

-: flush-bits ( bitstream -- ) stream>> stream-flush ;
+: widthed>bytes ( widthed -- bytes widthed )
+    [ 8 split-widthed dup zero-widthed? not ]
+    [ swap bits>> ] B{ } produce-as nip swap ;

-: bitstream-output ( bitstream -- bytes ) stream>> >byte-array ;
+:: |widthed ( widthed1 widthed2 -- widthed3 )
+    widthed1 bits>> :> bits1
+    widthed1 #bits>> :> #bits1
+    widthed2 bits>> :> bits2
+    widthed2 #bits>> :> #bits2
+    bits1 #bits2 shift bits2 bitor
+    #bits1 #bits2 + <widthed> ;
+
+PRIVATE>
+
+M:: lsb0-bit-writer poke ( value n bs -- )
+    value n <widthed> :> widthed
+    widthed
+    bs widthed>> #bits>> 8 swap - split-widthed :> remainder :> byte
+    byte bs widthed>> |widthed :> new-byte
+    new-byte #bits>> 8 = [
+        new-byte bits>> bs bytes>> push
+        zero-widthed bs (>>widthed)
+        remainder widthed>bytes
+        [ bs bytes>> push-all ] [ bs (>>widthed) ] bi*
+    ] [
+        byte bs (>>widthed)
+    ] if ;
+
+: enough-bits? ( n bs -- ? )
+    [ bytes>> length ]
+    [ byte-pos>> - 8 * ]
+    [ bit-pos>> - ] tri <= ;
+
+ERROR: not-enough-bits n bit-reader ;
+
+: #bits>#bytes ( #bits -- #bytes )
+    8 /mod 0 = [ 1 + ] unless ; inline
+
+:: subseq>bits-le ( bignum n bs -- bits )
+    bignum bs bit-pos>> neg shift n bits ;
+
+:: subseq>bits-be ( bignum n bs -- bits )
+    bignum 
+    8 bs bit-pos>> - n - 8 mod dup 0 < [ 8 + ] when
+    neg shift n bits ;
+
+:: adjust-bits ( n bs -- )
+    n 8 /mod :> #bits :> #bytes
+    bs [ #bytes + ] change-byte-pos
+    bit-pos>> #bits + dup 8 >= [
+        8 - bs (>>bit-pos)
+        bs [ 1 + ] change-byte-pos drop
+    ] [
+        bs (>>bit-pos)
+    ] if ;
+
+:: (peek) ( n bs endian> subseq-endian -- bits )
+    n bs enough-bits? [ n bs not-enough-bits ] unless
+    bs [ byte-pos>> ] [ bit-pos>> n + ] bi #bits>#bytes dupd +
+    bs bytes>> subseq endian> execute( seq -- x ) :> bignum
+    bignum n bs subseq-endian execute( bignum n bs -- bits ) ;
+
+M: lsb0-bit-reader peek ( n bs -- bits ) \ le> \ subseq>bits-le (peek) ;
+
+M: msb0-bit-reader peek ( n bs -- bits ) \ be> \ subseq>bits-be (peek) ;
+
+:: bit-writer-bytes ( writer -- bytes )
+    writer widthed>> #bits>> :> n
+    n 0 = [
+        writer widthed>> bits>> 8 n - shift
+        writer bytes>> swap push
+    ] unless
+    writer bytes>> ;
--- a/basis/bootstrap/compiler/compiler.factor
+++ b/basis/bootstrap/compiler/compiler.factor
@ -1,13 +1,14 @@
 ! Copyright (C) 2007, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors compiler cpu.architecture vocabs.loader system
+USING: accessors cpu.architecture vocabs.loader system
 sequences namespaces parser kernel kernel.private classes
 classes.private arrays hashtables vectors classes.tuple sbufs
 hashtables.private sequences.private math classes.tuple.private
 growable namespaces.private assocs words command-line vocabs io
-io.encodings.string libc splitting math.parser memory
-compiler.units math.order compiler.tree.builder
-compiler.tree.optimizer compiler.cfg.optimizer ;
+io.encodings.string libc splitting math.parser memory compiler.units
+math.order compiler.tree.builder compiler.tree.optimizer
+compiler.cfg.optimizer ;
+FROM: compiler => enable-optimizer compile-word ;
 IN: bootstrap.compiler

 ! Don't bring this in when deploying, since it will store a
--- a/basis/bootstrap/image/image.factor
+++ b/basis/bootstrap/image/image.factor
@ -1,15 +1,14 @@
 ! Copyright (C) 2004, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: alien arrays byte-arrays generic assocs hashtables assocs
-hashtables.private io io.binary io.files io.encodings.binary
-io.pathnames kernel kernel.private math namespaces make parser
-prettyprint sequences sequences.private strings sbufs vectors words
-quotations assocs system layouts splitting grouping growable classes
-classes.builtin classes.tuple classes.tuple.private vocabs
-vocabs.loader source-files definitions debugger quotations.private
-sequences.private combinators math.order math.private accessors
-slots.private generic.single.private compiler.units compiler.constants
-fry bootstrap.image.syntax ;
+USING: alien arrays byte-arrays generic hashtables hashtables.private
+io io.binary io.files io.encodings.binary io.pathnames kernel
+kernel.private math namespaces make parser prettyprint sequences
+strings sbufs vectors words quotations assocs system layouts splitting
+grouping growable classes classes.builtin classes.tuple
+classes.tuple.private vocabs vocabs.loader source-files definitions
+debugger quotations.private combinators math.order math.private
+accessors slots.private generic.single.private compiler.units
+compiler.constants fry bootstrap.image.syntax ;
 IN: bootstrap.image

 : arch ( os cpu -- arch )
--- a/basis/calendar/format/format.factor
+++ b/basis/calendar/format/format.factor
@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: math math.order math.parser math.functions kernel
 sequences io accessors arrays io.streams.string splitting
-combinators accessors calendar calendar.format.macros present ;
+combinators calendar calendar.format.macros present ;
 IN: calendar.format

 : pad-00 ( n -- str ) number>string 2 CHAR: 0 pad-head ;
--- a/basis/channels/channels.factor
+++ b/basis/channels/channels.factor
@ -3,7 +3,7 @@
 !
 ! Channels - based on ideas from newsqueak
 USING: kernel sequences threads continuations
-random math accessors random ;
+random math accessors ;
 IN: channels

 TUPLE: channel receivers senders ;
--- a/basis/checksums/adler-32/adler-32.factor
+++ b/basis/checksums/adler-32/adler-32.factor
@ -10,6 +10,6 @@ CONSTANT: adler-32-modulus 65521

 M: adler-32 checksum-bytes ( bytes checksum -- value )
    drop
-    [ sum 1+ ]
+    [ sum 1 + ]
    [ [ dup length [1,b] <reversed> v. ] [ length ] bi + ] bi
    [ adler-32-modulus mod ] bi@ 16 shift bitor ;
--- a/basis/checksums/hmac/authors.txt
+++ b/basis/checksums/hmac/authors.txt
--- a/basis/checksums/hmac/hmac-tests.factor
+++ b/basis/checksums/hmac/hmac-tests.factor
@ -0,0 +1,48 @@
+USING: kernel io strings byte-arrays sequences namespaces math
+parser checksums.hmac tools.test checksums.md5 checksums.sha
+checksums ;
+IN: checksums.hmac.tests
+
+[
+    "\u000092\u000094rz68\u0000bb\u00001c\u000013\u0000f4\u00008e\u0000f8\u000015\u00008b\u0000fc\u00009d"
+] [
+    16 11 <string> "Hi There" md5 hmac-bytes >string ] unit-test
+
+[ "u\u00000cx>j\u0000b0\u0000b5\u000003\u0000ea\u0000a8n1\n]\u0000b78" ]
+[ "Jefe" "what do ya want for nothing?" md5 hmac-bytes >string ] unit-test
+
+[
+    "V\u0000be4R\u00001d\u000014L\u000088\u0000db\u0000b8\u0000c73\u0000f0\u0000e8\u0000b3\u0000f6"
+]
+[
+    16 HEX: aa <string>
+    50 HEX: dd <repetition> md5 hmac-bytes >string
+] unit-test
+
+[
+    "g[\u00000b:\eM\u0000dfN\u000012Hr\u0000dal/c+\u0000fe\u0000d9W\u0000e9"
+] [
+    16 11 <string> "Hi There" sha1 hmac-bytes >string
+] unit-test
+
+[
+    "\u0000ef\u0000fc\u0000dfj\u0000e5\u0000eb/\u0000a2\u0000d2t\u000016\u0000d5\u0000f1\u000084\u0000df\u00009c%\u00009a|y"
+] [
+    "Jefe" "what do ya want for nothing?" sha1 hmac-bytes >string
+] unit-test
+
+[
+    "\u0000d70YM\u000016~5\u0000d5\u000095o\u0000d8\0=\r\u0000b3\u0000d3\u0000f4m\u0000c7\u0000bb"
+] [
+    16 HEX: aa <string>
+    50 HEX: dd <repetition> sha1 hmac-bytes >string
+] unit-test
+
+[ "b0344c61d8db38535ca8afceaf0bf12b881dc200c9833da726e9376c2e32cff7" ]
+[ 20 HEX: b <string> "Hi There" sha-256 hmac-bytes hex-string ] unit-test
+
+[ "167f928588c5cc2eef8e3093caa0e87c9ff566a14794aa61648d81621a2a40c6" ]
+[
+    "JefeJefeJefeJefeJefeJefeJefeJefe"
+    "what do ya want for nothing?" sha-256 hmac-bytes hex-string
+] unit-test
--- a/basis/checksums/hmac/hmac.factor
+++ b/basis/checksums/hmac/hmac.factor
@ -0,0 +1,39 @@
+! Copyright (C) 2008 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors arrays checksums combinators fry io io.binary
+io.encodings.binary io.files io.streams.byte-array kernel
+locals math math.vectors memoize sequences ;
+IN: checksums.hmac
+
+<PRIVATE
+
+: seq-bitxor ( seq seq -- seq ) [ bitxor ] 2map ;
+
+: opad ( checksum-state -- seq ) block-size>> HEX: 5c <array> ;
+
+: ipad ( checksum-state -- seq ) block-size>> HEX: 36 <array> ;
+
+:: init-K ( K checksum checksum-state -- o i )
+    checksum-state block-size>> K length <
+    [ K checksum checksum-bytes ] [ K ] if
+    checksum-state block-size>> 0 pad-tail 
+    [ checksum-state opad seq-bitxor ]
+    [ checksum-state ipad seq-bitxor ] bi ;
+
+PRIVATE>
+
+:: hmac-stream ( K stream checksum -- value )
+    K checksum dup initialize-checksum-state
+        dup :> checksum-state
+        init-K :> Ki :> Ko
+    checksum-state Ki add-checksum-bytes
+    stream add-checksum-stream get-checksum
+    checksum initialize-checksum-state
+    Ko add-checksum-bytes swap add-checksum-bytes
+    get-checksum ;
+
+: hmac-file ( K path checksum -- value )
+    [ binary <file-reader> ] dip hmac-stream ;
+
+: hmac-bytes ( K seq checksum -- value )
+    [ binary <byte-reader> ] dip hmac-stream ;
--- a/basis/checksums/interleave/authors.txt
+++ b/basis/checksums/interleave/authors.txt
@ -0,0 +1 @@
+Doug Coleman
--- a/basis/checksums/interleave/interleave-tests.factor
+++ b/basis/checksums/interleave/interleave-tests.factor
@ -0,0 +1,19 @@
+! Copyright (C) 2009 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: tools.test checksums.interleave checksums.sha ;
+IN: checksums.interleave.tests
+
+[
+    B{
+        59 155 253 205 75 163 94 115 208 42 227 92 181 19 60 232
+        119 65 178 131 210 48 241 230 204 216 30 156 4 215 80 84 93
+        206 44 1 18 128 150 153
+    }
+] [
+    B{
+        102 83 241 12 26 250 181 76 97 200 37 117 168 74 254 48 216
+        170 26 58 150 150 179 24 153 146 191 225 203 127 166 167
+    }
+    sha1 interleaved-checksum
+] unit-test
+
--- a/basis/checksums/interleave/interleave.factor
+++ b/basis/checksums/interleave/interleave.factor
@ -0,0 +1,17 @@
+! Copyright (C) 2009 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: assocs checksums grouping kernel locals math sequences ;
+IN: checksums.interleave
+
+: seq>2seq ( seq -- seq1 seq2 )
+    #! { abcdefgh } -> { aceg } { bdfh }
+    2 group flip [ { } { } ] [ first2 ] if-empty ;
+
+: 2seq>seq ( seq1 seq2 -- seq )
+    #! { aceg } { bdfh } -> { abcdefgh }
+    [ zip concat ] keep like ;
+
+:: interleaved-checksum ( bytes checksum -- seq )
+    bytes [ zero? ] trim-head
+    dup length odd? [ rest-slice ] when
+    seq>2seq [ checksum checksum-bytes ] bi@ 2seq>seq ;
--- a/basis/checksums/md5/md5-tests.factor
+++ b/basis/checksums/md5/md5-tests.factor
@ -1,4 +1,6 @@
-USING: kernel math namespaces checksums checksums.md5 tools.test byte-arrays ;
+USING: byte-arrays checksums checksums.md5 io.encodings.binary
+io.streams.byte-array kernel math namespaces tools.test ;
+

 [ "d41d8cd98f00b204e9800998ecf8427e" ] [ "" >byte-array md5 checksum-bytes hex-string ] unit-test
 [ "0cc175b9c0f1b6a831c399e269772661" ] [ "a" >byte-array md5 checksum-bytes hex-string ] unit-test
@ -8,3 +10,24 @@ USING: kernel math namespaces checksums checksums.md5 tools.test byte-arrays ;
 [ "d174ab98d277d9f5a5611c2c9f419d9f" ] [ "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789" >byte-array md5 checksum-bytes hex-string ] unit-test
 [ "57edf4a22be3c955ac49da2e2107b67a" ] [ "12345678901234567890123456789012345678901234567890123456789012345678901234567890" >byte-array md5 checksum-bytes hex-string ] unit-test

+
+[
+    t
+] [
+    <md5-state> "asdf" add-checksum-bytes
+    [ get-checksum ] [ get-checksum ] bi =
+] unit-test
+
+[
+    t
+] [
+    <md5-state> "" add-checksum-bytes
+    [ get-checksum ] [ get-checksum ] bi =
+] unit-test
+
+[
+    t
+] [
+    <md5-state> "asdf" binary <byte-reader> add-checksum-stream
+    [ get-checksum ] [ get-checksum ] bi =
+] unit-test
--- a/basis/checksums/md5/md5.factor
+++ b/basis/checksums/md5/md5.factor
@ -3,57 +3,53 @@
 USING: kernel io io.binary io.files io.streams.byte-array math
 math.functions math.parser namespaces splitting grouping strings
 sequences byte-arrays locals sequences.private macros fry
-io.encodings.binary math.bitwise checksums
-checksums.common checksums.stream combinators ;
+io.encodings.binary math.bitwise checksums accessors
+checksums.common checksums.stream combinators combinators.smart
+specialized-arrays.uint literals ;
 IN: checksums.md5

-! See http://www.faqs.org/rfcs/rfc1321.html
+SINGLETON: md5
+
+INSTANCE: md5 stream-checksum
+
+TUPLE: md5-state < checksum-state state old-state ;
+
+: <md5-state> ( -- md5 )
+    md5-state new-checksum-state
+        64 >>block-size
+        uint-array{ HEX: 67452301 HEX: efcdab89 HEX: 98badcfe HEX: 10325476 }
+        [ clone >>state ] [ >>old-state ] bi ;
+
+M: md5 initialize-checksum-state drop <md5-state> ;

 <PRIVATE

-SYMBOLS: a b c d old-a old-b old-c old-d ;
+: v-w+ ( v1 v2 -- v3 ) [ w+ ] 2map ;

-: T ( N -- Y )
-    sin abs 32 2^ * >integer ; foldable
+: update-md5 ( md5 -- )
+    [ state>> ] [ old-state>> v-w+ dup clone ] [ ] tri
+    [ (>>old-state) ] [ (>>state) ] bi ; inline

-: initialize-md5 ( -- )
-    0 bytes-read set
-    HEX: 67452301 dup a set old-a set
-    HEX: efcdab89 dup b set old-b set
-    HEX: 98badcfe dup c set old-c set
-    HEX: 10325476 dup d set old-d set ;
+CONSTANT: T
+    $[
+        80 iota [ sin abs 32 2^ * >integer ] uint-array{ } map-as
+    ]

-: update-md ( -- )
-    old-a a update-old-new
-    old-b b update-old-new
-    old-c c update-old-new
-    old-d d update-old-new ;
-
-:: (ABCD) ( x a b c d k s i func -- )
-    #! a = b + ((a + F(b,c,d) + X[k] + T[i]) <<< s)
-    a [
-        b get c get d get func call w+
-        k x nth-unsafe w+
-        i T w+
-        s bitroll-32
-        b get w+
-    ] change ; inline
-
-: F ( X Y Z -- FXYZ )
+:: F ( X Y Z -- FXYZ )
    #! F(X,Y,Z) = XY v not(X) Z
-    pick bitnot bitand [ bitand ] [ bitor ] bi* ;
+    X Y bitand X bitnot Z bitand bitor ; inline

-: G ( X Y Z -- GXYZ )
+:: G ( X Y Z -- GXYZ )
    #! G(X,Y,Z) = XZ v Y not(Z)
-    dup bitnot rot bitand [ bitand ] [ bitor ] bi* ;
+    X Z bitand Y Z bitnot bitand bitor ; inline

 : H ( X Y Z -- HXYZ )
    #! H(X,Y,Z) = X xor Y xor Z
-    bitxor bitxor ;
+    bitxor bitxor ; inline

-: I ( X Y Z -- IXYZ )
+:: I ( X Y Z -- IXYZ )
    #! I(X,Y,Z) = Y xor (X v not(Z))
-    rot swap bitnot bitor bitxor ;
+    Z bitnot X bitor Y bitxor ; inline

 CONSTANT: S11 7
 CONSTANT: S12 12
@ -72,10 +68,27 @@ CONSTANT: S42 10
 CONSTANT: S43 15
 CONSTANT: S44 21

-MACRO: with-md5-round ( ops func -- )
-    '[ [ _ (ABCD) ] compose ] map '[ _ cleave ] ;
+CONSTANT: a 0
+CONSTANT: b 1
+CONSTANT: c 2
+CONSTANT: d 3

-: (process-md5-block-F) ( block -- )
+:: (ABCD) ( x state a b c d k s i quot -- )
+    #! a = b + ((a + F(b,c,d) + X[k] + T[i]) <<< s)
+    a state [
+        b state nth-unsafe
+        c state nth-unsafe
+        d state nth-unsafe quot call w+
+        k x nth-unsafe w+
+        i T nth-unsafe w+
+        s bitroll-32
+        b state nth-unsafe w+ 32 bits
+    ] change-nth-unsafe ; inline
+
+MACRO: with-md5-round ( ops quot -- )
+    '[ [ _ (ABCD) ] compose ] map '[ _ 2cleave ] ;
+
+: (process-md5-block-F) ( block state -- )
    {
        [ a b c d 0  S11 1  ]
        [ d a b c 1  S12 2  ]
@ -93,9 +106,9 @@ MACRO: with-md5-round ( ops func -- )
        [ d a b c 13 S12 14 ]
        [ c d a b 14 S13 15 ]
        [ b c d a 15 S14 16 ]
-    } [ F ] with-md5-round ;
+    } [ F ] with-md5-round ; inline

-: (process-md5-block-G) ( block -- )
+: (process-md5-block-G) ( block state -- )
    {
        [ a b c d 1  S21 17 ]
        [ d a b c 6  S22 18 ]
@ -113,9 +126,9 @@ MACRO: with-md5-round ( ops func -- )
        [ d a b c 2  S22 30 ]
        [ c d a b 7  S23 31 ]
        [ b c d a 12 S24 32 ]
-    } [ G ] with-md5-round ;
+    } [ G ] with-md5-round ; inline

-: (process-md5-block-H) ( block -- )
+: (process-md5-block-H) ( block state -- )
    {
        [ a b c d 5  S31 33 ]
        [ d a b c 8  S32 34 ]
@ -133,9 +146,9 @@ MACRO: with-md5-round ( ops func -- )
        [ d a b c 12 S32 46 ]
        [ c d a b 15 S33 47 ]
        [ b c d a 2  S34 48 ]
-    } [ H ] with-md5-round ;
+    } [ H ] with-md5-round ; inline

-: (process-md5-block-I) ( block -- )
+: (process-md5-block-I) ( block state -- )
    {
        [ a b c d 0  S41 49 ]
        [ d a b c 7  S42 50 ]
@ -153,38 +166,33 @@ MACRO: with-md5-round ( ops func -- )
        [ d a b c 11 S42 62 ]
        [ c d a b 2  S43 63 ]
        [ b c d a 9  S44 64 ]
-    } [ I ] with-md5-round ;
+    } [ I ] with-md5-round ; inline

-: (process-md5-block) ( block -- )
-    4 <groups> [ le> ] map {
-        [ (process-md5-block-F) ]
-        [ (process-md5-block-G) ]
-        [ (process-md5-block-H) ]
-        [ (process-md5-block-I) ]
-    } cleave
-
-    update-md ;
-
-: process-md5-block ( str -- )
-    dup length [ bytes-read [ + ] change ] keep 64 = [
-        (process-md5-block)
+M: md5-state checksum-block ( block state -- )
+    [
+        [ byte-array>uint-array ] [ state>> ] bi* {
+            [ (process-md5-block-F) ]
+            [ (process-md5-block-G) ]
+            [ (process-md5-block-H) ]
+            [ (process-md5-block-I) ]
+        } 2cleave
    ] [
-        f bytes-read get pad-last-block
-        [ (process-md5-block) ] each
-    ] if ;
-    
-: stream>md5 ( -- )
-    64 read [ process-md5-block ] keep
-    length 64 = [ stream>md5 ] when ;
+        nip update-md5
+    ] 2bi ;

-: get-md5 ( -- str )
-    [ a b c d ] [ get 4 >le ] map concat >byte-array ;
+: md5>checksum ( md5 -- bytes ) state>> underlying>> ;
+
+M: md5-state clone ( md5 -- new-md5 )
+    call-next-method
+    [ clone ] change-state
+    [ clone ] change-old-state ;
+
+M: md5-state get-checksum ( md5 -- bytes )
+    clone [ bytes>> f ] [ bytes-read>> pad-last-block ] [ ] tri
+    [ [ checksum-block ] curry each ] [ md5>checksum ] bi ;
+
+M: md5 checksum-stream ( stream checksum -- byte-array )
+    drop
+    [ <md5-state> ] dip add-checksum-stream get-checksum ;

 PRIVATE>
-
-SINGLETON: md5
-
-INSTANCE: md5 stream-checksum
-
-M: md5 checksum-stream ( stream -- byte-array )
-    drop [ initialize-md5 stream>md5 get-md5 ] with-input-stream ;
--- a/basis/checksums/openssl/openssl-docs.factor
+++ b/basis/checksums/openssl/openssl-docs.factor
@ -30,8 +30,8 @@ ARTICLE: "checksums.openssl" "OpenSSL checksums"
 "An error thrown if the digest name is unrecognized:"
 { $subsection unknown-digest }
 "An example where we compute the SHA1 checksum of a string using the OpenSSL implementation of SHA1:"
-{ $example "USING: byte-arrays checksums checksums.openssl prettyprint ;" "\"hello world\" >byte-array openssl-sha1 checksum-bytes hex-string ." "\"2aae6c35c94fcfb415dbe95f408b9ce91ee846ed\"" }
+{ $example "USING: byte-arrays checksums checksums.openssl ;" "\"hello world\" >byte-array openssl-sha1 checksum-bytes hex-string ." "\"2aae6c35c94fcfb415dbe95f408b9ce91ee846ed\"" }
 "If we use the Factor implementation, we get the same result, just slightly slower:"
-{ $example "USING: byte-arrays checksums checksums.sha1 prettyprint ;" "\"hello world\" >byte-array sha1 checksum-bytes hex-string ." "\"2aae6c35c94fcfb415dbe95f408b9ce91ee846ed\"" } ;
+{ $example "USING: byte-arrays checksums checksums.sha ;" "\"hello world\" >byte-array sha1 checksum-bytes hex-string ." "\"2aae6c35c94fcfb415dbe95f408b9ce91ee846ed\"" } ;

 ABOUT: "checksums.openssl"
--- a/basis/checksums/openssl/openssl-tests.factor
+++ b/basis/checksums/openssl/openssl-tests.factor
@ -1,6 +1,6 @@
+USING: accessors byte-arrays checksums checksums.openssl
+combinators.short-circuit kernel system tools.test ;
 IN: checksums.openssl.tests
-USING: byte-arrays checksums.openssl checksums tools.test
-accessors kernel system ;

 [
    B{ 201 238 222 100 92 200 182 188 138 255 129 163 115 88 240 136 }
@ -22,7 +22,7 @@ accessors kernel system ;
    "Bad checksum test" >byte-array
    "no such checksum" <openssl-checksum>
    checksum-bytes
-] [ [ unknown-digest? ] [ name>> "no such checksum" = ] bi and ]
+] [ { [ unknown-digest? ] [ name>> "no such checksum" = ] } 1&& ]
 must-fail-with

 [ ] [ image openssl-sha1 checksum-file drop ] unit-test
--- a/basis/checksums/sha2/authors.txt
+++ b/basis/checksums/sha2/authors.txt
--- a/basis/checksums/sha/sha-docs.factor
+++ b/basis/checksums/sha/sha-docs.factor
@ -0,0 +1,18 @@
+USING: help.markup help.syntax ;
+IN: checksums.sha
+
+HELP: sha-224
+{ $class-description "SHA-224 checksum algorithm." } ;
+
+HELP: sha-256
+{ $class-description "SHA-256 checksum algorithm." } ;
+
+ARTICLE: "checksums.sha" "SHA-2 checksum"
+"The SHA family of checksum algorithms are one-way hashes useful for checksumming data. SHA-1 is considered insecure, while SHA-2 It is generally considered to be pretty strong." $nl
+"SHA-2 checksums:"
+{ $subsection sha-224 }
+{ $subsection sha-256 }
+"SHA-1 checksum:"
+{ $subsection sha1 } ;
+
+ABOUT: "checksums.sha"
--- a/basis/checksums/sha2/sha2-tests.factor
+++ b/basis/checksums/sha2/sha2-tests.factor
@ -1,10 +1,18 @@
-USING: arrays kernel math namespaces sequences tools.test
-checksums.sha2 checksums ;
-IN: checksums.sha2.tests
+USING: arrays checksums checksums.sha checksums.sha.private
+io.encodings.binary io.streams.byte-array kernel math
+namespaces sequences tools.test ;
+IN: checksums.sha.tests

 : test-checksum ( text identifier -- checksum )
    checksum-bytes hex-string ;

+[ "a9993e364706816aba3e25717850c26c9cd0d89d" ] [ "abc" sha1 checksum-bytes hex-string ] unit-test
+[ "84983e441c3bd26ebaae4aa1f95129e5e54670f1" ] [ "abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq" sha1 checksum-bytes hex-string ] unit-test
+! [ "34aa973cd4c4daa4f61eeb2bdbad27316534016f" ] [ 1000000 CHAR: a fill string>sha1str ] unit-test ! takes a long time...
+[ "dea356a2cddd90c7a7ecedc5ebb563934f460452" ] [ "0123456701234567012345670123456701234567012345670123456701234567"
+10 swap <array> concat sha1 checksum-bytes hex-string ] unit-test
+
+
 [ "75388b16512776cc5dba5da1fd890150b0c6455cb4f58b1952522525" ]
 [
    "abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq"
@ -36,7 +44,27 @@ IN: checksums.sha2.tests
 ] unit-test


-
-
 ! [ "8e959b75dae313da8cf4f72814fc143f8f7779c6eb9f7fa17299aeadb6889018501d289e4900f7e4331b99dec4b5433ac7d329eeb6dd26545e96e55b874be909" ]
 ! [ "abcdefghbcdefghicdefghijdefghijkefghijklfghijklmghijklmnhijklmnoijklmnopjklmnopqklmnopqrlmnopqrsmnopqrstnopqrstu" sha-512 test-checksum ] unit-test
+
+[
+    t
+] [
+    <sha1-state> "asdf" binary <byte-reader> add-checksum-stream
+    [ get-checksum ] [ get-checksum ] bi =
+] unit-test
+
+[
+    t
+] [
+    <sha-256-state> "asdf" binary <byte-reader> add-checksum-stream
+    [ get-checksum ] [ get-checksum ] bi =
+] unit-test
+
+[
+    t
+] [
+    <sha-224-state> "asdf" binary <byte-reader> add-checksum-stream
+    [ get-checksum ] [ get-checksum ] bi =
+] unit-test
+
--- a/basis/checksums/sha2/sha2.factor
+++ b/basis/checksums/sha2/sha2.factor
@ -3,16 +3,40 @@
 USING: kernel splitting grouping math sequences namespaces make
 io.binary math.bitwise checksums checksums.common
 sbufs strings combinators.smart math.ranges fry combinators
-accessors locals ;
-IN: checksums.sha2
+accessors locals checksums.stream multiline literals
+generalizations ;
+IN: checksums.sha
+
+SINGLETON: sha1
+INSTANCE: sha1 stream-checksum

 SINGLETON: sha-224
 SINGLETON: sha-256

-INSTANCE: sha-224 checksum
-INSTANCE: sha-256 checksum
+INSTANCE: sha-224 stream-checksum
+INSTANCE: sha-256 stream-checksum

-TUPLE: sha2-state K H word-size block-size ;
+TUPLE: sha1-state < checksum-state K H W word-size ;
+
+CONSTANT: initial-H-sha1
+    { 
+        HEX: 67452301
+        HEX: efcdab89
+        HEX: 98badcfe
+        HEX: 10325476
+        HEX: c3d2e1f0
+    }
+
+CONSTANT: K-sha1
+    $[
+        20 HEX: 5a827999 <repetition>
+        20 HEX: 6ed9eba1 <repetition>
+        20 HEX: 8f1bbcdc <repetition>
+        20 HEX: ca62c1d6 <repetition> 
+        4 { } nappend-as
+    ]
+
+TUPLE: sha2-state < checksum-state K H word-size ;

 TUPLE: sha2-short < sha2-state ;

@ -22,6 +46,11 @@ TUPLE: sha-224-state < sha2-short ;

 TUPLE: sha-256-state < sha2-short ;

+M: sha2-state clone
+    call-next-method
+    [ clone ] change-H
+    [ clone ] change-K ;
+
 <PRIVATE

 CONSTANT: a 0
@ -116,6 +145,33 @@ CONSTANT: K-384

 ALIAS: K-512 K-384

+: <sha1-state> ( -- sha1-state )
+    sha1-state new-checksum-state
+        64 >>block-size
+        K-sha1 >>K
+        initial-H-sha1 >>H
+        4 >>word-size ;
+
+: <sha-224-state> ( -- sha2-state )
+    sha-224-state new-checksum-state
+        64 >>block-size
+        K-256 >>K
+        initial-H-224 >>H
+        4 >>word-size ;
+
+: <sha-256-state> ( -- sha2-state )
+    sha-256-state new-checksum-state
+        64 >>block-size
+        K-256 >>K
+        initial-H-256 >>H
+        4 >>word-size ;
+
+M: sha1 initialize-checksum-state drop <sha1-state> ;
+
+M: sha-224 initialize-checksum-state drop <sha-224-state> ;
+
+M: sha-256 initialize-checksum-state drop <sha-256-state> ;
+
 : s0-256 ( x -- x' )
    [
        [ -7 bitroll-32 ]
@ -172,7 +228,7 @@ ALIAS: K-512 K-384
        [ -41 bitroll-64 ] tri
    ] [ bitxor ] reduce-outputs ; inline

-: process-M-256 ( n seq -- )
+: prepare-M-256 ( n seq -- )
    {
        [ [ 16 - ] dip nth ]
        [ [ 15 - ] dip nth s0-256 ]
@ -181,7 +237,7 @@ ALIAS: K-512 K-384
        [ ]
    } 2cleave set-nth ; inline

-: process-M-512 ( n seq -- )
+: prepare-M-512 ( n seq -- )
    {
        [ [ 16 - ] dip nth ]
        [ [ 15 - ] dip nth s0-512 ]
@ -201,26 +257,6 @@ ALIAS: K-512 K-384

 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 +
@ -257,7 +293,7 @@ M: sha2-long pad-initial-bytes ( string sha2 -- padded-string )
    [ word-size>> <sliced-groups> [ be> ] map ]
    [
        block-size>> [ 0 pad-tail 16 ] keep [a,b) over
-        '[ _ process-M-256 ] each
+        '[ _ prepare-M-256 ] each
    ] bi ; inline

 :: process-chunk ( M block-size cloned-H sha2 -- )
@ -266,41 +302,110 @@ M: sha2-long pad-initial-bytes ( string sha2 -- padded-string )
        cloned-H T2-256
        cloned-H update-H
    ] each
-    cloned-H sha2 H>> [ w+ ] 2map sha2 (>>H) ; inline
+    sha2 [ cloned-H [ w+ ] 2map ] change-H drop ; inline

-: sha2-steps ( sliced-groups state -- )
-    '[
-        _
-        [ prepare-message-schedule ]
-        [ [ block-size>> ] [ H>> clone ] [ ] tri process-chunk ] bi
-    ] each ;
+M: sha2-short checksum-block
+    [ prepare-message-schedule ]
+    [ [ block-size>> ] [ H>> clone ] [ ] tri process-chunk ] bi ;

-: byte-array>sha2 ( bytes state -- )
-    [ [ pad-initial-bytes ] [ nip block-size>> ] 2bi <sliced-groups> ]
-    [ sha2-steps ] bi ;
+: seq>byte-array ( seq n -- string )
+    '[ _ >be ] map B{ } join ;

-: <sha-224-state> ( -- sha2-state )
-    sha-224-state new
-        K-256 >>K
-        initial-H-224 >>H
-        4 >>word-size
-        64 >>block-size ;
+: sha1>checksum ( sha2 -- bytes )
+    H>> 4 seq>byte-array ;

-: <sha-256-state> ( -- sha2-state )
-    sha-256-state new
-        K-256 >>K
-        initial-H-256 >>H
-        4 >>word-size
-        64 >>block-size ;
+: sha-224>checksum ( sha2 -- bytes )
+    H>> 7 head 4 seq>byte-array ;
+
+: sha-256>checksum ( sha2 -- bytes )
+    H>> 4 seq>byte-array ;
+
+: pad-last-short-block ( state -- )
+    [ bytes>> t ] [ bytes-read>> pad-last-block ] [ ] tri
+    [ checksum-block ] curry each ;

 PRIVATE>

-M: sha-224 checksum-bytes
-    drop <sha-224-state>
-    [ byte-array>sha2 ]
-    [ H>> 7 head 4 seq>byte-array ] bi ;
+M: sha-224-state get-checksum
+    clone
+    [ pad-last-short-block ] [ sha-224>checksum ] bi ;

-M: sha-256 checksum-bytes
-    drop <sha-256-state>
-    [ byte-array>sha2 ]
-    [ H>> 4 seq>byte-array ] bi ;
+M: sha-256-state get-checksum
+    clone
+    [ pad-last-short-block ] [ sha-256>checksum ] bi ;
+
+M: sha-224 checksum-stream ( stream checksum -- byte-array )
+    drop
+    [ <sha-224-state> ] dip add-checksum-stream get-checksum ;
+
+M: sha-256 checksum-stream ( stream checksum -- byte-array )
+    drop
+    [ <sha-256-state> ] dip add-checksum-stream get-checksum ;
+
+
+
+: sha1-W ( t seq -- )
+    {
+        [ [ 3 - ] dip nth ]
+        [ [ 8 - ] dip nth bitxor ]
+        [ [ 14 - ] dip nth bitxor ]
+        [ [ 16 - ] dip nth bitxor 1 bitroll-32 ]
+        [ ]
+    } 2cleave set-nth ;
+
+: prepare-sha1-message-schedule ( seq -- w-seq )
+    4 <sliced-groups> [ be> ] map
+    80 0 pad-tail 16 80 [a,b) over
+    '[ _ sha1-W ] each ; inline
+
+: sha1-f ( B C D n -- f_nbcd )
+    20 /i
+    {
+        { 0 [ [ over bitnot ] dip bitand [ bitand ] dip bitor ] }
+        { 1 [ bitxor bitxor ] }
+        { 2 [ 2dup bitand [ pick bitand [ bitand ] dip ] dip bitor bitor ] }
+        { 3 [ bitxor bitxor ] }
+    } case ;
+
+:: inner-loop ( n H W K -- temp )
+    a H nth :> A
+    b H nth :> B
+    c H nth :> C
+    d H nth :> D
+    e H nth :> E
+    [
+        A 5 bitroll-32
+
+        B C D n sha1-f 
+
+        E
+
+        n K nth
+
+        n W nth
+    ] sum-outputs 32 bits ;
+
+:: process-sha1-chunk ( bytes H W K state -- )
+    80 [
+        H W K inner-loop
+        d H nth e H set-nth
+        c H nth d H set-nth
+        b H nth 30 bitroll-32 c H set-nth
+        a H nth b H set-nth
+        a H set-nth
+    ] each
+    state [ H [ w+ ] 2map ] change-H drop ; inline
+
+M:: sha1-state checksum-block ( bytes state -- )
+    bytes prepare-sha1-message-schedule state (>>W)
+
+    bytes
+    state [ H>> clone ] [ W>> ] [ K>> ] tri state process-sha1-chunk ;
+
+M: sha1-state get-checksum
+    clone
+    [ pad-last-short-block ] [ sha-256>checksum ] bi ;
+
+M: sha1 checksum-stream ( stream checksum -- byte-array )
+    drop
+    [ <sha1-state> ] dip add-checksum-stream get-checksum ;
--- a/basis/checksums/sha/summary.txt
+++ b/basis/checksums/sha/summary.txt
@ -0,0 +1 @@
+SHA checksum algorithms
--- a/basis/checksums/sha1/sha1-docs.factor
+++ b/basis/checksums/sha1/sha1-docs.factor
@ -1,11 +0,0 @@
-USING: help.markup help.syntax ;
-IN: checksums.sha1
-
-HELP: sha1
-{ $class-description "SHA1 checksum algorithm." } ;
-
-ARTICLE: "checksums.sha1" "SHA1 checksum"
-"The SHA1 checksum algorithm implements a one-way hash function. It is generally considered to be stronger than MD5, however there is a known algorithm for finding collisions more effectively than a brute-force search (" { $url "http://www.schneier.com/blog/archives/2005/02/sha1_broken.html" } ")."
-{ $subsection sha1 } ;
-
-ABOUT: "checksums.sha1"
--- a/basis/checksums/sha1/sha1-tests.factor
+++ b/basis/checksums/sha1/sha1-tests.factor
@ -1,14 +0,0 @@
-USING: arrays kernel math namespaces sequences tools.test checksums checksums.sha1 ;
-
-[ "a9993e364706816aba3e25717850c26c9cd0d89d" ] [ "abc" sha1 checksum-bytes hex-string ] unit-test
-[ "84983e441c3bd26ebaae4aa1f95129e5e54670f1" ] [ "abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq" sha1 checksum-bytes hex-string ] unit-test
-! [ "34aa973cd4c4daa4f61eeb2bdbad27316534016f" ] [ 1000000 CHAR: a fill string>sha1str ] unit-test ! takes a long time...
-[ "dea356a2cddd90c7a7ecedc5ebb563934f460452" ] [ "0123456701234567012345670123456701234567012345670123456701234567"
-10 swap <array> concat sha1 checksum-bytes hex-string ] unit-test
-
-[
-    ";\u00009b\u0000fd\u0000cdK\u0000a3^s\u0000d0*\u0000e3\\\u0000b5\u000013<\u0000e8wA\u0000b2\u000083\u0000d20\u0000f1\u0000e6\u0000cc\u0000d8\u00001e\u00009c\u000004\u0000d7PT]\u0000ce,\u000001\u000012\u000080\u000096\u000099"
-] [
-    "\u000066\u000053\u0000f1\u00000c\u00001a\u0000fa\u0000b5\u00004c\u000061\u0000c8\u000025\u000075\u0000a8\u00004a\u0000fe\u000030\u0000d8\u0000aa\u00001a\u00003a\u000096\u000096\u0000b3\u000018\u000099\u000092\u0000bf\u0000e1\u0000cb\u00007f\u0000a6\u0000a7"
-    sha1-interleave
-] unit-test
--- a/basis/checksums/sha1/sha1.factor
+++ b/basis/checksums/sha1/sha1.factor
@ -1,134 +0,0 @@
-! Copyright (C) 2006, 2008 Doug Coleman.
-! See http://factorcode.org/license.txt for BSD license.
-USING: arrays combinators kernel io io.encodings.binary io.files
-io.streams.byte-array math.vectors strings sequences namespaces
-make math parser sequences assocs grouping vectors io.binary
-hashtables math.bitwise checksums checksums.common
-checksums.stream ;
-IN: checksums.sha1
-
-! Implemented according to RFC 3174.
-
-SYMBOLS: h0 h1 h2 h3 h4 A B C D E w K ;
-
-: get-wth ( n -- wth ) w get nth ; inline
-: shift-wth ( n -- x ) get-wth 1 bitroll-32 ; inline
-
-: initialize-sha1 ( -- )
-    0 bytes-read set
-    HEX: 67452301 dup h0 set A set
-    HEX: efcdab89 dup h1 set B set
-    HEX: 98badcfe dup h2 set C set
-    HEX: 10325476 dup h3 set D set
-    HEX: c3d2e1f0 dup h4 set E set
-    [
-        20 HEX: 5a827999 <array> %
-        20 HEX: 6ed9eba1 <array> %
-        20 HEX: 8f1bbcdc <array> %
-        20 HEX: ca62c1d6 <array> %
-    ] { } make K set ;
-
-! W(t) = S^1(W(t-3) XOR W(t-8) XOR W(t-14) XOR W(t-16))
-: sha1-W ( t -- W_t )
-     dup 3 - get-wth
-     over 8 - get-wth bitxor
-     over 14 - get-wth bitxor
-     swap 16 - get-wth bitxor 1 bitroll-32 ;
-
-! f(t;B,C,D) = (B AND C) OR ((NOT B) AND D)         ( 0 <= t <= 19)
-! f(t;B,C,D) = B XOR C XOR D                        (20 <= t <= 39)
-! f(t;B,C,D) = (B AND C) OR (B AND D) OR (C AND D)  (40 <= t <= 59)
-! f(t;B,C,D) = B XOR C XOR D                        (60 <= t <= 79)
-: sha1-f ( B C D t -- f_tbcd )
-    20 /i
-    {   
-        { 0 [ [ over bitnot ] dip bitand [ bitand ] dip bitor ] }
-        { 1 [ bitxor bitxor ] }
-        { 2 [ 2dup bitand [ pick bitand [ bitand ] dip ] dip bitor bitor ] }
-        { 3 [ bitxor bitxor ] }
-    } case ;
-
-: nth-int-be ( string n -- int )
-    4 * dup 4 + rot <slice> be> ; inline
-
-: make-w ( str -- )
-    #! compute w, steps a-b of RFC 3174, section 6.1
-    16 [ nth-int-be w get push ] with each
-    16 80 dup <slice> [ sha1-W w get push ] each ;
-
-: init-letters ( -- )
-    ! step c of RFC 3174, section 6.1
-    h0 get A set
-    h1 get B set
-    h2 get C set
-    h3 get D set
-    h4 get E set ;
-
-: inner-loop ( n -- temp )
-    ! TEMP = S^5(A) + f(t;B,C,D) + E + W(t) + K(t);
-    [
-        [ B get C get D get ] keep sha1-f ,
-        dup get-wth ,
-        K get nth ,
-        A get 5 bitroll-32 ,
-        E get ,
-    ] { } make sum 32 bits ; inline
-
-: set-vars ( temp -- )
-    ! E = D;  D = C;  C = S^30(B);  B = A; A = TEMP;
-    D get E set
-    C get D set
-    B get 30 bitroll-32 C set
-    A get B set
-    A set ;
-
-: calculate-letters ( -- )
-    ! step d of RFC 3174, section 6.1
-    80 [ inner-loop set-vars ] each ;
-
-: update-hs ( -- )
-    ! step e of RFC 3174, section 6.1
-    A h0 update-old-new
-    B h1 update-old-new
-    C h2 update-old-new
-    D h3 update-old-new
-    E h4 update-old-new ;
-
-: (process-sha1-block) ( str -- )
-    80 <vector> w set make-w init-letters calculate-letters update-hs ;
-
-: process-sha1-block ( str -- )
-    dup length [ bytes-read [ + ] change ] keep 64 = [
-        (process-sha1-block)
-    ] [
-        t bytes-read get pad-last-block
-        [ (process-sha1-block) ] each
-    ] if ;
-
-: stream>sha1 ( -- )
-    64 read [ process-sha1-block ] keep
-    length 64 = [ stream>sha1 ] when ;
-
-: get-sha1 ( -- str )
-    [ [ h0 h1 h2 h3 h4 ] [ get 4 >be % ] each ] "" make ;
-
-SINGLETON: sha1
-
-INSTANCE: sha1 stream-checksum
-
-M: sha1 checksum-stream ( stream -- sha1 )
-    drop [ initialize-sha1 stream>sha1 get-sha1 ] with-input-stream ;
-
-: seq>2seq ( seq -- seq1 seq2 )
-    #! { abcdefgh } -> { aceg } { bdfh }
-    2 group flip [ { } { } ] [ first2 ] if-empty ;
-
-: 2seq>seq ( seq1 seq2 -- seq )
-    #! { aceg } { bdfh } -> { abcdefgh }
-    [ zip concat ] keep like ;
-
-: sha1-interleave ( string -- seq )
-    [ zero? ] trim-head
-    dup length odd? [ rest ] when
-    seq>2seq [ sha1 checksum-bytes ] bi@
-    2seq>seq ;
--- a/basis/checksums/sha1/summary.txt
+++ b/basis/checksums/sha1/summary.txt
@ -1 +0,0 @@
-SHA1 checksum algorithm
--- a/basis/checksums/sha2/sha2-docs.factor
+++ b/basis/checksums/sha2/sha2-docs.factor
@ -1,11 +0,0 @@
-USING: help.markup help.syntax ;
-IN: checksums.sha2
-
-HELP: sha-256
-{ $class-description "SHA-256 checksum algorithm." } ;
-
-ARTICLE: "checksums.sha2" "SHA2 checksum"
-"The SHA2 checksum algorithm implements a one-way hash function. It is generally considered to be pretty strong."
-{ $subsection sha-256 } ;
-
-ABOUT: "checksums.sha2"
--- a/basis/checksums/sha2/summary.txt
+++ b/basis/checksums/sha2/summary.txt
@ -1 +0,0 @@
-SHA2 checksum algorithm
--- a/basis/cocoa/messages/messages.factor
+++ b/basis/cocoa/messages/messages.factor
@ -2,9 +2,9 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors alien alien.c-types alien.strings arrays assocs
 continuations combinators compiler compiler.alien stack-checker kernel
-math namespaces make parser quotations sequences strings words
+math namespaces make quotations sequences strings words
 cocoa.runtime io macros memoize io.encodings.utf8 effects libc
-libc.private parser lexer init core-foundation fry generalizations
+libc.private lexer init core-foundation fry generalizations
 specialized-arrays.direct.alien ;
 IN: cocoa.messages

--- a/basis/command-line/command-line.factor
+++ b/basis/command-line/command-line.factor
@ -69,6 +69,4 @@ SYMBOL: main-vocab-hook
 : ignore-cli-args? ( -- ? )
    os macosx? "run" get "ui" = and ;

-: script-mode ( -- ) ;
-
 [ default-cli-args ] "command-line" add-init-hook
--- a/basis/compiler/cfg/rpo/rpo.factor
+++ b/basis/compiler/cfg/rpo/rpo.factor
@ -1,7 +1,7 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel accessors namespaces make math sequences sets
-assocs fry compiler.cfg.instructions ;
+assocs fry compiler.cfg compiler.cfg.instructions ;
 IN: compiler.cfg.rpo

 SYMBOL: visited
--- a/basis/compiler/compiler.factor
+++ b/basis/compiler/compiler.factor
@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors kernel namespaces arrays sequences io words fry
 continuations vocabs assocs dlists definitions math graphs generic
-generic.single combinators deques search-deques macros io
+generic.single combinators deques search-deques macros
 source-files.errors stack-checker stack-checker.state
 stack-checker.inlining stack-checker.errors combinators.short-circuit
 compiler.errors compiler.units compiler.tree.builder
--- a/basis/compiler/tests/alien.factor
+++ b/basis/compiler/tests/alien.factor
@ -1,9 +1,8 @@
-USING: alien alien.c-types alien.syntax compiler kernel
-namespaces namespaces tools.test sequences stack-checker
-stack-checker.errors words arrays parser quotations
-continuations effects namespaces.private io io.streams.string
-memory system threads tools.test math accessors combinators
-specialized-arrays.float alien.libraries io.pathnames
+USING: alien alien.c-types alien.syntax compiler kernel namespaces
+sequences stack-checker stack-checker.errors words arrays parser
+quotations continuations effects namespaces.private io
+io.streams.string memory system threads tools.test math accessors
+combinators specialized-arrays.float alien.libraries io.pathnames
 io.backend ;
 IN: compiler.tests.alien

--- a/basis/compiler/tests/codegen.factor
+++ b/basis/compiler/tests/codegen.factor
@ -1,9 +1,9 @@
-USING: generalizations accessors arrays compiler kernel
-kernel.private math hashtables.private math.private namespaces
-sequences sequences.private tools.test namespaces.private
-slots.private sequences.private byte-arrays alien
+USING: generalizations accessors arrays compiler kernel kernel.private
+math hashtables.private math.private namespaces sequences tools.test
+namespaces.private slots.private sequences.private byte-arrays alien
 alien.accessors layouts words definitions compiler.units io
 combinators vectors grouping make ;
+QUALIFIED: namespaces.private
 IN: compiler.tests.codegen

 ! Originally, this file did black box testing of templating
@ -48,7 +48,7 @@ unit-test
 [ 3 ]
 [
    global [ 3 \ foo set ] bind
-    \ foo [ global >n get ndrop ] compile-call
+    \ foo [ global >n get namespaces.private:ndrop ] compile-call
 ] unit-test

 : blech ( x -- ) drop ;
@ -62,7 +62,7 @@ unit-test
 [ 3 ]
 [
    global [ 3 \ foo set ] bind
-    \ foo [ global [ get ] swap >n call ndrop ] compile-call
+    \ foo [ global [ get ] swap >n call namespaces.private:ndrop ] compile-call
 ] unit-test

 [ 3 ]
--- a/basis/compiler/tests/intrinsics.factor
+++ b/basis/compiler/tests/intrinsics.factor
@ -1,10 +1,10 @@
 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
+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
+namespaces libc io.encodings.ascii
 classes compiler ;
 IN: compiler.tests.intrinsics

--- a/basis/compiler/tree/debugger/debugger.factor
+++ b/basis/compiler/tree/debugger/debugger.factor
@ -16,6 +16,7 @@ compiler.tree.builder
 compiler.tree.optimizer
 compiler.tree.combinators
 compiler.tree.checker ;
+FROM: fry => _ ;
 RENAME: _ match => __
 IN: compiler.tree.debugger

--- a/basis/compiler/tree/def-use/def-use.factor
+++ b/basis/compiler/tree/def-use/def-use.factor
@ -1,6 +1,6 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: arrays namespaces assocs sequences kernel generic assocs
+USING: arrays namespaces sequences kernel generic assocs
 classes vectors accessors combinators sets
 stack-checker.state
 stack-checker.branches
--- a/basis/compiler/tree/escape-analysis/escape-analysis-tests.factor
+++ b/basis/compiler/tree/escape-analysis/escape-analysis-tests.factor
@ -322,3 +322,9 @@ C: <ro-box> ro-box
 [ 0 ] [
    [ { null } declare [ 1 ] [ 2 ] if ] count-unboxed-allocations
 ] unit-test
+
+! Doug found a regression
+
+TUPLE: empty-tuple ;
+
+[ ] [ [ empty-tuple boa layout-of ] count-unboxed-allocations drop ] unit-test
--- a/basis/compiler/tree/escape-analysis/simple/simple.factor
+++ b/basis/compiler/tree/escape-analysis/simple/simple.factor
@ -49,14 +49,10 @@ M: #push escape-analysis*

 : slot-offset ( #call -- n/f )
    dup in-d>>
-    [ first node-value-info class>> ]
-    [ second node-value-info literal>> ] 2bi
-    dup fixnum? [
-        {
-            { [ over tuple class<= ] [ 2 - ] }
-            { [ over complex class<= ] [ 1 - ] }
-            [ drop f ]
-        } cond nip
+    [ second node-value-info literal>> ]
+    [ first node-value-info class>> ] 2bi
+    2dup [ fixnum? ] [ tuple class<= ] bi* and [
+        over 2 >= [ drop 2 - ] [ 2drop f ] if
    ] [ 2drop f ] if ;

 : record-slot-call ( #call -- )
--- a/basis/compiler/tree/normalization/normalization.factor
+++ b/basis/compiler/tree/normalization/normalization.factor
@ -1,7 +1,7 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: fry namespaces sequences math math.order accessors kernel arrays
-combinators compiler.utilities assocs
+combinators assocs
 stack-checker.backend
 stack-checker.branches
 stack-checker.inlining
--- a/basis/compiler/tree/propagation/info/info-tests.factor
+++ b/basis/compiler/tree/propagation/info/info-tests.factor
@ -1,5 +1,5 @@
 USING: accessors math math.intervals sequences classes.algebra
-math kernel tools.test compiler.tree.propagation.info arrays ;
+kernel tools.test compiler.tree.propagation.info arrays ;
 IN: compiler.tree.propagation.info.tests

 [ f ] [ 0.0 -0.0 eql? ] unit-test
--- a/basis/compiler/tree/propagation/nodes/nodes.factor
+++ b/basis/compiler/tree/propagation/nodes/nodes.factor
@ -1,6 +1,6 @@
 ! Copyright (C) 2004, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: sequences accessors kernel assocs sequences
+USING: sequences accessors kernel assocs
 compiler.tree
 compiler.tree.propagation.copy
 compiler.tree.propagation.info ;
--- a/basis/compiler/tree/tuple-unboxing/tuple-unboxing-tests.factor
+++ b/basis/compiler/tree/tuple-unboxing/tuple-unboxing-tests.factor
@ -1,5 +1,5 @@
 IN: compiler.tree.tuple-unboxing.tests
-USING: tools.test compiler.tree.tuple-unboxing compiler.tree
+USING: tools.test compiler.tree
 compiler.tree.builder compiler.tree.recursive
 compiler.tree.normalization compiler.tree.propagation
 compiler.tree.cleanup compiler.tree.escape-analysis
--- a/basis/compression/huffman/huffman.factor
+++ b/basis/compression/huffman/huffman.factor
@ -0,0 +1,88 @@
+! Copyright (C) 2009 Marc Fauconneau.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors arrays assocs constructors fry
+hashtables io kernel locals math math.order math.parser
+math.ranges multiline sequences ;
+IN: compression.huffman
+
+QUALIFIED-WITH: bitstreams bs
+
+<PRIVATE
+
+! huffman codes
+
+TUPLE: huffman-code
+    { value }
+    { size }
+    { code } ;
+
+: <huffman-code> ( -- code ) 0 0 0 huffman-code boa ;
+: next-size ( code -- ) [ 1+ ] change-size [ 2 * ] change-code drop ;
+: next-code ( code -- ) [ 1+ ] change-code drop ;
+
+:: all-patterns ( huff n -- seq )
+    n log2 huff size>> - :> free-bits
+    free-bits 0 >
+    [ free-bits 2^ [0,b) [ huff code>> free-bits 2^ * + ] map ]
+    [ huff code>> free-bits neg 2^ /i 1array ] if ;
+
+:: huffman-each ( tdesc quot: ( huff -- ) -- )
+    <huffman-code> :> code
+    tdesc
+    [
+        code next-size
+        [ code (>>value) code clone quot call code next-code ] each
+    ] each ; inline
+
+: update-reverse-table ( huff n table -- )
+    [ drop all-patterns ]
+    [ nip '[ _ swap _ set-at ] each ] 3bi ;
+
+:: reverse-table ( tdesc n -- rtable )
+   n f <array> <enum> :> table
+   tdesc [ n table update-reverse-table ] huffman-each
+   table seq>> ;
+
+:: huffman-table ( tdesc max -- table )
+   max f <array> :> table
+   tdesc [ [ ] [ value>> ] bi table set-nth ] huffman-each
+   table ;
+
+PRIVATE>
+
+! decoder
+
+TUPLE: huffman-decoder
+    { bs }
+    { tdesc }
+    { rtable }
+    { bits/level } ;
+
+CONSTRUCTOR: huffman-decoder ( bs tdesc -- decoder )
+    16 >>bits/level
+    [ ] [ tdesc>> ] [ bits/level>> 2^ ] tri reverse-table >>rtable ;
+
+: read1-huff ( decoder -- elt )
+    16 over [ bs>> bs:peek ] [ rtable>> nth ] bi ! first/last
+    [ size>> swap bs>> bs:seek ] [ value>> ] bi ;
+
+! %remove
+: reverse-bits ( value bits -- value' )
+    [ >bin ] [ CHAR: 0 pad-head <reversed> bin> ] bi* ;
+
+: read1-huff2 ( decoder -- elt )
+    16 over [ bs>> bs:peek 16 reverse-bits ] [ rtable>> nth ] bi ! first/last
+    [ size>> swap bs>> bs:seek ] [ value>> ] bi ;
+
+/*
+: huff>string ( code -- str )
+    [ value>> number>string ]
+    [ [ code>> ] [ size>> bits>string ] bi ] bi
+    " = " glue ;
+
+: huff. ( code -- ) huff>string print ;
+
+:: rtable. ( rtable -- )
+    rtable length>> log2 :> n
+    rtable <enum> [ swap n bits. [ huff. ] each ] assoc-each ;
+*/
--- a/basis/compression/inflate/inflate.factor
+++ b/basis/compression/inflate/inflate.factor
@ -0,0 +1,212 @@
+! Copyright (C) 2009 Marc Fauconneau.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors arrays assocs byte-arrays
+byte-vectors combinators constructors fry grouping hashtables
+compression.huffman images io.binary kernel locals
+math math.bitwise math.order math.ranges multiline sequences
+sorting ;
+IN: compression.inflate
+
+QUALIFIED-WITH: bitstreams bs
+
+<PRIVATE
+
+: enum>seq ( assoc -- seq )
+    dup keys [ ] [ max ] map-reduce 1 + f <array>
+    [ '[ swap _ set-nth ] assoc-each ] keep ;
+
+ERROR: zlib-unimplemented ;
+ERROR: bad-zlib-data ;
+ERROR: bad-zlib-header ;
+    
+:: check-zlib-header ( data -- )
+    16 data bs:peek 2 >le be> 31 mod    ! checksum
+    0 assert=                           
+    4 data bs:read 8 assert=            ! compression method: deflate
+    4 data bs:read                      ! log2(max length)-8, 32K max
+    7 <= [ bad-zlib-header ] unless     
+    5 data bs:seek                      ! drop check bits 
+    1 data bs:read 0 assert=            ! dictionnary - not allowed in png
+    2 data bs:seek                      ! compression level; ignore
+    ;
+
+:: default-table ( -- table )
+    0 <hashtable> :> table
+    0 143 [a,b] 280 287 [a,b] append 8 table set-at
+    144 255 [a,b] >array 9 table set-at
+    256 279 [a,b] >array 7 table set-at 
+    table enum>seq 1 tail ;
+
+CONSTANT: clen-shuffle { 16 17 18 0 8 7 9 6 10 5 11 4 12 3 13 2 14 1 15 }
+
+: get-table ( values size -- table ) 
+    16 f <array> clone <enum> 
+    [ '[ _ push-at ] 2each ] keep seq>> 1 tail [ natural-sort ] map ;
+
+:: decode-huffman-tables ( bitstream -- tables )
+    5 bitstream bs:read 257 +
+    5 bitstream bs:read 1 +
+    4 bitstream bs:read 4 +
+    clen-shuffle swap head
+    dup [ drop 3 bitstream bs:read ] map
+    get-table
+    bitstream swap <huffman-decoder> 
+    [ 2dup + ] dip swap :> k!
+    '[
+        _ read1-huff2
+        {
+            { [ dup 16 = ] [ 2 bitstream bs:read 3 + 2array ] }
+            { [ dup 17 = ] [ 3 bitstream bs:read 3 + 2array ] }
+            { [ dup 18 = ] [ 7 bitstream bs:read 11 + 2array ] }
+            [ ]
+        } cond
+        dup array? [ dup second ] [ 1 ] if
+        k swap - dup k! 0 >
+    ] 
+    [ ] produce swap suffix
+    { } [ dup array? [ dup first 16 = ] [ f ] if [ [ unclip-last ] [ second 1+ swap <repetition> append ] bi* ] [ suffix ] if ] reduce
+    [ dup array? [ second 0 <repetition> ] [ 1array ] if ] map concat
+    nip swap cut 2array [ [ length>> [0,b) ] [ ] bi get-table ] map ;
+    
+CONSTANT: length-table
+    {
+        3 4 5 6 7 8 9 10
+        11 13 15 17
+        19 23 27 31
+        35 43 51 59
+        67 83 99 115
+        131 163 195 227 258
+    }
+
+CONSTANT: dist-table
+    {
+        1 2 3 4 
+        5 7 9 13 
+        17 25 33 49
+        65 97 129 193
+        257 385 513 769
+        1025 1537 2049 3073
+        4097 6145 8193 12289
+        16385 24577
+    }
+
+: nth* ( n seq -- elt )
+    [ length 1- swap - ] [ nth ] bi ;
+
+:: inflate-lz77 ( seq -- bytes )
+    1000 <byte-vector> :> bytes
+    seq
+    [
+        dup array?
+        [ first2 '[ _ 1- bytes nth* bytes push ] times ]
+        [ bytes push ] if
+    ] each 
+    bytes ;
+
+:: inflate-dynamic ( bitstream -- bytes )
+    bitstream decode-huffman-tables
+    bitstream '[ _ swap <huffman-decoder> ] map :> tables
+    [
+        tables first read1-huff2
+        dup 256 >
+        [
+            dup 285 = 
+            [ ]
+            [ 
+                dup 264 > 
+                [ 
+                    dup 261 - 4 /i dup 5 > 
+                    [ bad-zlib-data ] when 
+                    bitstream bs:read 2array 
+                ]
+                when 
+            ] if
+            ! 5 bitstream read-bits ! distance
+            tables second read1-huff2
+            dup 3 > 
+            [ 
+                dup 2 - 2 /i dup 13 >
+                [ bad-zlib-data ] when
+                bitstream bs:read 2array
+            ] 
+            when
+            2array
+        ]
+        when
+        dup 256 = not
+    ]
+    [ ] produce nip
+    [
+        dup array? [
+            first2
+            [  
+                dup array? [ first2 ] [ 0 ] if
+                [ 257 - length-table nth ] [ + ] bi*
+            ] 
+            [
+                dup array? [ first2 ] [ 0 ] if
+                [ dist-table nth ] [ + ] bi*
+            ] bi*
+            2array
+        ] when
+    ] map ;
+    
+: inflate-raw ( bitstream -- bytes ) zlib-unimplemented ;
+: inflate-static ( bitstream -- bytes ) zlib-unimplemented ;
+
+:: inflate-loop ( bitstream -- bytes )
+    [ 1 bitstream bs:read 0 = ]
+    [
+        bitstream
+        2 bitstream bs:read
+        { 
+            { 0 [ inflate-raw ] }
+            { 1 [ inflate-static ] }
+            { 2 [ inflate-dynamic ] }
+            { 3 [ bad-zlib-data f ] }
+        }
+        case
+    ]
+    [ produce ] keep call suffix concat ;
+    
+  !  [ produce ] keep dip swap suffix
+
+:: paeth ( a b c -- p ) 
+    a b + c - { a b c } [ [ - abs ] keep 2array ] with map 
+    sort-keys first second ;
+    
+:: png-unfilter-line ( prev curr filter -- curr' )
+    prev :> c
+    prev 3 tail-slice :> b
+    curr :> a
+    curr 3 tail-slice :> x
+    x length [0,b)
+    filter
+    {
+        { 0 [ drop ] }
+        { 1 [ [| n | n x nth n a nth + 256 wrap n x set-nth ] each ] }
+        { 2 [ [| n | n x nth n b nth + 256 wrap n x set-nth ] each ] }
+        { 3 [ [| n | n x nth n a nth n b nth + 2/ + 256 wrap n x set-nth ] each ] }
+        { 4 [ [| n | n x nth n a nth n b nth n c nth paeth + 256 wrap n x set-nth ] each ] }
+        
+    } case 
+    curr 3 tail ;
+
+PRIVATE>
+
+! for debug -- shows residual values
+: reverse-png-filter' ( lines -- filtered )
+    [ first ] [ 1 tail ] [ map ] bi-curry@ bi nip
+    concat [ 128 + 256 wrap ] map ;
+    
+: reverse-png-filter ( lines -- filtered )
+    dup first [ 0 ] replicate prefix
+    [ { 0 0 } prepend  ] map
+    2 clump [
+        first2 dup [ third ] [ 0 2 rot set-nth ] bi png-unfilter-line
+    ] map concat ;
+
+: zlib-inflate ( bytes -- bytes )
+    bs:<lsb0-bit-reader>
+    [ check-zlib-header ] [ inflate-loop ] bi
+    inflate-lz77 ;
--- a/basis/compression/lzw/lzw.factor
+++ b/basis/compression/lzw/lzw.factor
@ -1,20 +1,19 @@
 ! Copyright (C) 2009 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors assocs bitstreams byte-vectors combinators io
+USING: accessors alien.accessors assocs byte-arrays combinators
 io.encodings.binary io.streams.byte-array kernel math sequences
 vectors ;
 IN: compression.lzw

+QUALIFIED-WITH: bitstreams bs
+
 CONSTANT: clear-code 256
 CONSTANT: end-of-information 257

-TUPLE: lzw input output end-of-input? table count k omega omega-k #bits
-code old-code ;
+TUPLE: lzw input output table code old-code ;

 SYMBOL: table-full

-ERROR: index-too-big n ;
-
 : lzw-bit-width ( n -- n' )
    {
        { [ dup 510 <= ] [ drop 9 ] }
@ -24,36 +23,14 @@ ERROR: index-too-big n ;
        [ drop table-full ]
    } cond ;

-: lzw-bit-width-compress ( lzw -- n )
-    count>> lzw-bit-width ;
-
 : lzw-bit-width-uncompress ( lzw -- n )
    table>> length lzw-bit-width ;

-: initial-compress-table ( -- assoc )
-    258 iota [ [ 1vector ] keep ] H{ } map>assoc ;
-
 : initial-uncompress-table ( -- seq )
    258 iota [ 1vector ] V{ } map-as ;

-: reset-lzw ( lzw -- lzw )
-    257 >>count
-    V{ } clone >>omega
-    V{ } clone >>omega-k
-    9 >>#bits ;
-
-: reset-lzw-compress ( lzw -- lzw )
-    f >>k
-    initial-compress-table >>table reset-lzw ;
-
 : reset-lzw-uncompress ( lzw -- lzw )
-    initial-uncompress-table >>table reset-lzw ;
-
-: <lzw-compress> ( input -- obj )
-    lzw new
-        swap >>input
-        binary <byte-writer> <bitstream-writer> >>output
-        reset-lzw-compress ;
+    initial-uncompress-table >>table ;

 : <lzw-uncompress> ( input -- obj )
    lzw new
@ -61,79 +38,8 @@ ERROR: index-too-big n ;
        BV{ } clone >>output
        reset-lzw-uncompress ;

-: push-k ( lzw -- lzw )
-    [ ]
-    [ k>> ]
-    [ omega>> clone [ push ] keep ] tri >>omega-k ;
-
-: omega-k-in-table? ( lzw -- ? )
-    [ omega-k>> ] [ table>> ] bi key? ;
-
 ERROR: not-in-table value ;

-: write-output ( lzw -- )
-    [
-        [ omega>> ] [ table>> ] bi ?at [ not-in-table ] unless
-    ] [
-        [ lzw-bit-width-compress ]
-        [ output>> write-bits ] bi
-    ] bi ;
-
-: omega-k>omega ( lzw -- lzw )
-    dup omega-k>> clone >>omega ;
-
-: k>omega ( lzw -- lzw )
-    dup k>> 1vector >>omega ;
-
-: add-omega-k ( lzw -- )
-    [ [ 1+ ] change-count count>> ]
-    [ omega-k>> clone ]
-    [ table>> ] tri set-at ;
-
-: lzw-compress-char ( lzw k -- )
-    >>k push-k dup omega-k-in-table? [
-        omega-k>omega drop
-    ] [
-        [ write-output ]
-        [ add-omega-k ]
-        [ k>omega drop ] tri
-    ] if ;
-
-: (lzw-compress-chars) ( lzw -- )
-    dup lzw-bit-width-compress table-full = [
-        drop
-    ] [
-        dup input>> stream-read1
-        [ [ lzw-compress-char ] [ drop (lzw-compress-chars) ] 2bi ]
-        [ t >>end-of-input? drop ] if*
-    ] if ;
-
-: lzw-compress-chars ( lzw -- )
-    {
-        ! [ [ clear-code lzw-compress-char ] [ drop ] bi ] ! reset-lzw-compress drop ] bi ]
-        [
-            [ clear-code ] dip
-            [ lzw-bit-width-compress ]
-            [ output>> write-bits ] bi
-        ]
-        [ (lzw-compress-chars) ]
-        [
-            [ k>> ]
-            [ lzw-bit-width-compress ]
-            [ output>> write-bits ] tri
-        ]
-        [
-            [ end-of-information ] dip
-            [ lzw-bit-width-compress ]
-            [ output>> write-bits ] bi
-        ]
-        [ ]
-    } cleave dup end-of-input?>> [ drop ] [ lzw-compress-chars ] if ;
-
-: lzw-compress ( byte-array -- seq )
-    binary <byte-reader> <lzw-compress>
-    [ lzw-compress-chars ] [ output>> stream>> ] bi ;
-
 : lookup-old-code ( lzw -- vector )
    [ old-code>> ] [ table>> ] bi nth ;

@ -152,7 +58,7 @@ ERROR: not-in-table value ;
 : add-to-table ( seq lzw -- ) table>> push ;

 : lzw-read ( lzw -- lzw n )
-    [ ] [ lzw-bit-width-uncompress ] [ input>> ] tri read-bits 2drop ;
+    [ ] [ lzw-bit-width-uncompress ] [ input>> ] tri bs:read ;

 DEFER: lzw-uncompress-char
 : handle-clear-code ( lzw -- )
@ -200,5 +106,6 @@ DEFER: lzw-uncompress-char
    ] if* ;

 : lzw-uncompress ( seq -- byte-array )
-    binary <byte-reader> <bitstream-reader>
-    <lzw-uncompress> [ lzw-uncompress-char ] [ output>> ] bi ;
+    bs:<msb0-bit-reader>
+    <lzw-uncompress>
+    [ lzw-uncompress-char ] [ output>> ] bi ;
--- a/basis/concurrency/distributed/distributed-tests.factor
+++ b/basis/concurrency/distributed/distributed-tests.factor
@ -3,6 +3,7 @@ USING: tools.test concurrency.distributed kernel io.files
 io.files.temp io.directories arrays io.sockets system
 combinators threads math sequences concurrency.messaging
 continuations accessors prettyprint ;
+FROM: concurrency.messaging => receive send ;

 : test-node ( -- addrspec )
    {
--- a/basis/concurrency/exchangers/exchangers-tests.factor
+++ b/basis/concurrency/exchangers/exchangers-tests.factor
@ -1,7 +1,8 @@
 IN: concurrency.exchangers.tests
-USING: sequences tools.test concurrency.exchangers
+USING: tools.test concurrency.exchangers
 concurrency.count-downs concurrency.promises locals kernel
 threads ;
+FROM: sequences => 3append ;

 :: exchanger-test ( -- string )
    [let |
--- a/basis/concurrency/messaging/messaging-docs.factor
+++ b/basis/concurrency/messaging/messaging-docs.factor
@ -1,7 +1,7 @@
 ! Copyright (C) 2006 Chris Double.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: help.syntax help.markup concurrency.messaging.private
-threads kernel arrays quotations threads strings ;
+threads kernel arrays quotations strings ;
 IN: concurrency.messaging

 HELP: send
@ -53,7 +53,7 @@ ARTICLE: { "concurrency" "synchronous-sends" } "Synchronous sends"
 { $subsection reply-synchronous }
 "An example:"
 { $example
-    "USING: concurrency.messaging kernel prettyprint threads ;"
+    "USING: concurrency.messaging threads ;"
    "IN: scratchpad"
    ": pong-server ( -- )"
    "    receive [ \"pong\" ] dip reply-synchronous ;"
--- a/basis/core-foundation/data/data.factor
+++ b/basis/core-foundation/data/data.factor
@ -1,7 +1,6 @@
 ! Copyright (C) 2008 Joe Groff.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: alien.c-types alien.syntax core-foundation.numbers kernel math
-sequences core-foundation.numbers ;
+USING: alien.c-types alien.syntax kernel math sequences ;
 IN: core-foundation.data

 TYPEDEF: void* CFDataRef
--- a/basis/cpu/ppc/assembler/assembler-tests.factor
+++ b/basis/cpu/ppc/assembler/assembler-tests.factor
@ -1,6 +1,7 @@
 IN: cpu.ppc.assembler.tests
 USING: cpu.ppc.assembler tools.test arrays kernel namespaces
 make vocabs sequences ;
+FROM: cpu.ppc.assembler => B ;

 : test-assembler ( expected quot -- )
    [ 1array ] [ [ B{ } make ] curry ] bi* unit-test ;
--- a/basis/cpu/ppc/bootstrap.factor
+++ b/basis/cpu/ppc/bootstrap.factor
@ -4,6 +4,7 @@ USING: bootstrap.image.private kernel kernel.private namespaces
 system cpu.ppc.assembler compiler.codegen.fixup compiler.units
 compiler.constants math math.private layouts words
 vocabs slots.private locals.backend ;
+FROM: cpu.ppc.assembler => B ;
 IN: bootstrap.ppc

 4 \ cell set
--- a/basis/cpu/ppc/ppc.factor
+++ b/basis/cpu/ppc/ppc.factor
@ -7,6 +7,7 @@ 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.units ;
+FROM: cpu.ppc.assembler => B ;
 IN: cpu.ppc

 ! PowerPC register assignments:
--- a/basis/cpu/x86/64/64.factor
+++ b/basis/cpu/x86/64/64.factor
@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors arrays kernel math namespaces make sequences
 system layouts alien alien.c-types alien.accessors alien.structs
-slots splitting assocs combinators make locals cpu.x86.assembler
+slots splitting assocs combinators locals cpu.x86.assembler
 cpu.x86 cpu.architecture compiler.constants
 compiler.codegen compiler.codegen.fixup
 compiler.cfg.instructions compiler.cfg.builder
--- a/basis/db/errors/postgresql/postgresql.factor
+++ b/basis/db/errors/postgresql/postgresql.factor
@ -1,7 +1,8 @@
 ! Copyright (C) 2009 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel db.errors peg.ebnf strings sequences math
-combinators.short-circuit accessors math.parser quoting ;
+combinators.short-circuit accessors math.parser quoting
+locals ;
 IN: db.errors.postgresql

 EBNF: parse-postgresql-sql-error
--- a/basis/db/tester/tester.factor
+++ b/basis/db/tester/tester.factor
@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: concurrency.combinators db.pools db.sqlite db.tuples
 db.types kernel math random threads tools.test db sequences
-io prettyprint db.postgresql db.sqlite accessors io.files.temp
+io prettyprint db.postgresql accessors io.files.temp
 namespaces fry system math.parser ;
 IN: db.tester

--- a/basis/db/tuples/tuples-tests.factor
+++ b/basis/db/tuples/tuples-tests.factor
@ -1,11 +1,12 @@
 ! Copyright (C) 2008 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: io.files io.files.temp kernel tools.test db db.tuples classes
-db.types continuations namespaces math math.ranges
+db.types continuations namespaces math
 prettyprint calendar sequences db.sqlite math.intervals
 db.postgresql accessors random math.bitwise system
 math.ranges strings urls fry db.tuples.private db.private
 db.tester ;
+FROM: math.ranges => [a,b] ;
 IN: db.tuples.tests

 TUPLE: person the-id the-name the-number the-real
--- a/basis/db/tuples/tuples.factor
+++ b/basis/db/tuples/tuples.factor
@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: arrays assocs classes db kernel namespaces
 classes.tuple words sequences slots math accessors
-math.parser io prettyprint db.types continuations
+math.parser io prettyprint continuations
 destructors mirrors sets db.types db.private fry
 combinators.short-circuit db.errors ;
 IN: db.tuples
--- a/basis/debugger/debugger.factor
+++ b/basis/debugger/debugger.factor
@ -251,8 +251,15 @@ M: already-disposed summary drop "Attempting to operate on disposed object" ;
 M: no-current-vocab summary
    drop "Not in a vocabulary; IN: form required" ;

-M: no-word-error error.
-    "No word named ``" write name>> write "'' found in current vocabulary search path" print ;
+M: no-word-error summary
+    name>> "No word named ``" "'' found in current vocabulary search path" surround ;
+
+M: no-word-error error. summary print ;
+
+M: ambiguous-use-error summary
+    words>> first name>> "More than one vocabulary defines a word named ``" "''" surround ;
+
+M: ambiguous-use-error error. summary print ;

 M: staging-violation summary
    drop
--- a/basis/documents/documents.factor
+++ b/basis/documents/documents.factor
@ -3,6 +3,7 @@
 USING: accessors arrays io kernel math models namespaces make
 sequences strings splitting combinators unicode.categories
 math.order math.ranges fry locals ;
+FROM: models => change-model ;
 IN: documents

 : +col ( loc n -- newloc ) [ first2 ] dip + 2array ;
--- a/basis/editors/editors.factor
+++ b/basis/editors/editors.factor
@ -4,7 +4,7 @@ USING: parser lexer kernel namespaces sequences definitions
 io.files io.backend io.pathnames io summary continuations
 tools.crossref vocabs.hierarchy prettyprint source-files
 source-files.errors assocs vocabs vocabs.loader splitting
-accessors debugger prettyprint help.topics ;
+accessors debugger help.topics ;
 IN: editors

 TUPLE: no-edit-hook ;
--- a/basis/editors/gvim/gvim.factor
+++ b/basis/editors/gvim/gvim.factor
@ -11,7 +11,10 @@ SINGLETON: gvim
 HOOK: gvim-path io-backend ( -- path )

 M: gvim vim-command ( file line -- string )
-    [ gvim-path , "+" swap number>string append , , ] { } make ;
+    [
+        gvim-path ,
+        number>string "+" prepend , ,
+    ] { } make ;

 gvim vim-editor set-global

--- a/basis/editors/macvim/macvim.factor
+++ b/basis/editors/macvim/macvim.factor
@ -3,11 +3,9 @@ namespaces prettyprint editors make ;

 IN: editors.macvim

-: macvim-location ( file line -- )
+: macvim ( file line -- )
    drop
    [ "open" , "-a" , "MacVim", , ] { } make
-    try-process ;
-
-[ macvim-location ] edit-hook set-global
-
+    run-detached drop ;

+[ macvim ] edit-hook set-global
--- a/basis/editors/scite/scite.factor
+++ b/basis/editors/scite/scite.factor
@ -25,7 +25,7 @@ IN: editors.scite
        number>string "-goto:" prepend ,
    ] { } make ;

-: scite-location ( file line -- )
+: scite ( file line -- )
    scite-command run-detached drop ;

-[ scite-location ] edit-hook set-global
+[ scite ] edit-hook set-global
--- a/basis/editors/textedit/textedit.factor
+++ b/basis/editors/textedit/textedit.factor
@ -2,9 +2,9 @@ USING: definitions io.launcher kernel math math.parser parser
 namespaces prettyprint editors make ;
 IN: editors.textedit

-: textedit-location ( file line -- )
+: textedit ( file line -- )
    drop
    [ "open" , "-a" , "TextEdit", , ] { } make
-    try-process ;
+    run-detached drop ;

-[ textedit-location ] edit-hook set-global
+[ textedit ] edit-hook set-global
--- a/basis/editors/textmate/textmate.factor
+++ b/basis/editors/textmate/textmate.factor
@ -1,10 +1,9 @@
 USING: definitions io.launcher kernel math math.parser parser
 namespaces prettyprint editors make ;
-
 IN: editors.textmate

-: textmate-location ( file line -- )
+: textmate ( file line -- )
    [ "mate" , "-a" , "-l" , number>string , , ] { } make
-    try-process ;
+    run-detached drop ;

-[ textmate-location ] edit-hook set-global
+[ textmate ] edit-hook set-global
--- a/basis/editors/vim/vim-docs.factor
+++ b/basis/editors/vim/vim-docs.factor
@ -3,7 +3,7 @@ USING: definitions editors help help.markup help.syntax io io.files
 IN: editors.vim

 ARTICLE: { "vim" "vim" } "Vim support"
-"This module makes the " { $link edit } " word work with Vim by setting the " { $link edit-hook } " global variable to call " { $link vim-location } ". The " { $link vim-path } " variable contains the name of the vim executable.  The default " { $link vim-path } " is " { $snippet "\"gvim\"" } "."
+"This module makes the " { $link edit } " word work with Vim by setting the " { $link edit-hook } " global variable to call " { $link vim } ". The " { $link vim-path } " variable contains the name of the vim executable.  The default " { $link vim-path } " is " { $snippet "\"gvim\"" } "."
 $nl
 "If you intend to use this module regularly, it helps to have it load during stage 2 bootstrap. On Windows, place the following example " { $snippet ".factor-boot-rc" } " in the directory returned by " { $link home } ":"
 { $code
--- a/basis/editors/vim/vim.factor
+++ b/basis/editors/vim/vim.factor
@ -4,7 +4,6 @@ make ;
 IN: editors.vim

 SYMBOL: vim-path
-
 SYMBOL: vim-editor
 HOOK: vim-command vim-editor ( file line -- array )

@ -12,12 +11,13 @@ SINGLETON: vim

 M: vim vim-command
    [
-        vim-path get , swap , "+" swap number>string append ,
+        vim-path get ,
+        [ , ] [ number>string "+" prepend , ] bi*
    ] { } make ;

-: vim-location ( file line -- )
-    vim-command try-process ;
+: vim ( file line -- )
+    vim-command run-detached drop ;

 "vim" vim-path set-global
-[ vim-location ] edit-hook set-global
-vim vim-editor set-global
+[ vim ] edit-hook set-global
+\ vim vim-editor set-global
--- a/basis/environment/unix/unix.factor
+++ b/basis/environment/unix/unix.factor
@ -2,8 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: alien alien.c-types alien.strings alien.syntax kernel
 layouts sequences system unix environment io.encodings.utf8
-unix.utilities vocabs.loader combinators alien.accessors
-alien.syntax ;
+unix.utilities vocabs.loader combinators alien.accessors ;
 IN: environment.unix

 HOOK: environ os ( -- void* )
--- a/basis/eval/eval.factor
+++ b/basis/eval/eval.factor
@ -1,6 +1,6 @@
 ! Copyright (C) 2008, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: splitting parser compiler.units kernel namespaces
+USING: splitting parser parser.notes compiler.units kernel namespaces
 debugger io.streams.string fry combinators effects.parser ;
 IN: eval

--- a/basis/farkup/farkup-tests.factor
+++ b/basis/farkup/farkup-tests.factor
@ -96,7 +96,7 @@ link-no-follow? off
 [ "<pre><span class=\"KEYWORD3\">int</span> <span class=\"FUNCTION\">main</span><span class=\"OPERATOR\">(</span><span class=\"OPERATOR\">)</span></pre>" ]
 [ "[c{int main()}]" convert-farkup ] unit-test

-[ "<p><img src=\"lol.jpg\" alt=\"image:lol.jpg\"/></p>" ] [ "[[image:lol.jpg]]" convert-farkup ] unit-test
+[ "<p><img src=\"lol.jpg\" alt=\"lol.jpg\"/></p>" ] [ "[[image:lol.jpg]]" convert-farkup ] unit-test
 [ "<p><img src=\"lol.jpg\" alt=\"teh lol\"/></p>" ] [ "[[image:lol.jpg|teh lol]]" convert-farkup ] unit-test
 [ "<p><a href=\"http://lol.com\">http://lol.com</a></p>" ] [ "[[http://lol.com]]" convert-farkup ] unit-test
 [ "<p><a href=\"http://lol.com\">haha</a></p>" ] [ "[[http://lol.com|haha]]" convert-farkup ] unit-test
@ -207,3 +207,5 @@ link-no-follow? off
        [ convert-farkup drop t ] [ drop print f ] recover
    ] all?
 ] unit-test
+
+[ "<p><a href=\"http://foo.com/~foo\">http://foo.com/~foo</a></p>" ] [ "[[http://foo.com/~foo]]" convert-farkup ] unit-test
--- a/basis/farkup/farkup.factor
+++ b/basis/farkup/farkup.factor
@ -70,11 +70,15 @@ DEFER: (parse-paragraph)
        { CHAR: % inline-code }
    } at ;

+: or-simple-title ( url title/f quot: ( title -- title' ) -- url title' )
+    [ "" like dup simple-link-title ] if* ; inline
+
 : parse-link ( string -- paragraph-list )
    rest-slice "]]" split1-slice [
        "|" split1
-        [ "" like dup simple-link-title ] unless*
-        [ "image:" ?head ] dip swap [ image boa ] [ parse-paragraph link boa ] if
+        [ "image:" ?head ] dip swap
+        [ [ ] or-simple-title image boa ]
+        [ [ parse-paragraph ] or-simple-title link boa ] if
    ] dip [ (parse-paragraph) cons ] [ 1list ] if* ;

 : ?first ( seq -- elt ) 0 swap ?nth ;
--- a/basis/formatting/formatting.factor
+++ b/basis/formatting/formatting.factor
@ -1,10 +1,10 @@
 ! Copyright (C) 2008 John Benediktsson
 ! See http://factorcode.org/license.txt for BSD license

-USING: accessors arrays ascii assocs calendar combinators fry kernel 
-generalizations io io.encodings.ascii io.files io.streams.string
-macros math math.functions math.parser peg.ebnf quotations
-sequences splitting strings unicode.case vectors combinators.smart ;
+USING: accessors arrays assocs calendar combinators fry kernel
+generalizations io io.streams.string macros math math.functions
+math.parser peg.ebnf quotations sequences splitting strings
+unicode.categories unicode.case vectors combinators.smart ;

 IN: formatting

--- a/basis/ftp/server/server-tests.factor
+++ b/basis/ftp/server/server-tests.factor
@ -2,6 +2,7 @@ USING: calendar ftp.server io.encodings.ascii io.files
 io.files.unique namespaces threads tools.test kernel
 io.servers.connection ftp.client accessors urls
 io.pathnames io.directories sequences fry ;
+FROM: ftp.client => ftp-get ;
 IN: ftp.server.tests

 : test-file-contents ( -- string )
--- a/basis/functors/functors.factor
+++ b/basis/functors/functors.factor
@ -146,10 +146,10 @@ DEFER: ;FUNCTOR delimiter
    } ;

 : push-functor-words ( -- )
-    functor-words use get push ;
+    functor-words use-words ;

 : pop-functor-words ( -- )
-    functor-words use get delq ;
+    functor-words unuse-words ;

 : parse-functor-body ( -- form )
    push-functor-words
--- a/basis/furnace/auth/auth-docs.factor
+++ b/basis/furnace/auth/auth-docs.factor
@ -1,6 +1,6 @@
 USING: assocs classes help.markup help.syntax kernel
 quotations strings words words.symbol furnace.auth.providers.db
-checksums.sha2 furnace.auth.providers math byte-arrays
+checksums.sha furnace.auth.providers math byte-arrays
 http multiline ;
 IN: furnace.auth

--- a/basis/furnace/auth/auth.factor
+++ b/basis/furnace/auth/auth.factor
@ -3,7 +3,7 @@
 USING: accessors assocs namespaces kernel sequences sets
 destructors combinators fry logging
 io.encodings.utf8 io.encodings.string io.binary random
-checksums checksums.sha2 urls
+checksums checksums.sha urls
 html.forms
 http.server
 http.server.filters
--- a/basis/furnace/sessions/sessions-docs.factor
+++ b/basis/furnace/sessions/sessions-docs.factor
@ -1,5 +1,5 @@
 USING: help.markup help.syntax io.streams.string quotations
-strings calendar serialize kernel furnace.db words words.symbol
+strings calendar serialize furnace.db words words.symbol
 kernel ;
 IN: furnace.sessions

--- a/basis/game-input/iokit/iokit.factor
+++ b/basis/game-input/iokit/iokit.factor
@ -1,9 +1,9 @@
 USING: cocoa cocoa.plists core-foundation iokit iokit.hid
 kernel cocoa.enumeration destructors math.parser cocoa.application 
 sequences locals combinators.short-circuit threads
-namespaces assocs vectors arrays combinators hints alien
+namespaces assocs arrays combinators hints alien
 core-foundation.run-loop accessors sequences.private
-alien.c-types math parser game-input vectors ;
+alien.c-types math parser game-input vectors bit-arrays ;
 IN: game-input.iokit

 SINGLETON: iokit-game-input-backend
@ -12,10 +12,11 @@ SYMBOLS: +hid-manager+ +keyboard-state+ +mouse-state+ +controller-states+ ;

 iokit-game-input-backend game-input-backend set-global

-: hid-manager-matching ( matching-seq -- alien )
-    f 0 IOHIDManagerCreate
-    [ swap >plist IOHIDManagerSetDeviceMatchingMultiple ]
-    keep ;
+: make-hid-manager ( -- alien )
+    f 0 IOHIDManagerCreate ;
+
+: set-hid-manager-matching ( alien matching-seq -- )
+    >plist IOHIDManagerSetDeviceMatchingMultiple ;

 : devices-from-hid-manager ( manager -- vector )
    [
@ -85,9 +86,6 @@ CONSTANT: hat-switch-matching-hash
 : ?hat-switch ( device -- ? )
    hat-switch-matching-hash ?axis ;

-: hid-manager-matching-game-devices ( -- alien )
-    game-devices-matching-seq hid-manager-matching ;
-
 : device-property ( device key -- value )
    <NSString> IOHIDDeviceGetProperty [ plist> ] [ f ] if* ;
 : element-property ( element key -- value )
@ -186,7 +184,7 @@ HINTS: record-controller { controller-state alien } ;
        rot ?set-nth
    ] [ 3drop ] if ;

-HINTS: record-keyboard { array alien } ;
+HINTS: record-keyboard { bit-array alien } ;

 : record-mouse ( mouse-state value -- )
    dup IOHIDValueGetElement {
@ -285,15 +283,16 @@ M: iokit-game-input-backend reset-mouse
    4 <vector> +controller-states+ set-global
    0 0 0 0 2 <vector> mouse-state boa
        +mouse-state+ set-global
-    256 f <array> +keyboard-state+ set-global ;
+    256 <bit-array> +keyboard-state+ set-global ;

 M: iokit-game-input-backend (open-game-input)
-    hid-manager-matching-game-devices {
+    make-hid-manager {
        [ initialize-variables ]
        [ device-matched-callback f IOHIDManagerRegisterDeviceMatchingCallback ]
        [ device-removed-callback f IOHIDManagerRegisterDeviceRemovalCallback ]
        [ device-input-callback f IOHIDManagerRegisterInputValueCallback ]
        [ 0 IOHIDManagerOpen mach-error ]
+        [ game-devices-matching-seq set-hid-manager-matching ]
        [
            CFRunLoopGetMain CFRunLoopDefaultMode
            IOHIDManagerScheduleWithRunLoop
--- a/basis/help/cookbook/cookbook.factor
+++ b/basis/help/cookbook/cookbook.factor
@ -1,4 +1,4 @@
-USING: help.markup help.syntax io kernel math namespaces parser
+USING: help.markup help.syntax io kernel math parser
 prettyprint sequences vocabs.loader namespaces stack-checker
 help command-line multiline see ;
 IN: help.cookbook
@ -136,7 +136,7 @@ ARTICLE: "cookbook-variables" "Dynamic variables cookbook"
 } ;

 ARTICLE: "cookbook-vocabs" "Vocabularies cookbook"
-"Rather than being in one flat list, words belong to vocabularies; every word is contained in exactly one. When parsing a word name, the parser searches the " { $emphasis "vocabulary search path" } ". When working at the listener, a useful set of vocabularies is already available. In a source file, all used vocabularies must be imported."
+"Rather than being in one flat list, words belong to vocabularies; every word is contained in exactly one. When parsing a word name, the parser searches through vocabularies. When working at the listener, a useful set of vocabularies is already available. In a source file, all used vocabularies must be imported."
 $nl
 "For example, a source file containing the following code will print a parse error if you try loading it:"
 { $code "\"Hello world\" print" }
@ -161,7 +161,7 @@ $nl
 "You would have to place the first definition after the two others for the parser to accept the file."
 { $references
    { }
-    "vocabulary-search"
+    "word-search"
    "words"
    "parser"
 } ;
@ -286,7 +286,6 @@ ARTICLE: "cookbook-pitfalls" "Pitfalls to avoid"
 { $list
    "Factor only makes use of one native thread, and Factor threads are scheduled co-operatively. C library calls block the entire VM."
    "Factor does not hide anything from the programmer, all internals are exposed. It is your responsibility to avoid writing fragile code which depends too much on implementation detail."
-    { "When a source file uses two vocabularies which define words with the same name, the order of the vocabularies in the " { $link POSTPONE: USE: } " or " { $link POSTPONE: USING: } " forms is important. The " { $link POSTPONE: QUALIFIED: } " word implements qualified naming, which can be used to resolve ambiguities." }
    { "If a literal object appears in a word definition, the object itself is pushed on the stack when the word executes, not a copy. If you intend to mutate this object, you must " { $link clone } " it first. See " { $link "syntax-literals" } "." }
    { "For a discussion of potential issues surrounding the " { $link f } " object, see " { $link "booleans" } "." }
    { "Factor's object system is quite flexible. Careless usage of union, mixin and predicate classes can lead to similar problems to those caused by “multiple inheritance” in other languages. In particular, it is possible to have two classes such that they have a non-empty intersection and yet neither is a subclass of the other. If a generic word defines methods on two such classes, various disambiguation rules are applied to ensure method dispatch remains deterministic, however they may not be what you expect. See " { $link "method-order" } " for details." }
--- a/basis/help/handbook/handbook.factor
+++ b/basis/help/handbook/handbook.factor
@ -248,14 +248,14 @@ ARTICLE: "handbook-language-reference" "The language"
 { $subsection "namespaces-global" }
 { $subsection "values" }
 { $heading "Abstractions" }
-{ $subsection "errors" }
+{ $subsection "fry" }
 { $subsection "objects" }
+{ $subsection "errors" }
 { $subsection "destructors" }
-{ $subsection "continuations" }
 { $subsection "memoize" }
 { $subsection "parsing-words" }
 { $subsection "macros" }
-{ $subsection "fry" }
+{ $subsection "continuations" }
 { $heading "Program organization" }
 { $subsection "vocabs.loader" }
 "Vocabularies tagged " { $link T{ vocab-tag { name "extensions" } } } " implement various additional language abstractions." ;
--- a/basis/help/html/html-tests.factor
+++ b/basis/help/html/html-tests.factor
@ -2,3 +2,5 @@ IN: help.html.tests
 USING: help.html tools.test help.topics kernel ;

 [ ] [ "xml" >link help>html drop ] unit-test
+
+[ "article-foobar.html" ] [ "foobar" >link topic>filename ] unit-test
--- a/basis/help/html/html.factor
+++ b/basis/help/html/html.factor
@ -1,11 +1,13 @@
 ! Copyright (C) 2008, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: io.encodings.utf8 io.encodings.ascii io.encodings.binary
+USING: io.encodings.utf8 io.encodings.binary
 io.files io.files.temp io.directories html.streams help kernel
 assocs sequences make words accessors arrays help.topics vocabs
 vocabs.hierarchy help.vocabs namespaces prettyprint io
-vocabs.loader serialize fry memoize ascii unicode.case math.order
+vocabs.loader serialize fry memoize unicode.case math.order
 sorting debugger html xml.syntax xml.writer math.parser ;
+FROM: io.encodings.ascii => ascii ;
+FROM: ascii => ascii? ;
 IN: help.html

 : escape-char ( ch -- )
--- a/basis/help/lint/lint.factor
+++ b/basis/help/lint/lint.factor
@ -66,11 +66,12 @@ PRIVATE>
    ] check-something ;

 : check-about ( vocab -- )
-    dup '[ _ vocab-help [ article drop ] when* ] check-something ;
+    vocab-link boa dup
+    '[ _ vocab-help [ article drop ] when* ] check-something ;

 : check-vocab ( vocab -- )
    "Checking " write dup write "..." print
-    [ vocab check-about ]
+    [ check-about ]
    [ words [ check-word ] each ]
    [ vocab-articles get at [ check-article ] each ]
    tri ;
--- a/basis/help/markup/markup.factor
+++ b/basis/help/markup/markup.factor
@ -5,6 +5,7 @@ hashtables namespaces make parser prettyprint sequences strings
 io.styles vectors words math sorting splitting classes slots fry
 sets vocabs help.stylesheet help.topics vocabs.loader quotations
 combinators see present ;
+FROM: prettyprint.sections => with-pprint ;
 IN: help.markup

 PREDICATE: simple-element < array
@ -348,8 +349,6 @@ M: f ($instance)
    drop
    "Throws an error if the I/O operation fails." $errors ;

-FROM: prettyprint.private => with-pprint ;
-
 : $prettyprinting-note ( children -- )
    drop {
        "This word should only be called from inside the "
--- a/basis/help/syntax/syntax.factor
+++ b/basis/help/syntax/syntax.factor
@ -16,4 +16,4 @@ SYNTAX: ARTICLE:
    ] dip remember-definition ;

 SYNTAX: ABOUT:
-    in get vocab scan-object >>help changed-definition ;
+    current-vocab scan-object >>help changed-definition ;
--- a/basis/help/tutorial/tutorial.factor
+++ b/basis/help/tutorial/tutorial.factor
@ -38,7 +38,7 @@ $nl
 $nl
 "Now we have changed the source file, we must reload it into Factor so that we can test the new definition. To do this, simply go to the Factor listener and press " { $command tool "common" refresh-all } ". This will find any previously-loaded source files which have changed on disk, and reload them."
 $nl
-"When you do this, you will get an error about the " { $link dup } " word not being found. This is because this word is part of the " { $vocab-link "kernel" } " vocabulary, but this vocabulary is not part of the source file's " { $link "vocabulary-search" } ". You must explicitly list dependencies in source files. This allows Factor to automatically load required vocabularies and makes larger programs easier to maintain."
+"When you do this, you will get an error about the " { $link dup } " word not being found. This is because this word is part of the " { $vocab-link "kernel" } " vocabulary, but this vocabulary is not part of the source file's " { $link "word-search" } ". You must explicitly list dependencies in source files. This allows Factor to automatically load required vocabularies and makes larger programs easier to maintain."
 $nl
 "To add the word to the search path, first convince yourself that this word is in the " { $vocab-link "kernel" } " vocabulary. Enter " { $snippet "dup" } " in the listener's input area, and press " { $operation com-browse } ". This will open the documentation browser tool, viewing the help for the " { $link dup } " word. One of the subheadings in the help article will mention the word's vocabulary."
 $nl
--- a/basis/html/components/components-tests.factor
+++ b/basis/html/components/components-tests.factor
@ -3,6 +3,7 @@ USING: tools.test kernel io.streams.string
 io.streams.null accessors inspector html.streams
 html.components html.forms namespaces
 xml.writer ;
+FROM: html.components => inspector ;

 [ ] [ begin-form ] unit-test

--- a/basis/html/forms/forms-tests.factor
+++ b/basis/html/forms/forms-tests.factor
@ -1,6 +1,7 @@
 IN: html.forms.tests
 USING: kernel sequences tools.test assocs html.forms validators accessors
 namespaces ;
+FROM: html.forms => values ;

 : with-validation ( quot -- messages )
    [
--- a/basis/html/streams/streams-tests.factor
+++ b/basis/html/streams/streams-tests.factor
@ -1,6 +1,6 @@
 USING: html.streams html.streams.private accessors io
 io.streams.string io.styles kernel namespaces tools.test
-xml.writer sbufs sequences inspector colors xml.writer
+sbufs sequences inspector colors xml.writer
 classes.predicate prettyprint ;
 IN: html.streams.tests

--- a/basis/html/templates/chloe/chloe-docs.factor
+++ b/basis/html/templates/chloe/chloe-docs.factor
@ -1,8 +1,9 @@
 IN: html.templates.chloe
-USING: xml.data help.markup help.syntax html.components html.forms
+USING: help.markup help.syntax html.components html.forms
 html.templates html.templates.chloe.syntax
 html.templates.chloe.compiler html.templates.chloe.components
 math strings quotations namespaces ;
+FROM: xml.data => tag ;

 HELP: <chloe>
 { $values { "path" "a pathname string without the trailing " { $snippet ".xml" } " extension" } { "chloe" chloe } }
--- a/basis/html/templates/chloe/chloe-tests.factor
+++ b/basis/html/templates/chloe/chloe-tests.factor
@ -1,7 +1,7 @@
 USING: html.templates html.templates.chloe
 tools.test io.streams.string kernel sequences ascii boxes
 namespaces xml html.components html.forms
-splitting unicode.categories furnace accessors
+splitting furnace accessors
 html.templates.chloe.compiler ;
 IN: html.templates.chloe.tests

--- a/basis/html/templates/chloe/chloe.factor
+++ b/basis/html/templates/chloe/chloe.factor
@ -1,11 +1,11 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors kernel sequences combinators kernel fry
+USING: accessors kernel sequences combinators fry
 namespaces make classes.tuple assocs splitting words arrays io
 io.files io.files.info io.encodings.utf8 io.streams.string
 unicode.case mirrors math urls present multiline quotations xml
 logging
-xml.data xml.writer xml.syntax strings
+xml.writer xml.syntax strings
 html.forms
 html
 html.components
--- a/basis/html/templates/chloe/syntax/syntax.factor
+++ b/basis/html/templates/chloe/syntax/syntax.factor
@ -1,13 +1,11 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-IN: html.templates.chloe.syntax
-USING: accessors kernel sequences combinators kernel namespaces
-classes.tuple assocs splitting words arrays memoize parser lexer
-io io.files io.encodings.utf8 io.streams.string
-unicode.case mirrors fry math urls
-multiline xml xml.data xml.writer xml.syntax
-html.components
+USING: accessors sequences combinators kernel namespaces classes.tuple
+assocs splitting words arrays memoize parser lexer io io.files
+io.encodings.utf8 io.streams.string unicode.case mirrors fry math urls
+multiline xml xml.data xml.writer xml.syntax html.components
 html.templates ;
+IN: html.templates.chloe.syntax

 SYMBOL: tags

--- a/basis/html/templates/fhtml/fhtml.factor
+++ b/basis/html/templates/fhtml/fhtml.factor
@ -3,7 +3,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: continuations sequences kernel namespaces debugger
 combinators math quotations generic strings splitting accessors
-assocs fry vocabs.parser parser lexer io io.files
+assocs fry vocabs.parser parser parser.notes lexer io io.files
 io.streams.string io.encodings.utf8 html.templates ;
 IN: html.templates.fhtml

@ -60,7 +60,7 @@ SYNTAX: %> lexer get parse-%> ;
    [
        "quiet" on
        parser-notes off
-        "html.templates.fhtml" use+
+        "html.templates.fhtml" use-vocab
        string-lines parse-template-lines
    ] with-file-vocabs ;

--- a/Show More
+++ b/Show More