Merge git://factorcode.org/git/factor

Makefile

@@ -56,6 +56,8 @@ default:
 	@echo "linux-arm"
 	@echo "openbsd-x86-32"
 	@echo "openbsd-x86-64"
+	@echo "netbsd-x86-32"
+	@echo "netbsd-x86-64"
 	@echo "macosx-x86-32"
 	@echo "macosx-x86-64"
 	@echo "macosx-ppc"
@@ -83,6 +85,12 @@ freebsd-x86-32:
 freebsd-x86-64:
 	$(MAKE) $(EXECUTABLE) CONFIG=vm/Config.freebsd.x86.64
 
+netbsd-x86-32:
+	$(MAKE) $(EXECUTABLE) CONFIG=vm/Config.netbsd.x86.32
+
+netbsd-x86-64:
+	$(MAKE) $(EXECUTABLE) CONFIG=vm/Config.netbsd.x86.64
+
 macosx-freetype:
 	ln -sf libfreetype.6.dylib \
 		Factor.app/Contents/Frameworks/libfreetype.dylib

core/alien/alien-docs.factor

@@ -1,6 +1,7 @@
 USING: byte-arrays arrays help.syntax help.markup
 alien.syntax compiler definitions math libc
-debugger parser io io.backend system bit-arrays float-arrays ;
+debugger parser io io.backend system bit-arrays float-arrays
+alien.accessors ;
 IN: alien
 
 HELP: alien

core/alien/alien-tests.factor

@@ -1,7 +1,7 @@
 IN: temporary
-USING: alien byte-arrays
+USING: alien alien.accessors byte-arrays arrays kernel
-arrays kernel kernel.private namespaces tools.test sequences
+kernel.private namespaces tools.test sequences libc math system
-libc math system prettyprint ;
+prettyprint ;
 
 [ t ] [ -1 <alien> alien-address 0 > ] unit-test
 

core/alien/alien.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2004, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: assocs kernel math namespaces sequences system
-kernel.private tuples ;
+kernel.private tuples bit-arrays byte-arrays float-arrays ;
 IN: alien
 
 ! Some predicate classes used by the compiler for optimization
@@ -9,16 +9,11 @@ IN: alien
 PREDICATE: alien simple-alien
     underlying-alien not ;
 
-! These mixins are not intended to be extended by user code.
+UNION: simple-c-ptr
-! They are not unions, because if they were we'd have a circular
+simple-alien POSTPONE: f byte-array bit-array float-array ;
-! dependency between alien and {byte,bit,float}-arrays.
-MIXIN: simple-c-ptr
-INSTANCE: simple-alien simple-c-ptr
-INSTANCE: f simple-c-ptr
 
-MIXIN: c-ptr
+UNION: c-ptr
-INSTANCE: alien c-ptr
+alien POSTPONE: f byte-array bit-array float-array ;
-INSTANCE: f c-ptr
 
 DEFER: pinned-c-ptr?
 

core/alien/c-types/c-types.factor

@@ -3,7 +3,7 @@
 USING: byte-arrays arrays generator.registers assocs
 kernel kernel.private libc math namespaces parser sequences
 strings words assocs splitting math.parser cpu.architecture
-alien quotations system compiler.units ;
+alien alien.accessors quotations system compiler.units ;
 IN: alien.c-types
 
 TUPLE: c-type

core/ascii/ascii-docs.factor

@@ -0,0 +1,51 @@
+USING: help.markup help.syntax ;
+IN: ascii
+
+HELP: blank?
+{ $values { "ch" "a character" } { "?" "a boolean" } }
+{ $description "Tests for an ASCII whitespace character." } ;
+
+HELP: letter?
+{ $values { "ch" "a character" } { "?" "a boolean" } }
+{ $description "Tests for a lowercase alphabet ASCII character." } ;
+
+HELP: LETTER?
+{ $values { "ch" "a character" } { "?" "a boolean" } }
+{ $description "Tests for a uppercase alphabet ASCII character." } ;
+
+HELP: digit?
+{ $values { "ch" "a character" } { "?" "a boolean" } }
+{ $description "Tests for an ASCII decimal digit character." } ;
+
+HELP: Letter?
+{ $values { "ch" "a character" } { "?" "a boolean" } }
+{ $description "Tests for an ASCII alphabet character, both upper and lower case." } ;
+
+HELP: alpha?
+{ $values { "ch" "a character" } { "?" "a boolean" } }
+{ $description "Tests for an alphanumeric ASCII character." } ;
+
+HELP: printable?
+{ $values { "ch" "a character" } { "?" "a boolean" } }
+{ $description "Tests for a printable ASCII character." } ;
+
+HELP: control?
+{ $values { "ch" "a character" } { "?" "a boolean" } }
+{ $description "Tests for an ASCII control character." } ;
+
+HELP: quotable?
+{ $values { "ch" "a character" } { "?" "a boolean" } }
+{ $description "Tests for characters which may appear in a Factor string literal without escaping." } ;
+
+ARTICLE: "ascii" "ASCII character classes"
+"Traditional ASCII character classes:"
+{ $subsection blank? }
+{ $subsection letter? }
+{ $subsection LETTER? }
+{ $subsection digit? }
+{ $subsection printable? }
+{ $subsection control? }
+{ $subsection quotable? }
+"Modern applications should use Unicode 5.0 instead (" { $vocab-link "unicode" } ")." ;
+
+ABOUT: "ascii"

core/ascii/ascii.factor

@@ -0,0 +1,27 @@
+! Copyright (C) 2005, 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: sequences math kernel ;
+IN: ascii
+
+: blank? ( ch -- ? ) " \t\n\r" member? ; inline
+
+: letter? ( ch -- ? ) CHAR: a CHAR: z between? ; inline
+
+: LETTER? ( ch -- ? ) CHAR: A CHAR: Z between? ; inline
+
+: digit? ( ch -- ? ) CHAR: 0 CHAR: 9 between? ; inline
+
+: printable? ( ch -- ? ) CHAR: \s CHAR: ~ between? ; inline
+
+: control? ( ch -- ? ) "\0\e\r\n\t\u0008\u007f" member? ; inline
+
+: quotable? ( ch -- ? )
+    dup printable? [ "\"\\" member? not ] [ drop f ] if ; inline
+
+: Letter? ( ch -- ? )
+    dup letter? [ drop t ] [ LETTER? ] if ; inline
+
+: alpha? ( ch -- ? )
+    dup Letter? [ drop t ] [ digit? ] if ; inline
+
+

core/ascii/authors.txt

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

core/ascii/summary.txt

@@ -0,0 +1 @@
+ASCII character classes

core/ascii/tags.txt

@@ -0,0 +1 @@
+text

core/bit-arrays/bit-arrays-tests.factor

@@ -46,3 +46,9 @@ IN: temporary
 [ ?{ f } ] [
     1 2 { t f t f } <slice> >bit-array
 ] unit-test
+
+[ ?{ t f t f f f } ] [ 6 ?{ t f t } resize-bit-array ] unit-test
+
+[ ?{ t t } ] [ 2 ?{ t t f t f t f t t t f t } resize-bit-array ] unit-test
+
+[ -10 ?{ } resize-bit-array ] unit-test-fails

core/bit-arrays/bit-arrays.factor

@@ -1,6 +1,6 @@
 ! Copyright (C) 2007, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: math alien kernel kernel.private sequences
+USING: math alien.accessors kernel kernel.private sequences
 sequences.private ;
 IN: bit-arrays
 
@@ -48,6 +48,7 @@ M: bit-array new drop <bit-array> ;
 M: bit-array equal?
     over bit-array? [ sequence= ] [ 2drop f ] if ;
 
+M: bit-array resize
+    resize-bit-array ;
+
 INSTANCE: bit-array sequence
-INSTANCE: bit-array simple-c-ptr
-INSTANCE: bit-array c-ptr

core/bit-vectors/bit-vectors-docs.factor

@@ -0,0 +1,33 @@
+USING: arrays bit-arrays help.markup help.syntax kernel
+bit-vectors.private combinators ;
+IN: bit-vectors
+
+ARTICLE: "bit-vectors" "Bit vectors"
+"A bit vector is a resizable mutable sequence of bits. The literal syntax is covered in " { $link "syntax-bit-vectors" } ". Bit vector words are found in the " { $vocab-link "bit-vectors" } " vocabulary."
+$nl
+"Bit vectors form a class:"
+{ $subsection bit-vector }
+{ $subsection bit-vector? }
+"Creating bit vectors:"
+{ $subsection >bit-vector }
+{ $subsection <bit-vector> }
+"If you don't care about initial capacity, a more elegant way to create a new bit vector is to write:"
+{ $code "?V{ } clone" } ;
+
+ABOUT: "bit-vectors"
+
+HELP: bit-vector
+{ $description "The class of resizable bit vectors. See " { $link "syntax-bit-vectors" } " for syntax and " { $link "bit-vectors" } " for general information." } ;
+
+HELP: <bit-vector>
+{ $values { "n" "a positive integer specifying initial capacity" } { "bit-vector" bit-vector } }
+{ $description "Creates a new bit vector that can hold " { $snippet "n" } " bits before resizing." } ;
+
+HELP: >bit-vector
+{ $values { "seq" "a sequence" } { "bit-vector" bit-vector } }
+{ $description "Outputs a freshly-allocated bit vector with the same elements as a given sequence." } ;
+
+HELP: bit-array>vector
+{ $values { "bit-array" "an array" } { "length" "a non-negative integer" } { "bit-vector" bit-vector } }
+{ $description "Creates a new bit vector using the array for underlying storage with the specified initial length." }
+{ $warning "This word is in the " { $vocab-link "bit-vectors.private" } " vocabulary because it does not perform type or bounds checks. User code should call " { $link >bit-vector } " instead." } ;

core/bit-vectors/bit-vectors-tests.factor

@@ -0,0 +1,14 @@
+IN: temporary
+USING: tools.test bit-vectors vectors sequences kernel math ;
+
+[ 0 ] [ 123 <bit-vector> length ] unit-test
+
+: do-it
+    1234 swap [ >r even? r> push ] curry each ;
+
+[ t ] [
+    3 <bit-vector> dup do-it
+    3 <vector> dup do-it sequence=
+] unit-test
+
+[ t ] [ ?V{ } bit-vector? ] unit-test

core/bit-vectors/bit-vectors.factor

@@ -0,0 +1,33 @@
+! Copyright (C) 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: arrays kernel kernel.private math sequences
+sequences.private growable bit-arrays ;
+IN: bit-vectors
+
+<PRIVATE
+
+: bit-array>vector ( bit-array length -- bit-vector )
+    bit-vector construct-boa ; inline
+
+PRIVATE>
+
+: <bit-vector> ( n -- bit-vector )
+    <bit-array> 0 bit-array>vector ; inline
+
+: >bit-vector ( seq -- bit-vector ) ?V{ } clone-like ;
+
+M: bit-vector like
+    drop dup bit-vector? [
+        dup bit-array?
+        [ dup length bit-array>vector ] [ >bit-vector ] if
+    ] unless ;
+
+M: bit-vector new
+    drop [ <bit-array> ] keep >fixnum bit-array>vector ;
+
+M: bit-vector equal?
+    over bit-vector? [ sequence= ] [ 2drop f ] if ;
+
+M: bit-array new-resizable drop <bit-vector> ;
+
+INSTANCE: bit-vector growable

core/bootstrap/image/image.factor

@@ -17,8 +17,6 @@ IN: bootstrap.image
 : image-magic HEX: 0f0e0d0c ; inline
 : image-version 4 ; inline
 
-: char bootstrap-cell 2/ ; inline
-
 : data-base 1024 ; inline
 
 : userenv-size 40 ; inline
@@ -244,21 +242,19 @@ M: wrapper '
     [ emit ] emit-object ;
 
 ! Strings
-: 16be> 0 [ swap 16 shift bitor ] reduce ;
-: 16le> <reversed> 16be> ;
-
 : emit-chars ( seq -- )
-    char <groups>
+    bootstrap-cell <groups>
-    big-endian get [ [ 16be> ] map ] [ [ 16le> ] map ] if
+    big-endian get [ [ be> ] map ] [ [ le> ] map ] if
     emit-seq ;
 
 : pack-string ( string -- newstr )
-    dup length 1+ char align 0 pad-right ;
+    dup length 1+ bootstrap-cell align 0 pad-right ;
 
 : emit-string ( string -- ptr )
     string type-number object tag-number [
         dup length emit-fixnum
         f ' emit
+        f ' emit
         pack-string emit-chars
     ] emit-object ;
 
@@ -320,24 +316,33 @@ M: quotation '
 ! Vectors and sbufs
 
 M: vector '
-    dup underlying ' swap length
+    dup length swap underlying '
-    vector type-number object tag-number [
+    tuple type-number tuple tag-number [
-        emit-fixnum ! length
+        4 emit-fixnum
+        vector ' emit
+        f ' emit
         emit ! array ptr
+        emit-fixnum ! length
     ] emit-object ;
 
 M: sbuf '
-    dup underlying ' swap length
+    dup length swap underlying '
-    sbuf type-number object tag-number [
+    tuple type-number tuple tag-number [
-        emit-fixnum ! length
+        4 emit-fixnum
+        sbuf ' emit
+        f ' emit
         emit ! array ptr
+        emit-fixnum ! length
     ] emit-object ;
 
 ! Hashes
 
 M: hashtable '
     [ hash-array ' ] keep
-    hashtable type-number object tag-number [
+    tuple type-number tuple tag-number [
+        5 emit-fixnum
+        hashtable ' emit
+        f ' emit
         dup hash-count emit-fixnum
         hash-deleted emit-fixnum
         emit ! array ptr

core/bootstrap/layouts/layouts.factor

@@ -8,7 +8,7 @@ BIN: 111 tag-mask set
 8 num-tags set
 3 tag-bits set
 
-23 num-types set
+20 num-types set
 
 H{
     { fixnum      BIN: 000 }
@@ -24,17 +24,14 @@ H{
 tag-numbers get H{
     { array 8 }
     { wrapper 9 }
-    { hashtable 10 }
+    { float-array 10 }
-    { vector 11 }
+    { callstack 11 }
     { string 12 }
-    { sbuf 13 }
+    { curry 13 }
     { quotation 14 }
     { dll 15 }
     { alien 16 }
     { word 17 }
     { byte-array 18 }
     { bit-array 19 }
-    { float-array 20 }
-    { curry 21 }
-    { callstack 22 }
 } union type-numbers set

core/bootstrap/primitives.factor

@@ -22,7 +22,9 @@ crossref off
        { "arm" "arm" }
    } at "/bootstrap.factor" 3append parse-file
 
-! Now we have ( syntax-quot arch-quot ) on the stack
+"resource:core/bootstrap/layouts/layouts.factor" parse-file
+
+! Now we have ( syntax-quot arch-quot layouts-quot ) on the stack
 
 ! Bring up a bare cross-compiling vocabulary.
 "syntax" vocab vocab-words bootstrap-syntax set
@@ -30,6 +32,7 @@ H{ } clone dictionary set
 H{ } clone changed-words set
 [ drop ] recompile-hook set
 
+call
 call
 call
 
@@ -37,13 +40,17 @@ call
 ! classes will go
 {
     "alien"
+    "alien.accessors"
     "arrays"
     "bit-arrays"
+    "bit-vectors"
     "byte-arrays"
+    "byte-vectors"
     "classes.private"
     "compiler.units"
     "continuations.private"
     "float-arrays"
+    "float-vectors"
     "generator"
     "growable"
     "hashtables"
@@ -96,12 +103,6 @@ H{ } clone update-map set
 : register-builtin ( class -- )
     dup "type" word-prop builtins get set-nth ;
 
-: intern-slots ( spec -- spec )
-    [
-        [ dup array? [ first2 create ] when ] map
-        { slot-spec f } swap append >tuple
-    ] map ;
-
 : lookup-type-number ( word -- n )
     global [ target-word ] bind type-number ;
 
@@ -110,8 +111,8 @@ H{ } clone update-map set
     dup dup lookup-type-number "type" set-word-prop
     dup f f builtin-class define-class
     dup r> builtin-predicate
-    dup r> intern-slots 2dup "slots" set-word-prop
+    dup r> 1 simple-slots 2dup "slots" set-word-prop
-    define-slots
+    dupd define-slots
     register-builtin ;
 
 H{ } clone typemap set
@@ -137,14 +138,12 @@ num-types get f <array> builtins set
     {
         { "integer" "math" }
         "numerator"
-        1
         { "numerator" "math" }
         f
     }
     {
         { "integer" "math" }
         "denominator"
-        2
         { "denominator" "math" }
         f
     }
@@ -158,14 +157,12 @@ num-types get f <array> builtins set
     {
         { "real" "math" }
         "real-part"
-        1
         { "real-part" "math" }
         f
     }
     {
         { "real" "math" }
         "imaginary-part"
-        2
         { "imaginary-part" "math" }
         f
     }
@@ -182,78 +179,23 @@ num-types get f <array> builtins set
     {
         { "object" "kernel" }
         "wrapped"
-        1
         { "wrapped" "kernel" }
         f
     }
 } define-builtin
 
-"hashtable" "hashtables" create "hashtable?" "hashtables" create
-{
-    {
-        { "array-capacity" "sequences.private" }
-        "count"
-        1
-        { "hash-count" "hashtables.private" }
-        { "set-hash-count" "hashtables.private" }
-    } {
-        { "array-capacity" "sequences.private" }
-        "deleted"
-        2
-        { "hash-deleted" "hashtables.private" }
-        { "set-hash-deleted" "hashtables.private" }
-    } {
-        { "array" "arrays" }
-        "array"
-        3
-        { "hash-array" "hashtables.private" }
-        { "set-hash-array" "hashtables.private" }
-    }
-} define-builtin
-
-"vector" "vectors" create "vector?" "vectors" create
-{
-    {
-        { "array-capacity" "sequences.private" }
-        "fill"
-        1
-        { "length" "sequences" }
-        { "set-fill" "growable" }
-    } {
-        { "array" "arrays" }
-        "underlying"
-        2
-        { "underlying" "growable" }
-        { "set-underlying" "growable" }
-    }
-} define-builtin
-
 "string" "strings" create "string?" "strings" create
 {
     {
         { "array-capacity" "sequences.private" }
         "length"
-        1
         { "length" "sequences" }
         f
-    }
+    } {
-} define-builtin
+        { "object" "kernel" }
-
+        "aux"
-"sbuf" "sbufs" create "sbuf?" "sbufs" create
+        { "string-aux" "strings.private" }
-{
+        { "set-string-aux" "strings.private" }
-    {
-        { "array-capacity" "sequences.private" }
-        "length"
-        1
-        { "length" "sequences" }
-        { "set-fill" "growable" }
-    }
-    {
-        { "string" "strings" }
-        "underlying"
-        2
-        { "underlying" "growable" }
-        { "set-underlying" "growable" }
     }
 } define-builtin
 
@@ -262,14 +204,12 @@ num-types get f <array> builtins set
     {
         { "object" "kernel" }
         "array"
-        1
         { "quotation-array" "quotations.private" }
         f
     }
     {
         { "object" "kernel" }
         "compiled?"
-        2
         { "quotation-compiled?" "quotations" }
         f
     }
@@ -280,7 +220,6 @@ num-types get f <array> builtins set
     {
         { "byte-array" "byte-arrays" }
         "path"
-        1
         { "(dll-path)" "alien" }
         f
     }
@@ -292,13 +231,11 @@ define-builtin
     {
         { "c-ptr" "alien" }
         "alien"
-        1
         { "underlying-alien" "alien" }
         f
     } {
         { "object" "kernel" }
         "expired?"
-        2
         { "expired?" "alien" }
         f
     }
@@ -307,45 +244,40 @@ define-builtin
 
 "word" "words" create "word?" "words" create
 {
+    f
     {
         { "object" "kernel" }
         "name"
-        2
         { "word-name" "words" }
         { "set-word-name" "words" }
     }
     {
         { "object" "kernel" }
         "vocabulary"
-        3
         { "word-vocabulary" "words" }
         { "set-word-vocabulary" "words" }
     }
     {
         { "quotation" "quotations" }
         "def"
-        4
         { "word-def" "words" }
         { "set-word-def" "words.private" }
     }
     {
         { "object" "kernel" }
         "props"
-        5
         { "word-props" "words" }
         { "set-word-props" "words" }
     }
     {
         { "object" "kernel" }
         "?"
-        6
         { "compiled?" "words" }
         f
     }
     {
         { "fixnum" "math" }
         "counter"
-        7
         { "profile-counter" "tools.profiler.private" }
         { "set-profile-counter" "tools.profiler.private" }
     }
@@ -369,14 +301,12 @@ define-builtin
     {
         { "object" "kernel" }
         "obj"
-        1
         { "curry-obj" "kernel" }
         f
     }
     {
         { "object" "kernel" }
         "obj"
-        2
         { "curry-quot" "kernel" }
         f
     }
@@ -414,6 +344,102 @@ builtins get num-tags get tail f union-class define-class
 "tombstone" "hashtables.private" lookup t
 2array >tuple 1quotation define-inline
 
+! Some tuple classes
+"hashtable" "hashtables" create
+{
+    {
+        { "array-capacity" "sequences.private" }
+        "count"
+        { "hash-count" "hashtables.private" }
+        { "set-hash-count" "hashtables.private" }
+    } {
+        { "array-capacity" "sequences.private" }
+        "deleted"
+        { "hash-deleted" "hashtables.private" }
+        { "set-hash-deleted" "hashtables.private" }
+    } {
+        { "array" "arrays" }
+        "array"
+        { "hash-array" "hashtables.private" }
+        { "set-hash-array" "hashtables.private" }
+    }
+} define-tuple-class
+
+"sbuf" "sbufs" create
+{
+    {
+        { "string" "strings" }
+        "underlying"
+        { "underlying" "growable" }
+        { "set-underlying" "growable" }
+    } {
+        { "array-capacity" "sequences.private" }
+        "length"
+        { "length" "sequences" }
+        { "set-fill" "growable" }
+    }
+} define-tuple-class
+
+"vector" "vectors" create
+{
+    {
+        { "array" "arrays" }
+        "underlying"
+        { "underlying" "growable" }
+        { "set-underlying" "growable" }
+    } {
+        { "array-capacity" "sequences.private" }
+        "fill"
+        { "length" "sequences" }
+        { "set-fill" "growable" }
+    }
+} define-tuple-class
+
+"byte-vector" "byte-vectors" create
+{
+    {
+        { "byte-array" "byte-arrays" }
+        "underlying"
+        { "underlying" "growable" }
+        { "set-underlying" "growable" }
+    } {
+        { "array-capacity" "sequences.private" }
+        "fill"
+        { "length" "sequences" }
+        { "set-fill" "growable" }
+    }
+} define-tuple-class
+
+"bit-vector" "bit-vectors" create
+{
+    {
+        { "bit-array" "bit-arrays" }
+        "underlying"
+        { "underlying" "growable" }
+        { "set-underlying" "growable" }
+    } {
+        { "array-capacity" "sequences.private" }
+        "fill"
+        { "length" "sequences" }
+        { "set-fill" "growable" }
+    }
+} define-tuple-class
+
+"float-vector" "float-vectors" create
+{
+    {
+        { "float-array" "float-arrays" }
+        "underlying"
+        { "underlying" "growable" }
+        { "set-underlying" "growable" }
+    } {
+        { "array-capacity" "sequences.private" }
+        "fill"
+        { "length" "sequences" }
+        { "set-fill" "growable" }
+    }
+} define-tuple-class
+
 ! Primitive words
 : make-primitive ( word vocab n -- )
     >r create dup reset-word r> [ do-primitive ] curry [ ] like define ;
@@ -422,7 +448,6 @@ builtins get num-tags get tail f union-class define-class
     { "(execute)" "words.private" }
     { "(call)" "kernel.private" }
     { "uncurry" "kernel.private" }
-    { "string>sbuf" "sbufs.private" }
     { "bignum>fixnum" "math.private" }
     { "float>fixnum" "math.private" }
     { "fixnum>bignum" "math.private" }
@@ -537,32 +562,32 @@ builtins get num-tags get tail f union-class define-class
     { "<byte-array>" "byte-arrays" }
     { "<bit-array>" "bit-arrays" }
     { "<displaced-alien>" "alien" }
-    { "alien-signed-cell" "alien" }
+    { "alien-signed-cell" "alien.accessors" }
-    { "set-alien-signed-cell" "alien" }
+    { "set-alien-signed-cell" "alien.accessors" }
-    { "alien-unsigned-cell" "alien" }
+    { "alien-unsigned-cell" "alien.accessors" }
-    { "set-alien-unsigned-cell" "alien" }
+    { "set-alien-unsigned-cell" "alien.accessors" }
-    { "alien-signed-8" "alien" }
+    { "alien-signed-8" "alien.accessors" }
-    { "set-alien-signed-8" "alien" }
+    { "set-alien-signed-8" "alien.accessors" }
-    { "alien-unsigned-8" "alien" }
+    { "alien-unsigned-8" "alien.accessors" }
-    { "set-alien-unsigned-8" "alien" }
+    { "set-alien-unsigned-8" "alien.accessors" }
-    { "alien-signed-4" "alien" }
+    { "alien-signed-4" "alien.accessors" }
-    { "set-alien-signed-4" "alien" }
+    { "set-alien-signed-4" "alien.accessors" }
-    { "alien-unsigned-4" "alien" }
+    { "alien-unsigned-4" "alien.accessors" }
-    { "set-alien-unsigned-4" "alien" }
+    { "set-alien-unsigned-4" "alien.accessors" }
-    { "alien-signed-2" "alien" }
+    { "alien-signed-2" "alien.accessors" }
-    { "set-alien-signed-2" "alien" }
+    { "set-alien-signed-2" "alien.accessors" }
-    { "alien-unsigned-2" "alien" }
+    { "alien-unsigned-2" "alien.accessors" }
-    { "set-alien-unsigned-2" "alien" }
+    { "set-alien-unsigned-2" "alien.accessors" }
-    { "alien-signed-1" "alien" }
+    { "alien-signed-1" "alien.accessors" }
-    { "set-alien-signed-1" "alien" }
+    { "set-alien-signed-1" "alien.accessors" }
-    { "alien-unsigned-1" "alien" }
+    { "alien-unsigned-1" "alien.accessors" }
-    { "set-alien-unsigned-1" "alien" }
+    { "set-alien-unsigned-1" "alien.accessors" }
-    { "alien-float" "alien" }
+    { "alien-float" "alien.accessors" }
-    { "set-alien-float" "alien" }
+    { "set-alien-float" "alien.accessors" }
-    { "alien-double" "alien" }
+    { "alien-double" "alien.accessors" }
-    { "set-alien-double" "alien" }
+    { "set-alien-double" "alien.accessors" }
-    { "alien-cell" "alien" }
+    { "alien-cell" "alien.accessors" }
-    { "set-alien-cell" "alien" }
+    { "set-alien-cell" "alien.accessors" }
     { "alien>char-string" "alien" }
     { "string>char-alien" "alien" }
     { "alien>u16-string" "alien" }
@@ -571,11 +596,10 @@ builtins get num-tags get tail f union-class define-class
     { "alien-address" "alien" }
     { "slot" "slots.private" }
     { "set-slot" "slots.private" }
-    { "char-slot" "strings.private" }
+    { "string-nth" "strings.private" }
-    { "set-char-slot" "strings.private" }
+    { "set-string-nth" "strings.private" }
     { "resize-array" "arrays" }
     { "resize-string" "strings" }
-    { "(hashtable)" "hashtables.private" }
     { "<array>" "arrays" }
     { "begin-scan" "memory" }
     { "next-object" "memory" }
@@ -590,7 +614,6 @@ builtins get num-tags get tail f union-class define-class
     { "fclose" "io.streams.c" }
     { "<wrapper>" "kernel" }
     { "(clone)" "kernel" }
-    { "array>vector" "vectors.private" }
     { "<string>" "strings" }
     { "(>tuple)" "tuples.private" }
     { "array>quotation" "quotations.private" }
@@ -610,6 +633,9 @@ builtins get num-tags get tail f union-class define-class
     { "set-innermost-frame-quot" "kernel.private" }
     { "call-clear" "kernel" }
     { "(os-envs)" "system" }
+    { "resize-byte-array" "byte-arrays" }
+    { "resize-bit-array" "bit-arrays" }
+    { "resize-float-array" "float-arrays" }
 }
 dup length [ >r first2 r> make-primitive ] 2each
 

core/bootstrap/stage2.factor

@@ -12,7 +12,7 @@ IN: bootstrap.stage2
 ! you can see what went wrong, instead of dealing with a
 ! fep
 [
-    vm file-name windows? [ >lower ".exe" ?tail drop ] when
+    vm file-name windows? [ "." split1 drop ] when
     ".image" append "output-image" set-global
 
     "math tools help compiler ui ui.tools io" "include" set-global
@@ -87,5 +87,5 @@ IN: bootstrap.stage2
         "output-image" get resource-path save-image-and-exit
     ] if
 ] [
-    error. :c "listener" vocab-main execute
+    print-error :c "listener" vocab-main execute
 ] recover

core/bootstrap/syntax.factor

@@ -16,12 +16,15 @@ f swap set-vocab-source-loaded?
     ";"
     "<PRIVATE"
     "?{"
+    "?V{"
     "BIN:"
     "B{"
+    "BV{"
     "C:"
     "CHAR:"
     "DEFER:"
     "F{"
+    "FV{"
     "FORGET:"
     "GENERIC#"
     "GENERIC:"

core/byte-arrays/byte-arrays-tests.factor

@@ -0,0 +1,8 @@
+IN: temporary
+USING: tools.test byte-arrays ;
+
+[ B{ 1 2 3 0 0 0 } ] [ 6 B{ 1 2 3 } resize-byte-array ] unit-test
+
+[ B{ 1 2 } ] [ 2 B{ 1 2 3 4 5 6 7 8 9 } resize-byte-array ] unit-test
+
+[ -10 B{ } resize-byte-array ] unit-test-fails

core/byte-arrays/byte-arrays.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2007, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel kernel.private alien sequences sequences.private
+USING: kernel kernel.private alien.accessors sequences
-math ;
+sequences.private math ;
 IN: byte-arrays
 
 M: byte-array clone (clone) ;
@@ -15,6 +15,7 @@ M: byte-array new drop <byte-array> ;
 M: byte-array equal?
     over byte-array? [ sequence= ] [ 2drop f ] if ;
 
+M: byte-array resize
+    resize-byte-array ;
+
 INSTANCE: byte-array sequence
-INSTANCE: byte-array simple-c-ptr
-INSTANCE: byte-array c-ptr

core/byte-vectors/byte-vectors-docs.factor

@@ -0,0 +1,34 @@
+USING: arrays byte-arrays help.markup help.syntax kernel
+byte-vectors.private combinators ;
+IN: byte-vectors
+
+ARTICLE: "byte-vectors" "Byte vectors"
+"A byte vector is a resizable mutable sequence of unsigned bytes. The literal syntax is covered in " { $link "syntax-byte-vectors" } ". Byte vector words are found in the " { $vocab-link "byte-vectors" } " vocabulary."
+$nl
+"Byte vectors form a class:"
+{ $subsection byte-vector }
+{ $subsection byte-vector? }
+"Creating byte vectors:"
+{ $subsection >byte-vector }
+{ $subsection <byte-vector> }
+"If you don't care about initial capacity, a more elegant way to create a new byte vector is to write:"
+{ $code "BV{ } clone" } ;
+
+ABOUT: "byte-vectors"
+
+HELP: byte-vector
+{ $description "The class of resizable byte vectors. See " { $link "syntax-byte-vectors" } " for syntax and " { $link "byte-vectors" } " for general information." } ;
+
+HELP: <byte-vector>
+{ $values { "n" "a positive integer specifying initial capacity" } { "byte-vector" byte-vector } }
+{ $description "Creates a new byte vector that can hold " { $snippet "n" } " bytes before resizing." } ;
+
+HELP: >byte-vector
+{ $values { "seq" "a sequence" } { "byte-vector" byte-vector } }
+{ $description "Outputs a freshly-allocated byte vector with the same elements as a given sequence." }
+{ $errors "Throws an error if the sequence contains elements other than integers." } ;
+
+HELP: byte-array>vector
+{ $values { "byte-array" "an array" } { "length" "a non-negative integer" } { "byte-vector" byte-vector } }
+{ $description "Creates a new byte vector using the array for underlying storage with the specified initial length." }
+{ $warning "This word is in the " { $vocab-link "byte-vectors.private" } " vocabulary because it does not perform type or bounds checks. User code should call " { $link >byte-vector } " instead." } ;

core/byte-vectors/byte-vectors-tests.factor

@@ -0,0 +1,14 @@
+IN: temporary
+USING: tools.test byte-vectors vectors sequences kernel ;
+
+[ 0 ] [ 123 <byte-vector> length ] unit-test
+
+: do-it
+    123 [ over push ] each ;
+
+[ t ] [
+    3 <byte-vector> do-it
+    3 <vector> do-it sequence=
+] unit-test
+
+[ t ] [ BV{ } byte-vector? ] unit-test

core/byte-vectors/byte-vectors.factor

@@ -0,0 +1,33 @@
+! Copyright (C) 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: arrays kernel kernel.private math sequences
+sequences.private growable byte-arrays ;
+IN: byte-vectors
+
+<PRIVATE
+
+: byte-array>vector ( byte-array capacity -- byte-vector )
+    byte-vector construct-boa ; inline
+
+PRIVATE>
+
+: <byte-vector> ( n -- byte-vector )
+    <byte-array> 0 byte-array>vector ; inline
+
+: >byte-vector ( seq -- byte-vector ) BV{ } clone-like ;
+
+M: byte-vector like
+    drop dup byte-vector? [
+        dup byte-array?
+        [ dup length byte-array>vector ] [ >byte-vector ] if
+    ] unless ;
+
+M: byte-vector new
+    drop [ <byte-array> ] keep >fixnum byte-array>vector ;
+
+M: byte-vector equal?
+    over byte-vector? [ sequence= ] [ 2drop f ] if ;
+
+M: byte-array new-resizable drop <byte-vector> ;
+
+INSTANCE: byte-vector growable

core/classes/classes-tests.factor

@@ -207,3 +207,14 @@ DEFER: mixin-forget-test-g
 
 [ { } mixin-forget-test-g ] unit-test-fails
 [ H{ } ] [ H{ } mixin-forget-test-g ] unit-test
+
+! Method flattening interfered with mixin update
+MIXIN: flat-mx-1
+TUPLE: flat-mx-1-1 ; INSTANCE: flat-mx-1-1 flat-mx-1
+TUPLE: flat-mx-1-2 ; INSTANCE: flat-mx-1-2 flat-mx-1
+TUPLE: flat-mx-1-3 ; INSTANCE: flat-mx-1-3 flat-mx-1
+TUPLE: flat-mx-1-4 ; INSTANCE: flat-mx-1-4 flat-mx-1
+MIXIN: flat-mx-2     INSTANCE: flat-mx-2 flat-mx-1
+TUPLE: flat-mx-2-1 ; INSTANCE: flat-mx-2-1 flat-mx-2
+
+[ t ] [ T{ flat-mx-2-1 } flat-mx-1? ] unit-test

core/classes/classes.factor

@@ -255,7 +255,14 @@ PRIVATE>
     >r dup word-props r> union over set-word-props
     t "class" set-word-prop ;
 
-GENERIC: update-methods ( class -- )
+GENERIC: update-predicate ( class -- )
+
+M: class update-predicate drop ;
+
+: update-predicates ( assoc -- )
+    [ drop update-predicate ] assoc-each ;
+
+GENERIC: update-methods ( assoc -- )
 
 : define-class ( word members superclass metaclass -- )
     #! If it was already a class, update methods after.
@@ -264,8 +271,9 @@ GENERIC: update-methods ( class -- )
     over class-usages [
         uncache-classes
         dupd (define-class)
-    ] keep cache-classes
+    ] keep cache-classes r>
-    r> [ update-methods ] [ drop ] if ;
+    [ class-usages dup update-predicates update-methods ]
+    [ drop ] if ;
 
 GENERIC: class ( object -- class ) inline
 

core/classes/union/union.factor

@@ -20,6 +20,8 @@ PREDICATE: class union-class
     over members union-predicate-quot
     define-predicate ;
 
+M: union-class update-predicate define-union-predicate ;
+
 : define-union-class ( class members -- )
     dupd f union-class define-class define-union-predicate ;
 

core/compiler/constants/constants.factor

@@ -10,7 +10,7 @@ IN: compiler.constants
 ! These constants must match vm/layouts.h
 : header-offset object tag-number neg ;
 : float-offset 8 float tag-number - ;
-: string-offset 3 bootstrap-cells object tag-number - ;
+: string-offset 4 bootstrap-cells object tag-number - ;
 : profile-count-offset 7 bootstrap-cells object tag-number - ;
 : byte-array-offset 2 bootstrap-cells object tag-number - ;
 : alien-offset 3 bootstrap-cells object tag-number - ;

core/compiler/test/intrinsics.factor

@@ -1,10 +1,10 @@
 IN: temporary
-USING: arrays compiler kernel kernel.private math
+USING: arrays compiler kernel kernel.private math math.constants
-math.constants math.private sequences strings tools.test words
+math.private sequences strings tools.test words continuations
-continuations sequences.private hashtables.private byte-arrays
+sequences.private hashtables.private byte-arrays strings.private
-strings.private system random layouts vectors.private
+system random layouts vectors.private sbufs.private
-sbufs.private strings.private slots.private alien alien.c-types
+strings.private slots.private alien alien.accessors
-alien.syntax namespaces libc combinators.private ;
+alien.c-types alien.syntax namespaces libc combinators.private ;
 
 ! Make sure that intrinsic ops compile to correct code.
 [ ] [ 1 [ drop ] compile-call ] unit-test
@@ -36,13 +36,13 @@ alien.syntax namespaces libc combinators.private ;
 ! Write barrier hits on the wrong value were causing segfaults
 [ -3 ] [ -3 1 2 [ 2array [ 3 set-slot ] keep ] compile-call second ] unit-test
 
-[ CHAR: b ] [ 1 "abc" [ char-slot ] compile-call ] unit-test
+! [ CHAR: b ] [ 1 "abc" [ char-slot ] compile-call ] unit-test
-[ CHAR: b ] [ 1 [ "abc" char-slot ] compile-call ] unit-test
+! [ CHAR: b ] [ 1 [ "abc" char-slot ] compile-call ] unit-test
-[ CHAR: b ] [ [ 1 "abc" char-slot ] compile-call ] unit-test
+! [ CHAR: b ] [ [ 1 "abc" char-slot ] compile-call ] unit-test
-
+! 
-[ "axc" ] [ CHAR: x 1 "abc" [ [ set-char-slot ] keep { string } declare dup rehash-string ] compile-call ] unit-test
+! [ "axc" ] [ CHAR: x 1 "abc" [ [ set-char-slot ] keep { string } declare dup rehash-string ] compile-call ] unit-test
-[ "axc" ] [ CHAR: x 1 [ "abc" [ set-char-slot ] keep { string } declare dup rehash-string ] compile-call ] unit-test
+! [ "axc" ] [ CHAR: x 1 [ "abc" [ set-char-slot ] keep { string } declare dup rehash-string ] compile-call ] unit-test
-[ "axc" ] [ CHAR: x [ 1 "abc" [ set-char-slot ] keep { string } declare dup rehash-string ] compile-call ] unit-test
+! [ "axc" ] [ CHAR: x [ 1 "abc" [ set-char-slot ] keep { string } declare dup rehash-string ] compile-call ] unit-test
 
 [ ] [ [ 0 getenv ] compile-call drop ] unit-test
 [ ] [ 1 getenv [ 1 setenv ] compile-call ] unit-test
@@ -334,10 +334,6 @@ cell 8 = [
 
 [ \ + ] [ \ + [ <wrapper> ] compile-call ] unit-test
 
-[ H{ } ] [
-    100 [ (hashtable) ] compile-call [ reset-hash ] keep
-] unit-test
-
 [ B{ 0 0 0 0 0 } ] [
     [ 5 <byte-array> ] compile-call
 ] unit-test

core/compiler/test/redefine.factor

@@ -238,3 +238,15 @@ DEFER: flushable-test-2
 [ \ bx forget ] with-compilation-unit
 
 [ t ] [ \ ax compiled-usage [ drop interned? ] assoc-all? ] unit-test
+
+DEFER: defer-redefine-test-2
+
+[ ] [ "IN: temporary DEFER: defer-redefine-test-1" eval ] unit-test
+
+[ ] [ "IN: temporary : defer-redefine-test-2 defer-redefine-test-1 1 ;" eval ] unit-test
+
+[ defer-redefine-test-2 ] unit-test-fails
+
+[ ] [ "IN: temporary : defer-redefine-test-1 2 ;" eval ] unit-test
+
+[ 2 1 ] [ defer-redefine-test-2 ] unit-test

core/compiler/test/templates.factor

@@ -2,8 +2,8 @@
 USING: arrays compiler kernel kernel.private math
 hashtables.private math.private namespaces sequences
 sequences.private tools.test namespaces.private slots.private
-combinators.private byte-arrays alien layouts words definitions
+combinators.private byte-arrays alien alien.accessors layouts
-compiler.units ;
+words definitions compiler.units ;
 IN: temporary
 
 ! Oops!

core/continuations/continuations-docs.factor

@@ -68,6 +68,15 @@ $nl
 
 ABOUT: "continuations"
 
+HELP: dispose
+{ $values { "object" "a disposable object" } }
+{ $contract "Releases operating system resources associated with a disposable object. No further operations can be performed on a disposable object after this call. Disposable objects include streams, memory mapped files, and so on." }
+{ $notes "You must close disposable objects after you are finished working with them, to avoid leaking operating system resources. A convenient way to automate this is by using the " { $link with-disposal } " word." } ;
+
+HELP: with-disposal
+{ $values { "object" "a disposable object" } { "quot" "a quotation with stack effect " { $snippet "( object -- )" } } }
+{ $description "Calls the quotation, disposing the object with " { $link dispose } " after the quotation returns or if it throws an error." } ;
+
 HELP: catchstack*
 { $values { "catchstack" "a vector of continuations" } }
 { $description "Outputs the current catchstack." } ;

core/continuations/continuations.factor

@@ -135,6 +135,11 @@ PRIVATE>
         [ [ , f ] compose [ , drop t ] recover ] curry all?
     ] { } make peek swap [ rethrow ] when ; inline
 
+GENERIC: dispose ( object -- )
+
+: with-disposal ( object quot -- )
+    over [ dispose ] curry [ ] cleanup ; inline
+
 TUPLE: condition restarts continuation ;
 
 : <condition> ( error restarts cc -- condition )

core/cpu/architecture/tags.txt

@@ -0,0 +1 @@
+compiler

core/cpu/arm/intrinsics/intrinsics.factor

@@ -383,41 +383,6 @@ IN: cpu.arm.intrinsics
     { +output+ { "out" } }
 } define-intrinsic
 
-\ (hashtable) [
-    hashtable 4 cells %allot
-    R12 f v>operand MOV
-    R12 1 %set-slot
-    R12 2 %set-slot
-    R12 3 %set-slot
-    ! Store tagged ptr in reg
-    "out" get object %store-tagged
-] H{
-    { +scratch+ { { f "out" } } }
-    { +output+ { "out" } }
-} define-intrinsic
-
-\ string>sbuf [
-    sbuf 3 cells %allot
-    "length" operand 1 %set-slot
-    "string" operand 2 %set-slot
-    "out" get object %store-tagged
-] H{
-    { +input+ { { f "string" } { f "length" } } }
-    { +scratch+ { { f "out" } } }
-    { +output+ { "out" } }
-} define-intrinsic
-
-\ array>vector [
-    vector 3 cells %allot
-    "length" operand 1 %set-slot
-    "array" operand 2 %set-slot
-    "out" get object %store-tagged
-] H{
-    { +input+ { { f "array" } { f "length" } } }
-    { +scratch+ { { f "out" } } }
-    { +output+ { "out" } }
-} define-intrinsic
-
 ! Alien intrinsics
 : %alien-accessor ( quot -- )
     "offset" operand dup %untag-fixnum

core/cpu/arm/tags.txt

@@ -0,0 +1 @@
+compiler

core/cpu/ppc/intrinsics/intrinsics.factor

@@ -93,30 +93,6 @@ IN: cpu.ppc.intrinsics
     }
 } define-intrinsics
 
-: (%char-slot)
-    "offset" operand "n" operand 2 SRAWI
-    "offset" operand dup "obj" operand ADD ;
-
-\ char-slot [
-    (%char-slot)
-    "out" operand "offset" operand string-offset LHZ
-    "out" operand dup %tag-fixnum
-] H{
-    { +input+ { { f "n" } { f "obj" } } }
-    { +scratch+ { { f "out" } { f "offset" } } }
-    { +output+ { "out" } }
-} define-intrinsic
-
-\ set-char-slot [
-    (%char-slot)
-    "val" operand dup %untag-fixnum
-    "val" operand "offset" operand string-offset STH
-] H{
-    { +input+ { { f "val" } { f "n" } { f "obj" } } }
-    { +scratch+ { { f "offset" } } }
-    { +clobber+ { "val" } }
-} define-intrinsic
-
 : fixnum-register-op ( op -- pair )
     [ "out" operand "y" operand "x" operand ] swap add H{
         { +input+ { { f "x" } { f "y" } } }
@@ -586,43 +562,6 @@ IN: cpu.ppc.intrinsics
     { +output+ { "wrapper" } }
 } define-intrinsic
 
-\ (hashtable) [
-    hashtable 4 cells %allot
-    f v>operand 12 LI
-    12 11 1 cells STW
-    12 11 2 cells STW
-    12 11 3 cells STW
-    ! Store tagged ptr in reg
-    "hashtable" get object %store-tagged
-] H{
-    { +scratch+ { { f "hashtable" } } }
-    { +output+ { "hashtable" } }
-} define-intrinsic
-
-\ string>sbuf [
-    sbuf 3 cells %allot
-    "length" operand 11 1 cells STW
-    "string" operand 11 2 cells STW
-    ! Store tagged ptr in reg
-    "sbuf" get object %store-tagged
-] H{
-    { +input+ { { f "string" } { f "length" } } }
-    { +scratch+ { { f "sbuf" } } }
-    { +output+ { "sbuf" } }
-} define-intrinsic
-
-\ array>vector [
-    vector 3 cells %allot
-    "length" operand 11 1 cells STW
-    "array" operand 11 2 cells STW
-    ! Store tagged ptr in reg
-    "vector" get object %store-tagged
-] H{
-    { +input+ { { f "array" } { f "length" } } }
-    { +scratch+ { { f "vector" } } }
-    { +output+ { "vector" } }
-} define-intrinsic
-
 ! Alien intrinsics
 : %alien-accessor ( quot -- )
     "offset" operand dup %untag-fixnum

core/cpu/ppc/tags.txt

@@ -0,0 +1 @@
+compiler

core/cpu/x86/32/tags.txt

@@ -0,0 +1 @@
+compiler

core/cpu/x86/64/tags.txt

@@ -0,0 +1 @@
+compiler

core/cpu/x86/intrinsics/intrinsics.factor

@@ -1,12 +1,13 @@
 ! Copyright (C) 2005, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: alien arrays cpu.x86.assembler cpu.x86.allot
+USING: alien alien.accessors arrays cpu.x86.assembler
-cpu.x86.architecture cpu.architecture kernel kernel.private math
+cpu.x86.allot cpu.x86.architecture cpu.architecture kernel
-math.private namespaces quotations sequences
+kernel.private math math.private namespaces quotations sequences
 words generic byte-arrays hashtables hashtables.private
 generator generator.registers generator.fixup sequences.private
 sbufs sbufs.private vectors vectors.private layouts system
-tuples.private strings.private slots.private compiler.constants ;
+tuples.private strings.private slots.private compiler.constants
+;
 IN: cpu.x86.intrinsics
 
 ! Type checks
@@ -153,34 +154,6 @@ IN: cpu.x86.intrinsics
 : small-reg-16 BX ; inline
 : small-reg-32 EBX ; inline
 
-\ char-slot [
-    small-reg PUSH
-    "n" operand 2 SHR
-    small-reg dup XOR
-    "obj" operand "n" operand ADD
-    small-reg-16 "obj" operand string-offset [+] MOV
-    small-reg %tag-fixnum
-    "obj" operand small-reg MOV
-    small-reg POP
-] H{
-    { +input+ { { f "n" } { f "obj" } } }
-    { +output+ { "obj" } }
-    { +clobber+ { "obj" "n" } }
-} define-intrinsic
-
-\ set-char-slot [
-    small-reg PUSH
-    "val" operand %untag-fixnum
-    "slot" operand 2 SHR
-    "obj" operand "slot" operand ADD
-    small-reg "val" operand MOV
-    "obj" operand string-offset [+] small-reg-16 MOV
-    small-reg POP
-] H{
-    { +input+ { { f "val" } { f "slot" } { f "obj" } } }
-    { +clobber+ { "val" "slot" "obj" } }
-} define-intrinsic
-
 ! Fixnums
 : fixnum-op ( op hash -- pair )
     >r [ "x" operand "y" operand ] swap add r> 2array ;
@@ -447,45 +420,6 @@ IN: cpu.x86.intrinsics
     { +output+ { "wrapper" } }
 } define-intrinsic
 
-\ (hashtable) [
-    hashtable 4 cells [
-        1 object@ f v>operand MOV
-        2 object@ f v>operand MOV
-        3 object@ f v>operand MOV
-        ! Store tagged ptr in reg
-        "hashtable" get object %store-tagged
-    ] %allot
-] H{
-    { +scratch+ { { f "hashtable" } } }
-    { +output+ { "hashtable" } }
-} define-intrinsic
-
-\ string>sbuf [
-    sbuf 3 cells [
-        1 object@ "length" operand MOV
-        2 object@ "string" operand MOV
-        ! Store tagged ptr in reg
-        "sbuf" get object %store-tagged
-    ] %allot
-] H{
-    { +input+ { { f "string" } { f "length" } } }
-    { +scratch+ { { f "sbuf" } } }
-    { +output+ { "sbuf" } }
-} define-intrinsic
-
-\ array>vector [
-    vector 3 cells [
-        1 object@ "length" operand MOV
-        2 object@ "array" operand MOV
-        ! Store tagged ptr in reg
-        "vector" get object %store-tagged
-    ] %allot
-] H{
-    { +input+ { { f "array" } { f "length" } } }
-    { +scratch+ { { f "vector" } } }
-    { +output+ { "vector" } }
-} define-intrinsic
-
 ! Alien intrinsics
 : %alien-accessor ( quot -- )
     "offset" operand %untag-fixnum

core/cpu/x86/sse2/sse2.factor

@@ -1,10 +1,10 @@
 ! Copyright (C) 2005, 2007 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: alien arrays cpu.x86.assembler cpu.x86.architecture
+USING: alien alien.accessors arrays cpu.x86.assembler
-cpu.x86.intrinsics generic kernel kernel.private math
+cpu.x86.architecture cpu.x86.intrinsics generic kernel
-math.private memory namespaces sequences words generator
+kernel.private math math.private memory namespaces sequences
-generator.registers cpu.architecture math.floats.private layouts
+words generator generator.registers cpu.architecture
-quotations ;
+math.floats.private layouts quotations ;
 IN: cpu.x86.sse2
 
 : define-float-op ( word op -- )

core/dlists/dlists-docs.factor

@@ -1,4 +1,4 @@
-USING: help.markup help.syntax kernel ;
+USING: help.markup help.syntax kernel quotations ;
 IN: dlists
 
 ARTICLE: "dlists" "Doubly-linked lists"
@@ -13,23 +13,31 @@ $nl
 { $subsection dlist? }
 "Constructing a dlist:"
 { $subsection <dlist> }
-"Double-ended queue protocol:"
+"Working with the front of the list:"
-{ $subsection dlist-empty? }
 { $subsection push-front }
+{ $subsection push-front* }
+{ $subsection peek-front }
 { $subsection pop-front }
 { $subsection pop-front* }
+"Working with the back of the list:"
 { $subsection push-back }
+{ $subsection push-back* }
+{ $subsection peek-back }
 { $subsection pop-back }
 { $subsection pop-back* }
 "Finding out the length:"
+{ $subsection dlist-empty? }
 { $subsection dlist-length }
 "Iterating over elements:"
 { $subsection dlist-each }
 { $subsection dlist-find }
 { $subsection dlist-contains? }
-"Deleting a node matching a predicate:"
+"Deleting a node:"
-{ $subsection delete-node* }
 { $subsection delete-node }
+{ $subsection dlist-delete }
+"Deleting a node matching a predicate:"
+{ $subsection delete-node-if* }
+{ $subsection delete-node-if }
 "Consuming all nodes:"
 { $subsection dlist-slurp } ;
 
@@ -77,7 +85,7 @@ HELP: pop-back*
 { $see-also push-front push-back pop-front pop-front* pop-back } ;
 
 HELP: dlist-find
-{ $values { "quot" "a quotation" } { "dlist" { $link dlist } } { "obj/f" "an object or " { $link f } } { "?" "a boolean" } }
+{ $values { "quot" quotation } { "dlist" { $link dlist } } { "obj/f" "an object or " { $link f } } { "?" "a boolean" } }
 { $description "Applies the quotation to each element of the " { $link dlist } " in turn, until it outputs a true value or the end of the " { $link dlist } " is reached.  Outputs either the object it found or " { $link f } ", and a boolean which is true if an object is found." }
 { $notes "Returns a boolean to allow dlists to store " { $link f } "."
     $nl
@@ -85,20 +93,20 @@ HELP: dlist-find
 } ;
 
 HELP: dlist-contains?
-{ $values { "quot" "a quotation" } { "dlist" { $link dlist } } { "?" "a boolean" } }
+{ $values { "quot" quotation } { "dlist" { $link dlist } } { "?" "a boolean" } }
 { $description "Just like " { $link dlist-find } " except it doesn't return the object." }
 { $notes "This operation is O(n)." } ;
 
-HELP: delete-node*
+HELP: delete-node-if*
-{ $values { "quot" "a quotation" } { "dlist" { $link dlist } } { "obj/f" "an object or " { $link f } } { "?" "a boolean" } }
+{ $values { "quot" quotation } { "dlist" { $link dlist } } { "obj/f" "an object or " { $link f } } { "?" "a boolean" } }
 { $description "Calls " { $link dlist-find } " on the " { $link dlist } " and deletes the node returned, if any.  Returns the value of the deleted node and a boolean to allow the deleted value to distinguished from " { $link f } ", for nothing deleted." }
 { $notes "This operation is O(n)." } ;
 
-HELP: delete-node
+HELP: delete-node-if
-{ $values { "quot" "a quotation" } { "dlist" { $link dlist } } { "obj/f" "an object or " { $link f } } }
+{ $values { "quot" quotation } { "dlist" { $link dlist } } { "obj/f" "an object or " { $link f } } }
-{ $description "Like " { $link delete-node* } " but cannot distinguish from deleting a node whose value is " { $link f } " or not deleting an element." }
+{ $description "Like " { $link delete-node-if* } " but cannot distinguish from deleting a node whose value is " { $link f } " or not deleting an element." }
 { $notes "This operation is O(n)." } ;
 
 HELP: dlist-each
-{ $values { "quot" "a quotation" } { "dlist" { $link dlist } } }
+{ $values { "quot" quotation } { "dlist" { $link dlist } } }
 { $description "Iterate a " { $link dlist } ", calling quot on each element." } ;

core/dlists/dlists-tests.factor

@@ -49,14 +49,14 @@ IN: temporary
 [ f ] [ <dlist> 1 over push-back [ 2 = ] swap dlist-contains? ] unit-test
 [ t ] [ <dlist> 1 over push-back [ 1 = ] swap dlist-contains? ] unit-test
 
-[ 1 ] [ <dlist> 1 over push-back [ 1 = ] swap delete-node ] unit-test
+[ 1 ] [ <dlist> 1 over push-back [ 1 = ] swap delete-node-if ] unit-test
-[ t ] [ <dlist> 1 over push-back [ 1 = ] over delete-node drop dlist-empty? ] unit-test
+[ t ] [ <dlist> 1 over push-back [ 1 = ] over delete-node-if drop dlist-empty? ] unit-test
-[ t ] [ <dlist> 1 over push-back [ 1 = ] over delete-node drop dlist-empty? ] unit-test
+[ t ] [ <dlist> 1 over push-back [ 1 = ] over delete-node-if drop dlist-empty? ] unit-test
-[ 0 ] [ <dlist> 1 over push-back [ 1 = ] over delete-node drop dlist-length ] unit-test
+[ 0 ] [ <dlist> 1 over push-back [ 1 = ] over delete-node-if drop dlist-length ] unit-test
-[ 1 ] [ <dlist> 1 over push-back 2 over push-back [ 1 = ] over delete-node drop dlist-length ] unit-test
+[ 1 ] [ <dlist> 1 over push-back 2 over push-back [ 1 = ] over delete-node-if drop dlist-length ] unit-test
-[ 2 ] [ <dlist> 1 over push-back 2 over push-back 3 over push-back [ 1 = ] over delete-node drop dlist-length ] unit-test
+[ 2 ] [ <dlist> 1 over push-back 2 over push-back 3 over push-back [ 1 = ] over delete-node-if drop dlist-length ] unit-test
-[ 2 ] [ <dlist> 1 over push-back 2 over push-back 3 over push-back [ 2 = ] over delete-node drop dlist-length ] unit-test
+[ 2 ] [ <dlist> 1 over push-back 2 over push-back 3 over push-back [ 2 = ] over delete-node-if drop dlist-length ] unit-test
-[ 2 ] [ <dlist> 1 over push-back 2 over push-back 3 over push-back [ 3 = ] over delete-node drop dlist-length ] unit-test
+[ 2 ] [ <dlist> 1 over push-back 2 over push-back 3 over push-back [ 3 = ] over delete-node-if drop dlist-length ] unit-test
 
 [ 0 ] [ <dlist> dlist-length ] unit-test
 [ 1 ] [ <dlist> 1 over push-front dlist-length ] unit-test

core/dlists/dlists.factor

@@ -63,12 +63,22 @@ C: <dlist-node> dlist-node
     >r dlist-front r> (dlist-each-node) ; inline
 PRIVATE>
 
-: push-front ( obj dlist -- )
+: push-front* ( obj dlist -- dlist-node )
-    [ dlist-front f swap <dlist-node> dup set-next-prev ] keep
+    [ dlist-front f swap <dlist-node> dup dup set-next-prev ] keep
     [ set-dlist-front ] keep
     [ set-back-to-front ] keep
     inc-length ;
 
+: push-front ( obj dlist -- )
+    push-front* drop ;
+
+: push-back* ( obj dlist -- dlist-node )
+    [ dlist-back f <dlist-node> ] keep
+    [ dlist-back set-next-when ] 2keep
+    [ set-dlist-back ] 2keep
+    [ set-front-to-back ] keep
+    inc-length ;
+
 : push-back ( obj dlist -- )
     [ dlist-back f <dlist-node> ] keep
     [ dlist-back set-next-when ] 2keep
@@ -76,6 +86,9 @@ PRIVATE>
     [ set-front-to-back ] keep
     inc-length ;
 
+: peek-front ( dlist -- obj )
+    dlist-front dlist-node-obj ;
+
 : pop-front ( dlist -- obj )
     dup dlist-front [
         dup dlist-node-next
@@ -87,6 +100,9 @@ PRIVATE>
 
 : pop-front* ( dlist -- ) pop-front drop ;
 
+: peek-back ( dlist -- obj )
+    dlist-back dlist-node-obj ;
+
 : pop-back ( dlist -- obj )
     dup dlist-back [
         dup dlist-node-prev
@@ -108,25 +124,25 @@ PRIVATE>
     dup dlist-node-prev over dlist-node-next set-prev-when
     dup dlist-node-next swap dlist-node-prev set-next-when ;
 
-: (delete-node) ( dlist dlist-node -- )
+: delete-node ( dlist dlist-node -- )
     {
         { [ over dlist-front over eq? ] [ drop pop-front* ] }
         { [ over dlist-back over eq? ] [ drop pop-back* ] }
         { [ t ] [ unlink-node dec-length ] }
     } cond ;
 
-: delete-node* ( quot dlist -- obj/f ? )
+: delete-node-if* ( quot dlist -- obj/f ? )
     tuck dlist-find-node [
-        [ (delete-node) ] keep [ dlist-node-obj t ] [ f f ] if*
+        [ delete-node ] keep [ dlist-node-obj t ] [ f f ] if*
     ] [
         2drop f f
     ] if ; inline
 
-: delete-node ( quot dlist -- obj/f )
+: delete-node-if ( quot dlist -- obj/f )
-    delete-node* drop ; inline
+    delete-node-if* drop ; inline
 
 : dlist-delete ( obj dlist -- obj/f )
-    >r [ eq? ] curry r> delete-node ;
+    >r [ eq? ] curry r> delete-node-if ;
 
 : dlist-each ( dlist quot -- )
     [ dlist-node-obj ] swap compose dlist-each-node ; inline

core/float-arrays/float-arrays-tests.factor

@@ -2,3 +2,9 @@ IN: temporary
 USING: float-arrays tools.test ;
 
 [ F{ 1.0 1.0 1.0 } ] [ 3 1.0 <float-array> ] unit-test
+
+[ F{ 1 2 3 0 0 0 } ] [ 6 F{ 1 2 3 } resize-float-array ] unit-test
+
+[ F{ 1 2 } ] [ 2 F{ 1 2 3 4 5 6 7 8 9 } resize-float-array ] unit-test
+
+[ -10 F{ } resize-float-array ] unit-test-fails

core/float-arrays/float-arrays.factor

@@ -1,6 +1,6 @@
 ! Copyright (C) 2007, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel kernel.private alien sequences
+USING: kernel kernel.private alien.accessors sequences
 sequences.private math math.private ;
 IN: float-arrays
 
@@ -29,9 +29,10 @@ M: float-array new drop 0.0 <float-array> ;
 M: float-array equal?
     over float-array? [ sequence= ] [ 2drop f ] if ;
 
+M: float-array resize
+    resize-float-array ;
+
 INSTANCE: float-array sequence
-INSTANCE: float-array simple-c-ptr
-INSTANCE: float-array c-ptr
 
 : 1float-array ( x -- array ) 1 swap <float-array> ; flushable
 

core/float-vectors/float-vectors-docs.factor

@@ -0,0 +1,34 @@
+USING: arrays float-arrays help.markup help.syntax kernel
+float-vectors.private combinators ;
+IN: float-vectors
+
+ARTICLE: "float-vectors" "Float vectors"
+"A float vector is a resizable mutable sequence of unsigned floats. The literal syntax is covered in " { $link "syntax-float-vectors" } ". Float vector words are found in the " { $vocab-link "float-vectors" } " vocabulary."
+$nl
+"Float vectors form a class:"
+{ $subsection float-vector }
+{ $subsection float-vector? }
+"Creating float vectors:"
+{ $subsection >float-vector }
+{ $subsection <float-vector> }
+"If you don't care about initial capacity, a more elegant way to create a new float vector is to write:"
+{ $code "BV{ } clone" } ;
+
+ABOUT: "float-vectors"
+
+HELP: float-vector
+{ $description "The class of resizable float vectors. See " { $link "syntax-float-vectors" } " for syntax and " { $link "float-vectors" } " for general information." } ;
+
+HELP: <float-vector>
+{ $values { "n" "a positive integer specifying initial capacity" } { "float-vector" float-vector } }
+{ $description "Creates a new float vector that can hold " { $snippet "n" } " floats before resizing." } ;
+
+HELP: >float-vector
+{ $values { "seq" "a sequence" } { "float-vector" float-vector } }
+{ $description "Outputs a freshly-allocated float vector with the same elements as a given sequence." }
+{ $errors "Throws an error if the sequence contains elements other than real numbers." } ;
+
+HELP: float-array>vector
+{ $values { "float-array" "an array" } { "length" "a non-negative integer" } { "float-vector" float-vector } }
+{ $description "Creates a new float vector using the array for underlying storage with the specified initial length." }
+{ $warning "This word is in the " { $vocab-link "float-vectors.private" } " vocabulary because it does not perform type or bounds checks. User code should call " { $link >float-vector } " instead." } ;

core/float-vectors/float-vectors-tests.factor

@@ -0,0 +1,14 @@
+IN: temporary
+USING: tools.test float-vectors vectors sequences kernel ;
+
+[ 0 ] [ 123 <float-vector> length ] unit-test
+
+: do-it
+    12345 [ over push ] each ;
+
+[ t ] [
+    3 <float-vector> do-it
+    3 <vector> do-it sequence=
+] unit-test
+
+[ t ] [ FV{ } float-vector? ] unit-test

core/float-vectors/float-vectors.factor

@@ -0,0 +1,33 @@
+! Copyright (C) 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: arrays kernel kernel.private math sequences
+sequences.private growable float-arrays ;
+IN: float-vectors
+
+<PRIVATE
+
+: float-array>vector ( float-array length -- float-vector )
+    float-vector construct-boa ; inline
+
+PRIVATE>
+
+: <float-vector> ( n -- float-vector )
+    0.0 <float-array> 0 float-array>vector ; inline
+
+: >float-vector ( seq -- float-vector ) FV{ } clone-like ;
+
+M: float-vector like
+    drop dup float-vector? [
+        dup float-array?
+        [ dup length float-array>vector ] [ >float-vector ] if
+    ] unless ;
+
+M: float-vector new
+    drop [ 0.0 <float-array> ] keep >fixnum float-array>vector ;
+
+M: float-vector equal?
+    over float-vector? [ sequence= ] [ 2drop f ] if ;
+
+M: float-array new-resizable drop <float-vector> ;
+
+INSTANCE: float-vector growable

core/generator/generator.factor

@@ -19,8 +19,8 @@ SYMBOL: compiled
 : queue-compile ( word -- )
     {
         { [ dup compiled get key? ] [ drop ] }
+        { [ dup inlined-block? ] [ drop ] }
         { [ dup primitive? ] [ drop ] }
-        { [ dup deferred? ] [ drop ] }
         { [ t ] [ dup compile-queue get set-at ] }
     } cond ;
 

core/generic/generic.factor

@@ -107,5 +107,5 @@ M: class forget* ( class -- )
     dup uncache-class
     forget-word ;
 
-M: class update-methods ( class -- )
+M: assoc update-methods ( assoc -- )
-    class-usages implementors* [ make-generic ] each ;
+    implementors* [ make-generic ] each ;

core/growable/growable-docs.factor

@@ -21,7 +21,7 @@ HELP: set-fill
 { $values { "n" "a new fill pointer" } { "seq" "a resizable sequence" } }
 { $contract "Sets the fill pointer (number of occupied elements in the underlying storage) of a resizable sequence." }
 { $side-effects "seq" }
-{ $warning "This word is in the " { $vocab-link "sequences.private" } " vocabulary because it is not safe. Changing the fill pointer to a negative value, or a value higher than the underlying sequence length can lead to memory corruption. User code should use " { $link set-length } " instead." } ;
+{ $warning "This word is in the " { $vocab-link "growable.private" } " vocabulary because it is not safe. Changing the fill pointer to a negative value, or a value higher than the underlying sequence length can lead to memory corruption. User code should use " { $link set-length } " instead." } ;
 
 HELP: underlying
 { $values { "seq" "a resizable sequence" } { "underlying" "the underlying sequence" } }
@@ -30,7 +30,7 @@ HELP: underlying
 HELP: set-underlying
 { $values { "underlying" "a sequence" } { "seq" "a resizable sequence" } }
 { $contract "Modifies the underlying storage of a resizable sequence." }
-{ $warning "This word is in the " { $vocab-link "sequences.private" } " vocabulary because it is not safe. Setting an underlying sequence shorter than the fill pointer can lead to memory corruption." } ;
+{ $warning "This word is in the " { $vocab-link "growable.private" } " vocabulary because it is not safe. Setting an underlying sequence shorter than the fill pointer can lead to memory corruption." } ;
 
 HELP: capacity
 { $values { "seq" "a vector or string buffer" } { "n" "the capacity of the sequence" } }

core/hashtables/hashtables-docs.factor

@@ -116,10 +116,6 @@ HELP: <hashtable>
 { $values { "n" "a positive integer specifying hashtable capacity" } { "hash" "a new hashtable" } }
 { $description "Create a new hashtable capable of storing " { $snippet "n" } " key/value pairs before growing." } ;
 
-HELP: (hashtable) ( -- hash )
-{ $values { "hash" "a new hashtable" } }
-{ $description "Allocates a hashtable stub object without an underlying array. User code should call " { $link <hashtable> } " instead." } ;
-
 HELP: associate
 { $values { "value" "a value" } { "key" "a key" } { "hash" "a new " { $link hashtable } } }
 { $description "Create a new hashtable holding one key/value pair." } ;

core/hashtables/hashtables.factor

@@ -122,7 +122,7 @@ IN: hashtables
 PRIVATE>
 
 : <hashtable> ( n -- hash )
-    (hashtable) [ reset-hash ] keep ;
+    hashtable construct-empty [ reset-hash ] keep ;
 
 M: hashtable at* ( key hash -- value ? )
     key@ [ 3 fixnum+fast slot t ] [ 2drop f f ] if ;

core/inference/backend/backend.factor

@@ -402,10 +402,14 @@ TUPLE: recursive-declare-error word ;
     dup node-param #return node,
     dataflow-graph get 1array over set-node-children ;
 
+: inlined-block? "inlined-block" word-prop ;
+
+: <inlined-block> gensym dup t "inlined-block" set-word-prop ;
+
 : inline-block ( word -- node-block data )
     [
         copy-inference nest-node
-        dup word-def swap gensym
+        dup word-def swap <inlined-block>
         [ infer-quot-recursive ] 2keep
         #label unnest-node
     ] H{ } make-assoc ;

core/inference/inference-tests.factor

@@ -421,6 +421,8 @@ DEFER: bar
 { 2 1 } [ [ + ] [ ] [ ] cleanup ] unit-test-effect
 { 2 1 } [ [ + ] [ 3drop 0 ] recover ] unit-test-effect
 
+\ dispose must-infer
+
 ! Test stream protocol
 \ set-timeout must-infer
 \ stream-read must-infer
@@ -430,7 +432,6 @@ DEFER: bar
 \ stream-write must-infer
 \ stream-write1 must-infer
 \ stream-nl must-infer
-\ stream-close must-infer
 \ stream-format must-infer
 \ stream-write-table must-infer
 \ stream-flush must-infer

core/inference/known-words/known-words.factor

@@ -1,15 +1,16 @@
-! Copyright (C) 2004, 2007 Slava Pestov.
+! Copyright (C) 2004, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: alien arrays bit-arrays byte-arrays classes
+USING: alien alien.accessors arrays bit-arrays byte-arrays
-combinators.private continuations.private effects float-arrays
+classes combinators.private continuations.private effects
-generic hashtables hashtables.private inference.state
+float-arrays generic hashtables hashtables.private
-inference.backend inference.dataflow io io.backend io.files
+inference.state inference.backend inference.dataflow io
-io.files.private io.streams.c kernel kernel.private math
+io.backend io.files io.files.private io.streams.c kernel
-math.private memory namespaces namespaces.private parser
+kernel.private math math.private memory namespaces
-prettyprint quotations quotations.private sbufs sbufs.private
+namespaces.private parser prettyprint quotations
-sequences sequences.private slots.private strings
+quotations.private sbufs sbufs.private sequences
-strings.private system threads.private tuples tuples.private
+sequences.private slots.private strings strings.private system
-vectors vectors.private words words.private assocs inspector ;
+threads.private tuples tuples.private vectors vectors.private
+words words.private assocs inspector ;
 IN: inference.known-words
 
 ! Shuffle words
@@ -167,9 +168,6 @@ t over set-effect-terminated?
 
 \ rehash-string { string } { } <effect> "inferred-effect" set-word-prop
 
-\ string>sbuf { string integer } { sbuf } <effect> "inferred-effect" set-word-prop
-\ string>sbuf make-flushable
-
 \ bignum>fixnum { bignum } { fixnum } <effect> "inferred-effect" set-word-prop
 \ bignum>fixnum make-foldable
 
@@ -483,20 +481,26 @@ t over set-effect-terminated?
 
 \ set-slot { object object fixnum } { } <effect> "inferred-effect" set-word-prop
 
-\ char-slot { fixnum object } { fixnum } <effect> "inferred-effect" set-word-prop
+\ string-nth { fixnum string } { fixnum } <effect> "inferred-effect" set-word-prop
-\ char-slot make-flushable
+\ string-nth make-flushable
 
-\ set-char-slot { fixnum fixnum object } { } <effect> "inferred-effect" set-word-prop
+\ set-string-nth { fixnum fixnum string } { } <effect> "inferred-effect" set-word-prop
 
 \ resize-array { integer array } { array } <effect> "inferred-effect" set-word-prop
 \ resize-array make-flushable
 
+\ resize-byte-array { integer byte-array } { byte-array } <effect> "inferred-effect" set-word-prop
+\ resize-byte-array make-flushable
+
+\ resize-bit-array { integer bit-array } { bit-array } <effect> "inferred-effect" set-word-prop
+\ resize-bit-array make-flushable
+
+\ resize-float-array { integer float-array } { float-array } <effect> "inferred-effect" set-word-prop
+\ resize-float-array make-flushable
+
 \ resize-string { integer string } { string } <effect> "inferred-effect" set-word-prop
 \ resize-string make-flushable
 
-\ (hashtable) { } { hashtable } <effect> "inferred-effect" set-word-prop
-\ (hashtable) make-flushable
-
 \ <array> { integer object } { array } <effect> "inferred-effect" set-word-prop
 \ <array> make-flushable
 
@@ -532,9 +536,6 @@ t over set-effect-terminated?
 \ (clone) { object } { object } <effect> "inferred-effect" set-word-prop
 \ (clone) make-flushable
 
-\ array>vector { array integer } { vector } <effect> "inferred-effect" set-word-prop
-\ array>vector make-flushable
-
 \ <string> { integer integer } { string } <effect> "inferred-effect" set-word-prop
 \ <string> make-flushable
 

core/io/files/files-tests.factor

@@ -1,5 +1,5 @@
 IN: temporary
-USING: tools.test io.files io threads kernel ;
+USING: tools.test io.files io threads kernel continuations ;
 
 [ "passwd" ] [ "/etc/passwd" file-name ] unit-test
 [ "awk/" ] [ "/usr/libexec/awk/" file-name ] unit-test
@@ -41,7 +41,7 @@ USING: tools.test io.files io threads kernel ;
 [ ] [ "test-blah" resource-path make-directory ] unit-test
 
 [ ] [
-    "test-blah/fooz" resource-path <file-writer> stream-close
+    "test-blah/fooz" resource-path <file-writer> dispose
 ] unit-test
 
 [ t ] [

core/io/io-docs.factor

@@ -1,12 +1,12 @@
 USING: help.markup help.syntax quotations hashtables kernel
-classes strings ;
+classes strings continuations ;
 IN: io
 
 ARTICLE: "stream-protocol" "Stream protocol"
 "The stream protocol consists of a large number of generic words, many of which are optional."
 $nl
-"A word required to be implemented for all streams:"
+"All streams must implement the " { $link dispose } " word in addition to the stream protocol."
-{ $subsection stream-close }
+$nl
 "Three words are required for input streams:"
 { $subsection stream-read1 }
 { $subsection stream-read }
@@ -73,16 +73,10 @@ ARTICLE: "streams" "Streams"
 
 ABOUT: "streams"
 
-HELP: stream-close
-{ $values { "stream" "a stream" } }
-{ $contract "Closes the stream. This releases any external resources associated with the stream, such as file handles and network connections. No further operations can be performed on the stream after this call." }
-{ $notes "You must close streams after you are finished working with them. A convenient way to automate this is by using the " { $link with-stream } " word." }
-$io-error ;
-
 HELP: set-timeout
 { $values { "n" "an integer" } { "stream" "a stream" } }
-{ $contract "Sets a timeout, in milliseconds, for closing the stream if there is no activity. Not all streams support timeouts." } 
+{ $contract "Sets a timeout, in milliseconds, for input and output operations on the stream. If a read or a write is initiated and no activity is seen before the timeout expires, an error will be thrown to the caller of the operation being performed." }
-$io-error ;
+{ $notes "Whether or not the stream is closed when the error is thrown is implementation-specific, and user code should take care to close the stream on all error conditions in any case." } ;
 
 HELP: stream-readln
 { $values { "stream" "an input stream" } { "str" string } }

core/io/io.factor

@@ -4,7 +4,6 @@ USING: hashtables generic kernel math namespaces sequences strings
     continuations assocs io.styles sbufs ;
 IN: io
 
-GENERIC: stream-close ( stream -- )
 GENERIC: set-timeout ( n stream -- )
 GENERIC: stream-readln ( stream -- str )
 GENERIC: stream-read1 ( stream -- ch/f )
@@ -29,7 +28,7 @@ GENERIC: stream-write-table ( table-cells style stream -- )
     [ over stream-write (stream-copy) ] [ 2drop ] if* ;
 
 : stream-copy ( in out -- )
-    [ 2dup (stream-copy) ] [ stream-close stream-close ] [ ]
+    [ 2dup (stream-copy) ] [ dispose dispose ] [ ]
     cleanup ;
 
 ! Default stream
@@ -54,9 +53,7 @@ SYMBOL: stderr
     stdio swap with-variable ; inline
 
 : with-stream ( stream quot -- )
-    swap [
+    [ with-stream* ] curry with-disposal ; inline
-        [ stdio get stream-close ] [ ] cleanup
-    ] with-stream* ; inline
 
 : tabular-output ( style quot -- )
     swap >r { } make r> stdio get stream-write-table ; inline

core/io/streams/c/c.factor

@@ -1,9 +1,9 @@
-! Copyright (C) 2004, 2007 Slava Pestov.
+! Copyright (C) 2004, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel kernel.private namespaces io
 strings sequences math generic threads.private classes
 io.backend io.streams.lines io.streams.plain io.streams.duplex
-io.files ;
+io.files continuations ;
 IN: io.streams.c
 
 TUPLE: c-writer handle ;
@@ -19,7 +19,7 @@ M: c-writer stream-write
 M: c-writer stream-flush
     c-writer-handle fflush ;
 
-M: c-writer stream-close
+M: c-writer dispose
     c-writer-handle fclose ;
 
 TUPLE: c-reader handle ;
@@ -46,7 +46,7 @@ M: c-reader stream-read-until
     [ swap read-until-loop ] "" make swap
     over empty? over not and [ 2drop f f ] when ;
 
-M: c-reader stream-close
+M: c-reader dispose
     c-reader-handle fclose ;
 
 : <duplex-c-stream> ( in out -- stream )

core/io/streams/duplex/duplex-docs.factor

@@ -1,4 +1,4 @@
-USING: help.markup help.syntax io ;
+USING: help.markup help.syntax io continuations ;
 IN: io.streams.duplex
 
 ARTICLE: "io.streams.duplex" "Duplex streams"
@@ -19,4 +19,4 @@ HELP: <duplex-stream>
 HELP: check-closed
 { $values { "stream" "a duplex stream" } }
 { $description "Throws a " { $link check-closed } " error if the stream has already been closed." }
-{ $error-description "This error is thrown when performing an I/O operation on a " { $link duplex-stream } " which has been closed with " { $link stream-close } "." } ;
+{ $error-description "This error is thrown when performing an I/O operation on a " { $link duplex-stream } " which has been closed with " { $link dispose } "." } ;

core/io/streams/duplex/duplex-tests.factor

@@ -6,7 +6,7 @@ TUPLE: closing-stream closed? ;
 
 : <closing-stream> closing-stream construct-empty ;
 
-M: closing-stream stream-close
+M: closing-stream dispose
     dup closing-stream-closed? [
         "Closing twice!" throw
     ] [
@@ -17,24 +17,24 @@ TUPLE: unclosable-stream ;
 
 : <unclosable-stream> unclosable-stream construct-empty ;
 
-M: unclosable-stream stream-close
+M: unclosable-stream dispose
     "Can't close me!" throw ;
 
 [ ] [
     <closing-stream> <closing-stream> <duplex-stream>
-    dup stream-close stream-close
+    dup dispose dispose
 ] unit-test
 
 [ t ] [
     <unclosable-stream> <closing-stream> [
         <duplex-stream>
-        [ dup stream-close ] catch 2drop
+        [ dup dispose ] catch 2drop
     ] keep closing-stream-closed?
 ] unit-test
 
 [ t ] [
     <closing-stream> [ <unclosable-stream>
         <duplex-stream>
-        [ dup stream-close ] catch 2drop
+        [ dup dispose ] catch 2drop
     ] keep closing-stream-closed?
 ] unit-test

core/io/streams/duplex/duplex.factor

@@ -65,14 +65,14 @@ M: duplex-stream make-cell-stream
 M: duplex-stream stream-write-table
     duplex-stream-out+ stream-write-table ;
 
-M: duplex-stream stream-close
+M: duplex-stream dispose
     #! The output stream is closed first, in case both streams
     #! are attached to the same file descriptor, the output
     #! buffer needs to be flushed before we close the fd.
     dup duplex-stream-closed? [
         t over set-duplex-stream-closed?
-        [ dup duplex-stream-out stream-close ]
+        [ dup duplex-stream-out dispose ]
-        [ dup duplex-stream-in stream-close ] [ ] cleanup
+        [ dup duplex-stream-in dispose ] [ ] cleanup
     ] unless drop ;
 
 M: duplex-stream set-timeout

core/io/streams/nested/nested.factor

@@ -1,14 +1,14 @@
-! Copyright (C) 2006, 2007 Slava Pestov.
+! Copyright (C) 2006, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 IN: io.streams.nested
 USING: arrays generic assocs kernel namespaces strings
-quotations io ;
+quotations io continuations ;
 
 TUPLE: ignore-close-stream ;
 
 : <ignore-close-stream> ignore-close-stream construct-delegate ;
 
-M: ignore-close-stream stream-close drop ;
+M: ignore-close-stream dispose drop ;
 
 TUPLE: style-stream style ;
 
@@ -44,4 +44,4 @@ TUPLE: block-stream ;
 
 : <block-stream> block-stream construct-delegate ;
 
-M: block-stream stream-close drop ;
+M: block-stream dispose drop ;

core/io/streams/string/string.factor

@@ -2,11 +2,13 @@
 ! See http://factorcode.org/license.txt for BSD license.
 IN: io.streams.string
 USING: io kernel math namespaces sequences sbufs strings
-generic splitting io.streams.plain io.streams.lines ;
+generic splitting io.streams.plain io.streams.lines
+continuations ;
+
+M: sbuf dispose drop ;
 
 M: sbuf stream-write1 push ;
 M: sbuf stream-write push-all ;
-M: sbuf stream-close drop ;
 M: sbuf stream-flush drop ;
 
 : <string-writer> ( -- stream )

core/listener/listener.factor

@@ -18,11 +18,10 @@ GENERIC: stream-read-quot ( stream -- quot/f )
     [ parse-lines in get ] with-compilation-unit in set ;
 
 : read-quot-step ( lines -- quot/f )
-    [ parse-lines-interactive ] catch {
+    [ parse-lines-interactive ] [
-        { [ dup delegate unexpected-eof? ] [ 2drop f ] }
+        dup delegate unexpected-eof?
-        { [ dup not ] [ drop ] }
+        [ 2drop f ] [ rethrow ] if
-        { [ t ] [ rethrow ] }
+    ] recover ;
-    } cond ;
 
 : read-quot-loop  ( stream accum -- quot/f )
     over stream-readln dup [

core/math/parser/parser.factor

@@ -1,7 +1,7 @@
-! Copyright (C) 2004, 2007 Slava Pestov.
+! Copyright (C) 2004, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel math.private namespaces sequences strings arrays
-combinators splitting math ;
+combinators splitting math assocs ;
 IN: math.parser
 
 DEFER: base>
@@ -11,12 +11,30 @@ DEFER: base>
     2dup and [ / ] [ 2drop f ] if ;
 
 : digit> ( ch -- n )
-    {
+    H{
-        { [ dup digit?  ] [ CHAR: 0 - ] }
+        { CHAR: 0 0 }
-        { [ dup letter? ] [ CHAR: a - 10 + ] }
+        { CHAR: 1 1 }
-        { [ dup LETTER? ] [ CHAR: A - 10 + ] }
+        { CHAR: 2 2 }
-        { [ t ] [ drop f ] }
+        { CHAR: 3 3 }
-    } cond ;
+        { CHAR: 4 4 }
+        { CHAR: 5 5 }
+        { CHAR: 6 6 }
+        { CHAR: 7 7 }
+        { CHAR: 8 8 }
+        { CHAR: 9 9 }
+        { CHAR: A 10 }
+        { CHAR: B 11 }
+        { CHAR: C 12 }
+        { CHAR: D 13 }
+        { CHAR: E 14 }
+        { CHAR: F 15 }
+        { CHAR: a 10 }
+        { CHAR: b 11 }
+        { CHAR: c 12 }
+        { CHAR: d 13 }
+        { CHAR: e 14 }
+        { CHAR: f 15 }
+    } at ;
 
 : digits>integer ( radix seq -- n )
     0 rot [ swapd * + ] curry reduce ;

core/optimizer/math/math.factor

@@ -1,13 +1,13 @@
 ! Copyright (C) 2005, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 IN: optimizer.math
-USING: alien arrays generic hashtables kernel assocs math
+USING: alien alien.accessors arrays generic hashtables kernel
-math.private kernel.private sequences words parser
+assocs math math.private kernel.private sequences words parser
 inference.class inference.dataflow vectors strings sbufs io
 namespaces assocs quotations math.intervals sequences.private
-combinators splitting layouts math.parser classes
+combinators splitting layouts math.parser classes generic.math
-generic.math optimizer.pattern-match optimizer.backend
+optimizer.pattern-match optimizer.backend optimizer.def-use
-optimizer.def-use generic.standard system ;
+generic.standard system ;
 
 { + bignum+ float+ fixnum+fast } {
     { { number 0 } [ drop ] }

core/parser/parser.factor

@@ -5,7 +5,8 @@ namespaces prettyprint sequences strings vectors words
 quotations inspector io.styles io combinators sorting
 splitting math.parser effects continuations debugger 
 io.files io.streams.string io.streams.lines vocabs
-source-files classes hashtables compiler.errors compiler.units ;
+source-files classes hashtables compiler.errors compiler.units
+ascii ;
 IN: parser
 
 TUPLE: lexer text line column ;

core/prettyprint/backend/backend.factor

@@ -1,9 +1,10 @@
-! Copyright (C) 2003, 2007 Slava Pestov.
+! Copyright (C) 2003, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: arrays byte-arrays bit-arrays generic hashtables io
+USING: arrays byte-arrays byte-vectors bit-arrays bit-vectors
-assocs kernel math namespaces sequences strings sbufs io.styles
+generic hashtables io assocs kernel math namespaces sequences
-vectors words prettyprint.config prettyprint.sections quotations
+strings sbufs io.styles vectors words prettyprint.config
-io io.files math.parser effects tuples classes float-arrays ;
+prettyprint.sections quotations io io.files math.parser effects
+tuples classes float-arrays float-vectors ascii ;
 IN: prettyprint.backend
 
 GENERIC: pprint* ( obj -- )
@@ -143,8 +144,11 @@ M: quotation pprint-delims drop \ [ \ ] ;
 M: curry pprint-delims drop \ [ \ ] ;
 M: array pprint-delims drop \ { \ } ;
 M: byte-array pprint-delims drop \ B{ \ } ;
+M: byte-vector pprint-delims drop \ BV{ \ } ;
 M: bit-array pprint-delims drop \ ?{ \ } ;
+M: bit-vector pprint-delims drop \ ?V{ \ } ;
 M: float-array pprint-delims drop \ F{ \ } ;
+M: float-vector pprint-delims drop \ FV{ \ } ;
 M: vector pprint-delims drop \ V{ \ } ;
 M: hashtable pprint-delims drop \ H{ \ } ;
 M: tuple pprint-delims drop \ T{ \ } ;
@@ -155,6 +159,10 @@ GENERIC: >pprint-sequence ( obj -- seq )
 
 M: object >pprint-sequence ;
 
+M: vector >pprint-sequence ;
+M: bit-vector >pprint-sequence ;
+M: byte-vector >pprint-sequence ;
+M: float-vector >pprint-sequence ;
 M: hashtable >pprint-sequence >alist ;
 M: tuple >pprint-sequence tuple>array ;
 M: wrapper >pprint-sequence wrapped 1array ;

core/sbufs/sbufs.factor

@@ -1,13 +1,20 @@
 ! Copyright (C) 2004, 2007 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel math strings kernel.private sequences.private
+USING: kernel math strings sequences.private sequences strings
-sequences strings growable strings.private sbufs.private ;
+growable strings.private ;
 IN: sbufs
 
+<PRIVATE
+
+: string>sbuf ( string length -- sbuf )
+    sbuf construct-boa ; inline
+
+PRIVATE>
+
 : <sbuf> ( n -- sbuf ) 0 <string> 0 string>sbuf ; inline
 
 M: sbuf set-nth-unsafe
-    underlying >r >r >fixnum r> >fixnum r> set-char-slot ;
+    underlying >r >r >fixnum r> >fixnum r> set-string-nth ;
 
 M: sbuf new drop [ 0 <string> ] keep >fixnum string>sbuf ;
 

core/sbufs/tags.txt

@@ -1 +1,2 @@
+text
 collections

core/slots/slots.factor

@@ -1,8 +1,8 @@
-! Copyright (C) 2005, 2007 Slava Pestov.
+! Copyright (C) 2005, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: arrays kernel kernel.private math namespaces
 sequences strings words effects generic generic.standard
-classes slots.private ;
+classes slots.private combinators ;
 IN: slots
 
 TUPLE: slot-spec type name offset reader writer ;
@@ -87,14 +87,23 @@ PREDICATE: word slot-writer "writing" word-prop >boolean ;
 : simple-writer-word ( class name -- word )
     (simple-slot-word) writer-word ;
 
-: simple-slot ( class name # -- spec )
+: short-slot ( class name # -- spec )
     >r object bootstrap-word over r> f f <slot-spec>
     2over simple-reader-word over set-slot-spec-reader
     -rot simple-writer-word over set-slot-spec-writer ;
 
+: long-slot ( spec # -- spec )
+    >r [ dup array? [ first2 create ] when ] map first4 r>
+    -rot <slot-spec> ;
+
 : simple-slots ( class slots base -- specs )
-    over length [ + ] with map
+    over length [ + ] with map [
-    [ >r >r dup r> r> simple-slot ] 2map nip ;
+        {
+            { [ over not ] [ 2drop f ] }
+            { [ over string? ] [ >r dupd r> short-slot ] }
+            { [ over array? ] [ long-slot ] }
+        } cond
+    ] 2map [ ] subset nip ;
 
 : slot-of-reader ( reader specs -- spec/f )
     [ slot-spec-reader eq? ] with find nip ;

core/strings/strings-docs.factor

@@ -4,7 +4,11 @@ sbufs math ;
 IN: strings
 
 ARTICLE: "strings" "Strings"
-"A string is a fixed-size mutable sequence of characters. The literal syntax is covered in " { $link "syntax-strings" } "."
+"A string is a fixed-size mutable sequence of Unicode 5.0 code points."
+$nl
+"Characters are not a first-class type; they are simply represented as integers between 0 and 16777216 (2^24). Only characters up to 2097152 (2^21) have a defined meaning in Unicode."
+$nl
+"String literal syntax is covered in " { $link "syntax-strings" } "."
 $nl
 "String words are found in the " { $vocab-link "strings" } " vocabulary."
 $nl
@@ -16,28 +20,25 @@ $nl
 { $subsection <string> }
 "Creating a string from a single character:"
 { $subsection 1string }
-"Characters are not a first-class type; they are simply represented as integers between 0 and 65535. A few words operate on characters:"
+"Since strings are sequences, basic string manipulation can be performed using sequence operations (" { $link "sequences" } "). More advanced functionality can be found in other vocabularies, including but not limited to:"
-{ $subsection blank? }
+{ $list
-{ $subsection letter? }
+    { { $vocab-link "ascii" } " - traditional ASCII character classes" }
-{ $subsection LETTER? }
+    { { $vocab-link "unicode" } " - Unicode 5.0-aware character classes, case conversion, word breaks, ..." }
-{ $subsection digit? }
+    { { $vocab-link "regexp" } " - regular expressions" }
-{ $subsection printable? }
+    { { $vocab-link "peg" } " - parser expression grammars" }
-{ $subsection control? }
+} ;
-{ $subsection quotable? }
-{ $subsection ch>lower }
-{ $subsection ch>upper } ;
 
 ABOUT: "strings"
 
 HELP: string
 { $description "The class of fixed-length character strings. See " { $link "syntax-strings" } " for syntax and " { $link "strings" } " for general information." } ;
 
-HELP: char-slot ( n string -- ch )
+HELP: string-nth ( n string -- ch )
 { $values { "n" fixnum } { "string" string } { "ch" "the character at the " { $snippet "n" } "th index" } }
 { $description "Unsafe string accessor, used to define " { $link nth } " on strings." }
 { $warning "This word is in the " { $vocab-link "strings.private" } " vocabulary because it does not perform type or bounds checking. User code should call " { $link nth } " instead." } ;
 
-HELP: set-char-slot ( ch n string -- )
+HELP: set-string-nth ( ch n string -- )
 { $values { "ch" "a character" } { "n" fixnum } { "string" string }  }
 { $description "Unsafe string mutator, used to define " { $link set-nth } " on strings." }
 { $warning "This word is in the " { $vocab-link "strings.private" } " vocabulary because it does not perform type or bounds checking. User code should call " { $link set-nth } " instead." } ;
@@ -46,58 +47,6 @@ HELP: <string> ( n ch -- string )
 { $values { "n" "a positive integer specifying string length" } { "ch" "an initial character" } { "string" string } }
 { $description "Creates a new string with the given length and all characters initially set to " { $snippet "ch" } "." } ;
 
-HELP: blank?
-{ $values { "ch" "a character" } { "?" "a boolean" } }
-{ $description "Tests for an ASCII whitespace character." } ;
-
-HELP: letter?
-{ $values { "ch" "a character" } { "?" "a boolean" } }
-{ $description "Tests for a lowercase alphabet ASCII character." } ;
-
-HELP: LETTER?
-{ $values { "ch" "a character" } { "?" "a boolean" } }
-{ $description "Tests for a uppercase alphabet ASCII character." } ;
-
-HELP: digit?
-{ $values { "ch" "a character" } { "?" "a boolean" } }
-{ $description "Tests for an ASCII decimal digit character." } ;
-
-HELP: Letter?
-{ $values { "ch" "a character" } { "?" "a boolean" } }
-{ $description "Tests for an ASCII alphabet character, both upper and lower case." } ;
-
-HELP: alpha?
-{ $values { "ch" "a character" } { "?" "a boolean" } }
-{ $description "Tests for an alphanumeric ASCII character." } ;
-
-HELP: printable?
-{ $values { "ch" "a character" } { "?" "a boolean" } }
-{ $description "Tests for a printable ASCII character." } ;
-
-HELP: control?
-{ $values { "ch" "a character" } { "?" "a boolean" } }
-{ $description "Tests for an ASCII control character." } ;
-
-HELP: quotable?
-{ $values { "ch" "a character" } { "?" "a boolean" } }
-{ $description "Tests for characters which may appear in a Factor string literal without escaping." } ;
-
-HELP: ch>lower
-{ $values { "ch" "a character" } { "lower" "a character" } }
-{ $description "Converts a character to lowercase." } ;
-
-HELP: ch>upper
-{ $values { "ch" "a character" } { "upper" "a character" } }
-{ $description "Converts a character to uppercase." } ;
-
-HELP: >lower
-{ $values { "str" string } { "lower" string } }
-{ $description "Converts a string to lowercase." } ;
-
-HELP: >upper
-{ $values { "str" string } { "upper" string } }
-{ $description "Converts a string to uppercase." } ;
-
 HELP: 1string
 { $values { "ch" "a character"} { "str" string } }
 { $description "Outputs a string of one character." } ;

core/strings/strings-tests.factor

@@ -1,5 +1,5 @@
 USING: continuations kernel math namespaces strings sbufs
-tools.test sequences vectors ;
+tools.test sequences vectors arrays ;
 IN: temporary
 
 [ CHAR: b ] [ 1 >bignum "abc" nth ] unit-test
@@ -66,3 +66,27 @@ unit-test
 ! Random tester found this
 [ { "kernel-error" 3 12 -7 } ]
 [ [ 2 -7 resize-string ] catch ] unit-test
+
+"hello world" "s" set
+
+[ ] [ HEX: 1234 1 "s" get set-nth ] unit-test
+[ ] [ HEX: 4321 3 "s" get set-nth ] unit-test
+[ ] [ HEX: 654321 5 "s" get set-nth ] unit-test
+
+[
+    {
+        CHAR: h
+        HEX: 1234
+        CHAR: l
+        HEX: 4321
+        CHAR: o
+        HEX: 654321
+        CHAR: w
+        CHAR: o
+        CHAR: r
+        CHAR: l
+        CHAR: d
+    }
+] [
+    "s" get >array
+] unit-test

core/strings/strings.factor

@@ -1,14 +1,15 @@
-! Copyright (C) 2003, 2007 Slava Pestov.
+! Copyright (C) 2003, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel math.private sequences kernel.private
-math sequences.private slots.private ;
+math sequences.private slots.private byte-arrays
+alien.accessors ;
 IN: strings
 
 <PRIVATE
 
-: string-hashcode 2 slot ; inline
+: string-hashcode 3 slot ; inline
 
-: set-string-hashcode 2 set-slot ; inline
+: set-string-hashcode 3 set-slot ; inline
 
 : reset-string-hashcode f swap set-string-hashcode ; inline
 
@@ -29,43 +30,17 @@ M: string hashcode*
     nip dup string-hashcode [ ]
     [ dup rehash-string string-hashcode ] ?if ;
 
-M: string nth-unsafe >r >fixnum r> char-slot ;
+M: string nth-unsafe
+    >r >fixnum r> string-nth ;
 
-M: string set-nth-unsafe 
+M: string set-nth-unsafe
     dup reset-string-hashcode
-    >r >fixnum >r >fixnum r> r> set-char-slot ;
+    >r >fixnum >r >fixnum r> r> set-string-nth ;
 
 M: string clone (clone) ;
 
 M: string resize resize-string ;
 
-! Characters
-: blank? ( ch -- ? ) " \t\n\r" member? ; inline
-: letter? ( ch -- ? ) CHAR: a CHAR: z between? ; inline
-: LETTER? ( ch -- ? ) CHAR: A CHAR: Z between? ; inline
-: digit? ( ch -- ? ) CHAR: 0 CHAR: 9 between? ; inline
-: printable? ( ch -- ? ) CHAR: \s CHAR: ~ between? ; inline
-: control? ( ch -- ? ) "\0\e\r\n\t\u0008\u007f" member? ; inline
-
-: quotable? ( ch -- ? )
-    dup printable? [ "\"\\" member? not ] [ drop f ] if ; inline
-
-: Letter? ( ch -- ? )
-    dup letter? [ drop t ] [ LETTER? ] if ; inline
-
-: alpha? ( ch -- ? )
-    dup Letter? [ drop t ] [ digit? ] if ; inline
-
-: ch>lower ( ch -- lower )
-    dup LETTER? [ HEX: 20 + ] when ; inline
-
-: ch>upper ( ch -- upper )
-    dup letter? [ HEX: 20 - ] when ; inline
-
-: >lower ( str -- lower ) [ ch>lower ] map ;
-
-: >upper ( str -- upper ) [ ch>upper ] map ;
-
 : 1string ( ch -- str ) 1 swap <string> ;
 
 : >string ( seq -- str ) "" clone-like ;

core/strings/tags.txt

@@ -1 +1,2 @@
+text
 collections

core/syntax/syntax-docs.factor

@@ -151,6 +151,18 @@ ARTICLE: "syntax-byte-arrays" "Byte array syntax"
 { $subsection POSTPONE: B{ }
 "Byte arrays are documented in " { $link "byte-arrays" } "." ;
 
+ARTICLE: "syntax-bit-vectors" "Bit vector syntax"
+{ $subsection POSTPONE: ?V{ }
+"Bit vectors are documented in " { $link "bit-vectors" } "." ;
+
+ARTICLE: "syntax-float-vectors" "Float vector syntax"
+{ $subsection POSTPONE: FV{ }
+"Float vectors are documented in " { $link "float-vectors" } "." ;
+
+ARTICLE: "syntax-byte-vectors" "Byte vector syntax"
+{ $subsection POSTPONE: BV{ }
+"Byte vectors are documented in " { $link "byte-vectors" } "." ;
+
 ARTICLE: "syntax-pathnames" "Pathname syntax"
 { $subsection POSTPONE: P" }
 "Pathnames are documented in " { $link "file-streams" } "." ;
@@ -165,11 +177,15 @@ $nl
 { $subsection "syntax-words" }
 { $subsection "syntax-quots" }
 { $subsection "syntax-arrays" }
-{ $subsection "syntax-vectors" }
 { $subsection "syntax-strings" }
-{ $subsection "syntax-sbufs" }
-{ $subsection "syntax-byte-arrays" }
 { $subsection "syntax-bit-arrays" }
+{ $subsection "syntax-byte-arrays" }
+{ $subsection "syntax-float-arrays" }
+{ $subsection "syntax-vectors" }
+{ $subsection "syntax-sbufs" }
+{ $subsection "syntax-bit-vectors" }
+{ $subsection "syntax-byte-vectors" }
+{ $subsection "syntax-float-vectors" }
 { $subsection "syntax-hashtables" }
 { $subsection "syntax-tuples" }
 { $subsection "syntax-pathnames" } ;
@@ -273,12 +289,30 @@ HELP: B{
 { $description "Marks the beginning of a literal byte array. Literal byte arrays are terminated by " { $link POSTPONE: } } "." } 
 { $examples { $code "B{ 1 2 3 }" } } ;
 
+HELP: BV{
+{ $syntax "BV{ elements... }" }
+{ $values { "elements" "a list of bytes" } }
+{ $description "Marks the beginning of a literal byte vector. Literal byte vectors are terminated by " { $link POSTPONE: } } "." } 
+{ $examples { $code "BV{ 1 2 3 12 }" } } ;
+
 HELP: ?{
 { $syntax "?{ elements... }" }
 { $values { "elements" "a list of booleans" } }
 { $description "Marks the beginning of a literal bit array. Literal bit arrays are terminated by " { $link POSTPONE: } } "." } 
 { $examples { $code "?{ t f t }" } } ;
 
+HELP: ?V{
+{ $syntax "?V{ elements... }" }
+{ $values { "elements" "a list of booleans" } }
+{ $description "Marks the beginning of a literal bit vector. Literal bit vectors are terminated by " { $link POSTPONE: } } "." } 
+{ $examples { $code "?V{ t f t }" } } ;
+
+HELP: FV{
+{ $syntax "FV{ elements... }" }
+{ $values { "elements" "a list of real numbers" } }
+{ $description "Marks the beginning of a literal float vector. Literal float vectors are terminated by " { $link POSTPONE: } } "." } 
+{ $examples { $code "FV{ 1.0 2.0 3.0 }" } } ;
+
 HELP: F{
 { $syntax "F{ elements... }" }
 { $values { "elements" "a list of real numbers" } }

core/syntax/syntax.factor

@@ -1,11 +1,11 @@
-! Copyright (C) 2004, 2007 Slava Pestov.
+! Copyright (C) 2004, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: alien arrays bit-arrays byte-arrays definitions generic
+USING: alien arrays bit-arrays bit-vectors byte-arrays
-hashtables kernel math namespaces parser sequences strings sbufs
+byte-vectors definitions generic hashtables kernel math
-vectors words quotations io assocs splitting tuples
+namespaces parser sequences strings sbufs vectors words
-generic.standard generic.math classes io.files vocabs
+quotations io assocs splitting tuples generic.standard
-float-arrays classes.union classes.mixin classes.predicate
+generic.math classes io.files vocabs float-arrays float-vectors
-compiler.units ;
+classes.union classes.mixin classes.predicate compiler.units ;
 IN: bootstrap.syntax
 
 ! These words are defined as a top-level form, instead of with
@@ -71,8 +71,11 @@ IN: bootstrap.syntax
     "{" [ \ } [ >array ] parse-literal ] define-syntax
     "V{" [ \ } [ >vector ] parse-literal ] define-syntax
     "B{" [ \ } [ >byte-array ] parse-literal ] define-syntax
+    "BV{" [ \ } [ >byte-vector ] parse-literal ] define-syntax
     "?{" [ \ } [ >bit-array ] parse-literal ] define-syntax
+    "?V{" [ \ } [ >bit-vector ] parse-literal ] define-syntax
     "F{" [ \ } [ >float-array ] parse-literal ] define-syntax
+    "FV{" [ \ } [ >float-vector ] parse-literal ] define-syntax
     "H{" [ \ } [ >hashtable ] parse-literal ] define-syntax
     "T{" [ \ } [ >tuple ] parse-literal ] define-syntax
     "W{" [ \ } [ first <wrapper> ] parse-literal ] define-syntax

core/system/system-docs.factor

@@ -49,6 +49,7 @@ HELP: os
         "linux"
         "macosx"
         "openbsd"
+        "netbsd"
         "solaris"
         "windows"
     }

core/system/system.factor

@@ -39,11 +39,11 @@ splitting assocs ;
 
 : unix? ( -- ? )
     os {
-        "freebsd" "openbsd" "linux" "macosx" "solaris"
+        "freebsd" "openbsd" "netbsd" "linux" "macosx" "solaris"
     } member? ;
 
 : bsd? ( -- ? )
-    os { "freebsd" "openbsd" "macosx" } member? ;
+    os { "freebsd" "openbsd" "netbsd" "macosx" } member? ;
 
 : linux? ( -- ? )
     os "linux" = ;

core/tuples/tuples.factor

@@ -80,8 +80,8 @@ PRIVATE>
     } ;
 
 : define-tuple-slots ( class slots -- )
-    2dup "slot-names" set-word-prop
     dupd 4 simple-slots
+    2dup [ slot-spec-name ] map "slot-names" set-word-prop
     2dup delegate-slot-spec add* "slots" set-word-prop
     define-slots ;
 

core/vectors/vectors-docs.factor

@@ -30,10 +30,10 @@ HELP: >vector
 { $values { "seq" "a sequence" } { "vector" vector } }
 { $description "Outputs a freshly-allocated vector with the same elements as a given sequence." } ;
 
-HELP: array>vector ( array length -- vector )
+HELP: array>vector
 { $values { "array" "an array" } { "length" "a non-negative integer" } { "vector" vector } }
 { $description "Creates a new vector using the array for underlying storage with the specified initial length." }
-{ $warning "This word is in the " { $vocab-link "sequences.private" } " vocabulary because it does not perform type or bounds checks. User code should call " { $link >vector } " instead." } ;
+{ $warning "This word is in the " { $vocab-link "vectors.private" } " vocabulary because it does not perform type or bounds checks. User code should call " { $link >vector } " instead." } ;
 
 HELP: 1vector
 { $values { "x" object } { "vector" vector } }

core/vectors/vectors.factor

@@ -1,10 +1,15 @@
-! Copyright (C) 2004, 2007 Slava Pestov.
+! Copyright (C) 2004, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: arrays kernel kernel.private math
+USING: arrays kernel math sequences sequences.private growable ;
-math.private sequences sequences.private vectors.private
-growable ;
 IN: vectors
 
+<PRIVATE
+
+: array>vector ( byte-array capacity -- byte-vector )
+    vector construct-boa ; inline
+
+PRIVATE>
+
 : <vector> ( n -- vector ) f <array> 0 array>vector ; inline
 
 : >vector ( seq -- vector ) V{ } clone-like ;

core/vocabs/loader/loader.factor

@@ -148,8 +148,16 @@ SYMBOL: load-help?
     dup update-roots
     dup modified-sources swap modified-docs ;
 
+: require-restart { { "Ignore this vocabulary" t } } ;
+
 : require-all ( seq -- )
-    [ [ require ] each ] with-compiler-errors ;
+    [
+        [
+            [ require ]
+            [ require-restart rethrow-restarts 2drop ]
+            recover
+        ] each
+    ] with-compiler-errors ;
 
 : do-refresh ( modified-sources modified-docs -- )
     2dup

extra/benchmark/bootstrap2/bootstrap2.factor

@@ -1,9 +1,14 @@
-USING: tools.deploy.private io.files system
+USING: io.files io.launcher system tools.deploy.backend
-tools.deploy.backend ;
+namespaces sequences kernel ;
 IN: benchmark.bootstrap2
 
 : bootstrap-benchmark
     "." resource-path cd
-    vm { "-output-image=foo.image" "-no-user-init" } stage2 ;
+    [
+        vm ,
+        "-i=" boot-image-name append ,
+        "-output-image=foo.image" ,
+        "-no-user-init" ,
+    ] { } make run-process drop ;
 
 MAIN: bootstrap-benchmark

extra/boids/ui/ui.factor

@@ -145,20 +145,20 @@ VARS: population-label cohesion-label alignment-label separation-label ;
   slate> over @center grid-add
 
   H{ } clone
-    T{ key-down f f "1" } C[ drop randomize    ] put-hash
+    T{ key-down f f "1" } C[ drop randomize    ] put-at
-    T{ key-down f f "2" } C[ drop sub-10-boids ] put-hash
+    T{ key-down f f "2" } C[ drop sub-10-boids ] put-at
-    T{ key-down f f "3" } C[ drop add-10-boids ] put-hash
+    T{ key-down f f "3" } C[ drop add-10-boids ] put-at
 
-    T{ key-down f f "q" } C[ drop inc-cohesion-weight ] put-hash
+    T{ key-down f f "q" } C[ drop inc-cohesion-weight ] put-at
-    T{ key-down f f "a" } C[ drop dec-cohesion-weight ] put-hash
+    T{ key-down f f "a" } C[ drop dec-cohesion-weight ] put-at
 
-    T{ key-down f f "w" } C[ drop inc-alignment-weight ] put-hash
+    T{ key-down f f "w" } C[ drop inc-alignment-weight ] put-at
-    T{ key-down f f "s" } C[ drop dec-alignment-weight ] put-hash
+    T{ key-down f f "s" } C[ drop dec-alignment-weight ] put-at
 
-    T{ key-down f f "e" } C[ drop inc-separation-weight ] put-hash
+    T{ key-down f f "e" } C[ drop inc-separation-weight ] put-at
-    T{ key-down f f "d" } C[ drop dec-separation-weight ] put-hash
+    T{ key-down f f "d" } C[ drop dec-separation-weight ] put-at
 
-    T{ key-down f f "ESC" } C[ drop toggle-loop ] put-hash
+    T{ key-down f f "ESC" } C[ drop toggle-loop ] put-at
   <handler> tuck set-gadget-delegate "Boids" open-window ;
 
 : boids-window ( -- ) [ [ boids-window* ] with-scope ] with-ui ;

extra/builder/builder.factor

@@ -0,0 +1,113 @@
+
+USING: kernel io io.files io.launcher
+       system namespaces sequences splitting math.parser
+       unix prettyprint tools.time calendar bake vars ;
+
+IN: builder
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: datestamp ( -- string )
+  now `{ ,[ dup timestamp-year   ]
+      	 ,[ dup timestamp-month	 ]
+	 ,[ dup timestamp-day	 ]
+	 ,[ dup timestamp-hour	 ]
+	 ,[     timestamp-minute ] }
+  [ number>string 2 CHAR: 0 pad-left ] map "-" join ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+SYMBOL: builder-recipients
+
+: quote ( str -- str ) "'" swap "'" 3append ;
+
+: email-file ( subject file -- )
+  `{
+     "cat"       ,
+     "| mutt -s" ,[ quote ]
+     "-x"        %[ builder-recipients get ]
+   }
+   " " join system drop ;
+  
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: boot-image ( -- filename ) `{ "boot" ,[ cpu ] "image" } "." join ;
+
+: target ( -- target ) `{ ,[ os ] %[ cpu "." split ] } "-" join ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+VAR: stamp
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: build ( -- )
+
+datestamp >stamp
+
+"/builds/factor" cd
+"git pull git://factorcode.org/git/factor.git" system
+0 =
+[ ]
+[
+  "builder: git pull" "/dev/null" email-file
+  "builder: git pull" throw
+]
+if
+
+"/builds/" stamp> append make-directory
+"/builds/" stamp> append cd
+"git clone /builds/factor" system drop
+
+"factor" cd
+
+{ "/usr/bin/git" "show" } <process-stream>
+[ readln ] with-stream
+" " split second
+"../git-id" <file-writer> [ print ] with-stream
+
+"make clean" system drop
+
+"make " target " > ../compile-log" 3append system
+0 =
+[ ]
+[
+  "builder: vm compile" "../compile-log" email-file
+  "builder: vm compile" throw
+] if
+
+"wget http://factorcode.org/images/latest/" boot-image append system
+0 =
+[ ]
+[
+  "builder: image download" "/dev/null" email-file
+  "builder: image download" throw
+] if
+
+[ "./factor -i=" boot-image " -no-user-init > ../boot-log" 3append system ]
+benchmark nip
+"../boot-time" <file-writer> [ . ] with-stream
+0 =
+[ ]
+[
+  "builder: bootstrap" "../boot-log" email-file
+  "builder: bootstrap" throw
+] if
+
+[
+  "./factor -e='USE: tools.browser load-everything' > ../load-everything-log"
+  system
+] benchmark nip
+"../load-everything-time" <file-writer> [ . ] with-stream
+0 =
+[ ]
+[
+  "builder: load-everything" "../load-everything-log" email-file
+  "builder: load-everything" throw
+] if
+
+;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+MAIN: build

extra/bunny/bunny.factor

@@ -53,7 +53,7 @@ IN: bunny
     model-path resource-path dup exists? [
         "Downloading bunny from " write
         model-url dup print flush
-        over download
+        over download-to
     ] unless ;
 
 : draw-triangle ( ns vs triple -- )

extra/cabal/cabal.factor

@@ -41,7 +41,7 @@ VARS: input user ;
 : ((send-input)) ( other -- ) [ input> print flush ] with-stream* ;
 
 : (send-input) ( other -- )
-[ ((send-input)) ] catch [ print dup stream-close users> delete ] when ;
+[ ((send-input)) ] catch [ print dup dispose users> delete ] when ;
 
 : send-input ( other -- )
 dup duplex-stream-closed? [ users> delete ] [ (send-input) ] if ;

extra/concurrency/concurrency-docs.factor

@@ -127,7 +127,7 @@ ARTICLE: { "concurrency" "processes" } "Processes"
 { $code ": odd? ( n -- ? ) 2 mod 1 = ;\n1 self send 2 self send 3 self send\n\nreceive .\n => 1\n\n[ odd? ] receive-if .\n => 3\n\nreceive .\n => 2" } ;
 
 ARTICLE: { "concurrency" "self" } "Self"
-"A process can get access to its own process object using " { $link self } " so it can pass it to other processes. This allows the other processes to send messages back. A simple example of using this gets the current processes 'self' and spawns a process which sends a message to it. We then receive the message from the original process:" 
+"A process can get access to its own process object using " { $link self } " so it can pass it to other processes. This allows the other processes to send messages back. A simple example of using this gets the current process' 'self' and spawns a process which sends a message to it. We then receive the message from the original process:" 
 { $code "self [ \"Hello!\" swap send ] spawn 2drop receive .\n => \"Hello!\"" } ;
 
 ARTICLE: { "concurrency" "servers" } "Servers"
@@ -150,7 +150,7 @@ ARTICLE: { "concurrency" "exceptions" } "Exceptions"
 "Exceptions are only raised in the parent when the parent does a " { $link receive } " or " { $link receive-if } ". This is because the exception is sent from the child to the parent as a message." ;
 
 ARTICLE: { "concurrency" "futures" } "Futures"
-"A future is a placeholder for the result of a computation that is being calculated in a process. When the process has completed the computation the future can be queried to find out the result. If the computation has not completed when the future is queried them the process will block until the result is completed. <p>A future is created using " { $link future } ".\n\nThe quotation will be run in a spawned process, and a future object is immediately returned. This future object can be resolved using " { $link ?future } ".\n\nFutures are useful for starting calculations that take a long time to run but aren't needed until later in the process. When the process needs the value it can use '?future' to get the result or block until the result is available. For example:"
+"A future is a placeholder for the result of a computation that is being calculated in a process. When the process has completed the computation the future can be queried to find out the result. If the computation has not completed when the future is queried them the process will block until the result is completed. A future is created using " { $link future } ".\n\nThe quotation will be run in a spawned process, and a future object is immediately returned. This future object can be resolved using " { $link ?future } ".\n\nFutures are useful for starting calculations that take a long time to run but aren't needed until later in the process. When the process needs the value it can use '?future' to get the result or block until the result is available. For example:"
 { $code "[ 30 fib ] future\n...do stuff...\n?future" } ;
 
 ARTICLE: { "concurrency" "promises" } "Promises"

extra/const/const.factor

@@ -14,3 +14,11 @@ IN: const
 
 : ENUM:
     ";" parse-tokens [ create-in ] map define-enum ; parsing
+
+: define-value ( word -- )
+    { f } clone [ first ] curry define ;
+
+: VALUE: CREATE define-value ; parsing
+
+: set-value ( value word -- )
+    word-def first set-first ;

extra/cryptlib/streams/streams.factor

@@ -1,6 +1,6 @@
 ! Copyright (C) 2007 Matthew Willis
 ! See http://factorcode.org/license.txt for BSD license.
-USING: cryptlib cryptlib.libcl kernel alien sequences
+USING: cryptlib cryptlib.libcl kernel alien sequences continuations
 byte-arrays namespaces io.buffers math generic io strings
 io.streams.lines io.streams.plain io.streams.duplex combinators
 alien.c-types ;
@@ -84,7 +84,7 @@ M: crypt-stream stream-write1 ( ch stream -- )
 : check-close ( err -- )
     dup CRYPT_ERROR_PARAM1 = [ drop ] [ check-result ] if ;
     
-M: crypt-stream stream-close ( stream -- )
+M: crypt-stream dispose ( stream -- )
     crypt-stream-handle cryptDestroySession check-close ;
 
 : create-session ( format -- session )
@@ -115,7 +115,7 @@ M: crypt-stream stream-close ( stream -- )
     
     dup stream-readln print
     
-    stream-close 
+    dispose 
     end 
     ;
     
@@ -130,7 +130,7 @@ M: crypt-stream stream-close ( stream -- )
     "Thanks!" over stream-print
     dup stream-flush
     
-    stream-close
+    dispose
     end 
     ;
     
@@ -152,6 +152,6 @@ M: crypt-stream stream-close ( stream -- )
     
     (rpl)
     
-    stream-close 
+    dispose 
     end 
     ;

extra/delegate/protocols/protocols.factor

@@ -15,7 +15,7 @@ PROTOCOL: assoc-protocol
     ! everything should work, just slower (with >alist)
 
 PROTOCOL: stream-protocol
-    stream-close stream-read1 stream-read stream-read-until
+    stream-read1 stream-read stream-read-until
     stream-flush stream-write1 stream-write stream-format
     stream-nl make-span-stream make-block-stream stream-readln
     make-cell-stream stream-write-table set-timeout ;

extra/documents/documents.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2006, 2007 Slava Pestov
 ! See http://factorcode.org/license.txt for BSD license.
 USING: arrays io kernel math models namespaces sequences strings
-splitting io.streams.lines combinators ;
+splitting io.streams.lines combinators unicode.categories ;
 IN: documents
 
 : +col ( loc n -- newloc ) >r first2 r> + 2array ;

extra/editors/gvim/windows/windows.factor

@@ -1,4 +1,4 @@
-USING: editors.gvim io.files io.windows kernel namespaces
+USING: editors.gvim.backend io.files io.windows kernel namespaces
 sequences windows.shell32 ;
 IN: editors.gvim.windows