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

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-tests.factor

@@ -2,16 +2,16 @@ IN: temporary
 USING: alien alien.syntax alien.c-types kernel tools.test
 sequences system libc ;
 
-[ "\u00ff" ]
+[ "\u0000ff" ]
-[ "\u00ff" string>char-alien alien>char-string ]
+[ "\u0000ff" string>char-alien alien>char-string ]
 unit-test
 
 [ "hello world" ]
 [ "hello world" string>char-alien alien>char-string ]
 unit-test
 
-[ "hello\uabcdworld" ]
+[ "hello\u00abcdworld" ]
-[ "hello\uabcdworld" string>u16-alien alien>u16-string ]
+[ "hello\u00abcdworld" string>u16-alien alien>u16-string ]
 unit-test
 
 [ t ] [ f expired? ] unit-test

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/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
 
@@ -52,5 +52,3 @@ M: bit-array resize
     resize-bit-array ;
 
 INSTANCE: bit-array sequence
-INSTANCE: bit-array simple-c-ptr
-INSTANCE: bit-array c-ptr

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 ;
 

core/bootstrap/primitives.factor

@@ -40,6 +40,7 @@ call
 ! classes will go
 {
     "alien"
+    "alien.accessors"
     "arrays"
     "bit-arrays"
     "bit-vectors"
@@ -190,6 +191,11 @@ num-types get f <array> builtins set
         "length"
         { "length" "sequences" }
         f
+    } {
+        { "object" "kernel" }
+        "aux"
+        { "string-aux" "strings.private" }
+        { "set-string-aux" "strings.private" }
     }
 } define-builtin
 
@@ -556,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" }
@@ -590,8 +596,8 @@ 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" }
     { "<array>" "arrays" }

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

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) ;
@@ -19,5 +19,3 @@ M: byte-array resize
     resize-byte-array ;
 
 INSTANCE: byte-array sequence
-INSTANCE: byte-array simple-c-ptr
-INSTANCE: byte-array c-ptr

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

core/compiler/test/redefine.factor

@@ -249,4 +249,4 @@ DEFER: defer-redefine-test-2
 
 [ ] [ "IN: temporary : defer-redefine-test-1 2 ;" eval ] unit-test
 
-[ 1 ] [ defer-redefine-test-2 ] 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/cpu/ppc/intrinsics/intrinsics.factor

@@ -1,6 +1,6 @@
-! Copyright (C) 2005, 2007 Slava Pestov.
+! Copyright (C) 2005, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: alien alien.c-types arrays cpu.ppc.assembler
+USING: alien alien.accessors alien.c-types arrays cpu.ppc.assembler
 cpu.ppc.architecture cpu.ppc.allot cpu.architecture kernel
 kernel.private math math.private namespaces sequences words
 generic quotations byte-arrays hashtables hashtables.private
@@ -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" } } }

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 ;

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/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
 
@@ -33,8 +33,6 @@ 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/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/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
@@ -480,10 +481,10 @@ 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

core/io/binary/binary-tests.factor

@@ -1,8 +1,8 @@
 USING: io.binary tools.test ;
 IN: temporary
 
-[ "\0\0\u0004\u00d2" ] [ 1234 4 >be ] unit-test
+[ "\0\0\u000004\u0000d2" ] [ 1234 4 >be ] unit-test
-[ "\u00d2\u0004\0\0" ] [ 1234 4 >le ] unit-test
+[ "\u0000d2\u000004\0\0" ] [ 1234 4 >le ] unit-test
 
 [ 1234 ] [ 1234 4 >be be> ] unit-test
 [ 1234 ] [ 1234 4 >le le> ] unit-test

core/io/encodings/encodings.factor

@@ -18,8 +18,8 @@ SYMBOL: begin
     over push 0 begin ;
 
 : finish-decoding ( buf ch state -- str )
-    begin eq? [ decode-error ] unless drop { } like ;
+    begin eq? [ decode-error ] unless drop "" like ;
 
 : decode ( seq quot -- str )
-    >r [ length <vector> 0 begin ] keep r> each
+    >r [ length <sbuf> 0 begin ] keep r> each
     finish-decoding ; inline

core/io/utf16/utf16-tests.factor

@@ -1,15 +1,15 @@
 USING: tools.test io.utf16 ;
 
-[ { CHAR: x } ] [ { 0 CHAR: x } decode-utf16be ] unit-test
+[ { CHAR: x } ] [ { 0 CHAR: x } decode-utf16be >array ] unit-test
-[ { HEX: 1D11E } ] [ { HEX: D8 HEX: 34 HEX: DD HEX: 1E } decode-utf16be ] unit-test
+[ { HEX: 1D11E } ] [ { HEX: D8 HEX: 34 HEX: DD HEX: 1E } decode-utf16be >array ] unit-test
-[ { BIN: 11011111 CHAR: q } decode-utf16be ] unit-test-fails
+[ { BIN: 11011111 CHAR: q } decode-utf16be >array ] unit-test-fails
-[ { BIN: 11011011 CHAR: x BIN: 11011011 CHAR: x } decode-utf16be ] unit-test-fails
+[ { BIN: 11011011 CHAR: x BIN: 11011011 CHAR: x } decode-utf16be >array ] unit-test-fails
 
-[ B{ 0 120 216 52 221 30 } ] [ { CHAR: x HEX: 1d11e } encode-utf16be ] unit-test
+[ B{ 0 120 216 52 221 30 } ] [ { CHAR: x HEX: 1d11e } encode-utf16be >array ] unit-test
 
-[ { CHAR: x } ] [ { CHAR: x 0 } decode-utf16le ] unit-test
+[ { CHAR: x } ] [ { CHAR: x 0 } decode-utf16le >array ] unit-test
-[ { 119070 } ] [ { HEX: 34 HEX: D8 HEX: 1E HEX: DD } decode-utf16le ] unit-test
+[ { 119070 } ] [ { HEX: 34 HEX: D8 HEX: 1E HEX: DD } decode-utf16le >array ] unit-test
-[ { 0 BIN: 11011111 } decode-utf16le ] unit-test-fails
+[ { 0 BIN: 11011111 } decode-utf16le >array ] unit-test-fails
-[ { 0 BIN: 11011011 0 0 } decode-utf16le ] unit-test-fails
+[ { 0 BIN: 11011011 0 0 } decode-utf16le >array ] unit-test-fails
 
-[ B{ 120 0 52 216 30 221 } ] [ { CHAR: x HEX: 1d11e } encode-utf16le ] unit-test
+[ B{ 120 0 52 216 30 221 } ] [ { CHAR: x HEX: 1d11e } encode-utf16le >array ] unit-test

core/io/utf16/utf16.factor

@@ -110,4 +110,3 @@ SYMBOL: quad3
         { [ utf16be? ] [ decode-utf16be ] }
         { [ t ] [ decode-error ] }
     } cond ;
-

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-tests.factor

@@ -8,14 +8,14 @@ IN: temporary
     [ 1 CHAR: a ]
     [ 0 "abcd" next-char ] unit-test
 
-    [ 6 CHAR: \s ]
+    [ 8 CHAR: \s ]
-    [ 1 "\\u0020hello" next-escape ] unit-test
+    [ 1 "\\u000020hello" next-escape ] unit-test
 
     [ 2 CHAR: \n ]
     [ 1 "\\nhello" next-escape ] unit-test
 
-    [ 6 CHAR: \s ]
+    [ 8 CHAR: \s ]
-    [ 0 "\\u0020hello" next-char ] unit-test
+    [ 0 "\\u000020hello" next-char ] unit-test
 
     [ 1 [ 2 [ 3 ] 4 ] 5 ]
     [ "1\n[\n2\n[\n3\n]\n4\n]\n5" eval ]
@@ -46,15 +46,13 @@ IN: temporary
     ! Test escapes
 
     [ " " ]
-    [ "\"\\u0020\"" eval ]
+    [ "\"\\u000020\"" eval ]
     unit-test
 
     [ "'" ]
-    [ "\"\\u0027\"" eval ]
+    [ "\"\\u000027\"" eval ]
     unit-test
 
-    [ "\\u123" eval ] unit-test-fails
-
     ! Test EOL comments in multiline strings.
     [ "Hello" ] [ "#! This calls until-eol.\n\"Hello\"" eval ] unit-test
 

core/parser/parser.factor

@@ -1,4 +1,4 @@
-! Copyright (C) 2005, 2007 Slava Pestov.
+! Copyright (C) 2005, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: arrays definitions generic assocs kernel math
 namespaces prettyprint sequences strings vectors words
@@ -54,8 +54,9 @@ t parser-notes set-global
     0 over set-lexer-column
     dup lexer-line 1+ swap set-lexer-line ;
 
-: skip ( i seq quot -- n )
+: skip ( i seq ? -- n )
-    over >r find* drop
+    over >r
+    [ swap CHAR: \s eq? xor ] curry find* drop
     [ r> drop ] [ r> length ] if* ; inline
 
 : change-column ( lexer quot -- )
@@ -66,14 +67,13 @@ t parser-notes set-global
 GENERIC: skip-blank ( lexer -- )
 
 M: lexer skip-blank ( lexer -- )
-    [ [ blank? not ] skip ] change-column ;
+    [ t skip ] change-column ;
 
 GENERIC: skip-word ( lexer -- )
 
 M: lexer skip-word ( lexer -- )
     [
-        2dup nth CHAR: " =
+        2dup nth CHAR: " = [ drop 1+ ] [ f skip ] if
-        [ drop 1+ ] [ [ blank? ] skip ] if
     ] change-column ;
 
 : still-parsing? ( lexer -- ? )
@@ -119,7 +119,7 @@ M: bad-escape summary drop "Bad escape code" ;
 
 : next-escape ( m str -- n ch )
     2dup nth CHAR: u =
-    [ >r 1+ dup 4 + tuck r> subseq hex> ]
+    [ >r 1+ dup 6 + tuck r> subseq hex> ]
     [ over 1+ -rot nth escape ] if ;
 
 : next-char ( m str -- n ch )

core/prettyprint/backend/backend-docs.factor

@@ -20,7 +20,7 @@ HELP: ch>ascii-escape
 
 HELP: ch>unicode-escape
 { $values { "ch" "a character" } { "str" string } }
-{ $description "Converts a character to a Unicode escape code (" { $snippet "\\u1234"} ")." } ;
+{ $description "Converts a character to a Unicode escape code (" { $snippet "\\u123456"} ")." } ;
 
 HELP: unparse-ch
 { $values { "ch" "a character" } }

core/prettyprint/backend/backend.factor

@@ -58,24 +58,17 @@ M: f pprint* drop \ f pprint-word ;
 ! Strings
 : ch>ascii-escape ( ch -- str )
     H{
-        { CHAR: \e "\\e"  }
+        { CHAR: \e CHAR: \\e  }
-        { CHAR: \n "\\n"  }
+        { CHAR: \n CHAR: \\n  }
-        { CHAR: \r "\\r"  }
+        { CHAR: \r CHAR: \\r  }
-        { CHAR: \t "\\t"  }
+        { CHAR: \t CHAR: \\t  }
-        { CHAR: \0 "\\0"  }
+        { CHAR: \0 CHAR: \\0  }
-        { CHAR: \\ "\\\\" }
+        { CHAR: \\ CHAR: \\\\ }
-        { CHAR: \" "\\\"" }
+        { CHAR: \" CHAR: \\\" }
     } at ;
 
-: ch>unicode-escape ( ch -- str )
-    >hex 4 CHAR: 0 pad-left "\\u" swap append ;
-
 : unparse-ch ( ch -- )
-    dup quotable? [
+    dup ch>ascii-escape [ ] [ ] ?if , ;
-        ,
-    ] [
-        dup ch>ascii-escape [ ] [ ch>unicode-escape ] ?if %
-    ] if ;
 
 : do-string-limit ( str -- trimmed )
     string-limit get [

core/prettyprint/prettyprint-tests.factor

@@ -21,8 +21,8 @@ IN: temporary
 [ "hello\\backslash" unparse ]
 unit-test
 
-[ "\"\\u1234\"" ]
+[ "\"\\u123456\"" ]
-[ "\u1234" unparse ]
+[ "\u123456" unparse ]
 unit-test
 
 [ "\"\\e\"" ]

core/sbufs/sbufs.factor

@@ -14,7 +14,7 @@ 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/sequences/sequences-tests.factor

@@ -151,7 +151,7 @@ unit-test
 
 [ 5 ] [ 1 >bignum { 1 5 7 } nth-unsafe ] unit-test
 [ 5 ] [ 1 >bignum { 1 5 7 } nth-unsafe ] unit-test
-[ 5 ] [ 1 >bignum "\u0001\u0005\u0007" nth-unsafe ] unit-test
+[ 5 ] [ 1 >bignum "\u000001\u000005\u000007" nth-unsafe ] unit-test
 
 [ SBUF" before&after" ] [
     "&" 6 11 SBUF" before and after" [ replace-slice ] keep
@@ -235,12 +235,12 @@ unit-test
 [ 11 10 nth ] unit-test-fails
 
 [ -1./0. 0 delete-nth ] unit-test-fails
-[ "" ] [ "" [ blank? ] trim ] unit-test
+[ "" ] [ "" [ CHAR: \s = ] trim ] unit-test
-[ "" ] [ "" [ blank? ] left-trim ] unit-test
+[ "" ] [ "" [ CHAR: \s = ] left-trim ] unit-test
-[ "" ] [ "" [ blank? ] right-trim ] unit-test
+[ "" ] [ "" [ CHAR: \s = ] right-trim ] unit-test
-[ "" ] [ "  " [ blank? ] left-trim ] unit-test
+[ "" ] [ "  " [ CHAR: \s = ] left-trim ] unit-test
-[ "" ] [ "  " [ blank? ] right-trim ] unit-test
+[ "" ] [ "  " [ CHAR: \s = ] right-trim ] unit-test
-[ "asdf" ] [ " asdf " [ blank? ] trim ] unit-test
+[ "asdf" ] [ " asdf " [ CHAR: \s = ] trim ] unit-test
-[ "asdf " ] [ " asdf " [ blank? ] left-trim ] unit-test
+[ "asdf " ] [ " asdf " [ CHAR: \s = ] left-trim ] unit-test
-[ " asdf" ] [ " asdf " [ blank? ] right-trim ] unit-test
+[ " asdf" ] [ " asdf " [ CHAR: \s = ] right-trim ] unit-test
 

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." } ;
@@ -109,4 +58,4 @@ HELP: >string
 
 HELP: resize-string ( n str -- newstr )
 { $values { "n" "a non-negative integer" } { "str" string } { "newstr" string } }
-{ $description "Creates a new string " { $snippet "n" } " characters long The contents of the existing string are copied into the new string; if the new string is shorter, only an initial segment is copied, and if the new string is longer the remaining space is filled with " { $snippet "\\u0000" } "." } ;
+{ $description "Creates a new string " { $snippet "n" } " characters long The contents of the existing string are copied into the new string; if the new string is shorter, only an initial segment is copied, and if the new string is longer the remaining space is filled with " { $snippet "\\u000000" } "." } ;

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
@@ -28,23 +28,11 @@ IN: temporary
 
 [ "end" ] [ "Beginning and end" 14 tail ] unit-test
 
-[ t ] [ CHAR: a letter? ] unit-test
-[ f ] [ CHAR: A letter? ] unit-test
-[ f ] [ CHAR: a LETTER? ] unit-test
-[ t ] [ CHAR: A LETTER? ] unit-test
-[ t ] [ CHAR: 0 digit? ] unit-test
-[ f ] [ CHAR: x digit? ] unit-test
-
 [ t ] [ "abc" "abd" <=> 0 < ] unit-test
 [ t ] [ "z" "abd" <=> 0 > ] unit-test
 
 [ f ] [ [ 0 10 "hello" subseq ] catch not ] unit-test
 
-[ 4 ] [
-    0 "There are Four Upper Case characters"
-    [ LETTER? [ 1+ ] when ] each
-] unit-test
-
 [ "Replacing+spaces+with+plus" ]
 [
     "Replacing spaces with plus"
@@ -66,3 +54,37 @@ unit-test
 ! Random tester found this
 [ { "kernel-error" 3 12 -7 } ]
 [ [ 2 -7 resize-string ] catch ] unit-test
+
+! Make sure 24-bit strings work
+"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
+
+! Make sure we clear aux vector when storing octets
+[ "\u123456hi" ] [ "ih\u123456" clone dup reverse-here ] unit-test
+
+! Make sure aux vector is not shared
+[ "\udeadbe" ] [
+	"\udeadbe" clone
+	CHAR: \u123456 over clone set-first
+] 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,18 @@ 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
     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 clone
+	(clone) dup string-aux clone over set-string-aux ;
 
 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

@@ -99,9 +99,9 @@ ARTICLE: "escape" "Character escape codes"
     { { $snippet "\\e" } "escape (ASCII 27)" }
     { { $snippet "\\\"" } { $snippet "\"" } }
 }
-"A Unicode character can be specified by its code number by writing " { $snippet "\\u" } " followed by a four-digit hexadecimal number. That is, the following two expressions are equivalent:"
+"A Unicode character can be specified by its code number by writing " { $snippet "\\u" } " followed by a six-digit hexadecimal number. That is, the following two expressions are equivalent:"
 { $code
-    "CHAR: \\u0078"
+    "CHAR: \\u000078"
     "78"
 }
 "While not useful for single characters, this syntax is also permitted inside strings." ;

extra/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"

extra/ascii/ascii-tests.factor

@@ -0,0 +1,15 @@
+IN: temporary
+USING: ascii tools.test sequences kernel math ;
+
+[ t ] [ CHAR: a letter? ] unit-test
+[ f ] [ CHAR: A letter? ] unit-test
+[ f ] [ CHAR: a LETTER? ] unit-test
+[ t ] [ CHAR: A LETTER? ] unit-test
+[ t ] [ CHAR: 0 digit? ] unit-test
+[ f ] [ CHAR: x digit? ] unit-test
+
+
+[ 4 ] [
+    0 "There are Four Upper Case characters"
+    [ LETTER? [ 1+ ] when ] each
+] unit-test

extra/ascii/ascii.factor

@@ -0,0 +1,26 @@
+! 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\u000008\u00007f" 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

extra/ascii/authors.txt

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

extra/ascii/summary.txt

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

extra/ascii/tags.txt

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

extra/asn1/asn1-tests.factor

@@ -1,7 +1,7 @@
 USING: asn1 asn1.ldap io io.streams.string tools.test ;
 
 [ 6 ] [
-    "\u0002\u0001\u0006" <string-reader> [ asn-syntax read-ber ] with-stream
+    "\u000002\u000001\u000006" <string-reader> [ asn-syntax read-ber ] with-stream
 ] unit-test
 
 [ "testing" ] [

extra/cel-shading/cel-shading.factor

@@ -1,5 +1,5 @@
 USING: arrays bunny combinators.lib io io.files kernel
-       math math.functions multiline
+       math math.functions multiline continuations debugger
        opengl opengl.gl opengl-demo-support
        sequences ui ui.gadgets ui.render ;
 IN: cel-shading
@@ -58,14 +58,14 @@ main()
     <simple-gl-program> ;
 
 M: cel-shading-gadget graft* ( gadget -- )
-    "2.0" { "GL_ARB_shader_objects" } require-gl-version-or-extensions
+    [ "2.0" { "GL_ARB_shader_objects" } require-gl-version-or-extensions
     0.0 0.0 0.0 1.0 glClearColor
     GL_CULL_FACE glEnable
     GL_DEPTH_TEST glEnable
-    cel-shading-program swap set-cel-shading-gadget-program ;
+    cel-shading-program swap set-cel-shading-gadget-program ] [ ] [ :c ] cleanup ;
 
 M: cel-shading-gadget ungraft* ( gadget -- )
-    cel-shading-gadget-program delete-gl-program ;
+    cel-shading-gadget-program [ delete-gl-program ] when* ;
 
 : cel-shading-draw-setup ( gadget -- gadget )
     [ demo-gadget-set-matrices ] keep

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/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 ;

extra/crypto/hmac/hmac-tests.factor

@@ -1,11 +1,11 @@
 USING: kernel io strings sequences namespaces math parser crypto.hmac tools.test ;
 IN: temporary
 
-[ "\u0092\u0094rz68\u00bb\u001c\u0013\u00f4\u008e\u00f8\u0015\u008b\u00fc\u009d" ] [ 16 11 <string> "Hi There" string>md5-hmac >string ] unit-test
+[ "\u000092\u000094rz68\u0000bb\u00001c\u000013\u0000f4\u00008e\u0000f8\u000015\u00008b\u0000fc\u00009d" ] [ 16 11 <string> "Hi There" string>md5-hmac >string ] unit-test
-[ "u\u000cx>j\u00b0\u00b5\u0003\u00ea\u00a8n1\n]\u00b78" ] [ "Jefe" "what do ya want for nothing?" string>md5-hmac >string ] unit-test
+[ "u\u00000cx>j\u0000b0\u0000b5\u000003\u0000ea\u0000a8n1\n]\u0000b78" ] [ "Jefe" "what do ya want for nothing?" string>md5-hmac >string ] unit-test
-[ "V\u00be4R\u001d\u0014L\u0088\u00db\u00b8\u00c73\u00f0\u00e8\u00b3\u00f6" ] [ 16 HEX: aa <string> 50 HEX: dd <string> string>md5-hmac >string ] unit-test
+[ "V\u0000be4R\u00001d\u000014L\u000088\u0000db\u0000b8\u0000c73\u0000f0\u0000e8\u0000b3\u0000f6" ] [ 16 HEX: aa <string> 50 HEX: dd <string> string>md5-hmac >string ] unit-test
 
-[ "g[\u000b:\eM\u00dfN\u0012Hr\u00dal/c+\u00fe\u00d9W\u00e9" ] [ 16 11 <string> "Hi There" string>sha1-hmac >string ] unit-test
+[ "g[\u00000b:\eM\u0000dfN\u000012Hr\u0000dal/c+\u0000fe\u0000d9W\u0000e9" ] [ 16 11 <string> "Hi There" string>sha1-hmac >string ] unit-test
-[ "\u00ef\u00fc\u00dfj\u00e5\u00eb/\u00a2\u00d2t\u0016\u00d5\u00f1\u0084\u00df\u009c%\u009a|y" ] [ "Jefe" "what do ya want for nothing?" string>sha1-hmac >string ] unit-test
+[ "\u0000ef\u0000fc\u0000dfj\u0000e5\u0000eb/\u0000a2\u0000d2t\u000016\u0000d5\u0000f1\u000084\u0000df\u00009c%\u00009a|y" ] [ "Jefe" "what do ya want for nothing?" string>sha1-hmac >string ] unit-test
-[ "\u00d70YM\u0016~5\u00d5\u0095o\u00d8\0=\r\u00b3\u00d3\u00f4m\u00c7\u00bb" ] [ 16 HEX: aa <string> 50 HEX: dd <string> string>sha1-hmac >string ] unit-test
+[ "\u0000d70YM\u000016~5\u0000d5\u000095o\u0000d8\0=\r\u0000b3\u0000d3\u0000f4m\u0000c7\u0000bb" ] [ 16 HEX: aa <string> 50 HEX: dd <string> string>sha1-hmac >string ] unit-test
 

extra/crypto/sha1/sha1-tests.factor

@@ -7,8 +7,8 @@ USING: arrays kernel math namespaces sequences tools.test crypto.sha1 ;
 10 swap <array> concat string>sha1str ] unit-test
 
 [
-    ";\u009b\u00fd\u00cdK\u00a3^s\u00d0*\u00e3\\\u00b5\u0013<\u00e8wA\u00b2\u0083\u00d20\u00f1\u00e6\u00cc\u00d8\u001e\u009c\u0004\u00d7PT]\u00ce,\u0001\u0012\u0080\u0096\u0099"
+    ";\u00009b\u0000fd\u0000cdK\u0000a3^s\u0000d0*\u0000e3\\\u0000b5\u000013<\u0000e8wA\u0000b2\u000083\u0000d20\u0000f1\u0000e6\u0000cc\u0000d8\u00001e\u00009c\u000004\u0000d7PT]\u0000ce,\u000001\u000012\u000080\u000096\u000099"
 ] [
-    "\u0066\u0053\u00f1\u000c\u001a\u00fa\u00b5\u004c\u0061\u00c8\u0025\u0075\u00a8\u004a\u00fe\u0030\u00d8\u00aa\u001a\u003a\u0096\u0096\u00b3\u0018\u0099\u0092\u00bf\u00e1\u00cb\u007f\u00a6\u00a7"
+    "\u000066\u000053\u0000f1\u00000c\u00001a\u0000fa\u0000b5\u00004c\u000061\u0000c8\u000025\u000075\u0000a8\u00004a\u0000fe\u000030\u0000d8\u0000aa\u00001a\u00003a\u000096\u000096\u0000b3\u000018\u000099\u000092\u0000bf\u0000e1\u0000cb\u00007f\u0000a6\u0000a7"
     string>sha1-interleave
 ] unit-test

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/help/tutorial/tutorial.factor

@@ -1,6 +1,7 @@
 USING: help.markup help.syntax ui.commands ui.operations
 ui.tools.search ui.tools.workspace editors vocabs.loader
-kernel sequences prettyprint tools.test strings ;
+kernel sequences prettyprint tools.test strings
+unicode.categories unicode.case ;
 IN: help.tutorial
 
 ARTICLE: "first-program-start" "Creating a vocabulary for your first program"
@@ -134,7 +135,7 @@ $nl
 { $code "[ Letter? ] subset >lower" }
 "This code starts with a string on the stack, removes non-alphabetical characters, and converts the result to lower case, leaving a new string on the stack. We put this code in a new word, and add the new word to " { $snippet "palindrome.factor" } ":"
 { $code ": normalize ( str -- newstr ) [ Letter? ] subset >lower ;" }
-"You will need to add " { $vocab-link "strings" } " to the vocabulary search path, so that " { $link Letter? } " can be used in the source file."
+"You will need to add " { $vocab-link "unicode.categories" } " to the vocabulary search path, so that " { $link Letter? } " can be used in the source file."
 $nl
 "We modify " { $snippet "palindrome?" } " to first apply " { $snippet "normalize" } " to its input:"
 { $code ": palindrome? ( str -- ? ) normalize dup reverse = ;" }

extra/html/elements/elements.factor

@@ -4,7 +4,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 
 USING: io kernel namespaces prettyprint quotations
-sequences strings words xml.writer compiler.units effects ;
+sequences strings words xml.writer xml.entities compiler.units effects ;
 
 IN: html.elements
 

extra/html/html.factor

@@ -1,9 +1,9 @@
 ! Copyright (C) 2004, 2006 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: generic assocs help http io io.styles io.files
+USING: generic assocs help http io io.styles io.files continuations
 io.streams.string kernel math math.parser namespaces
 quotations assocs sequences strings words html.elements
-xml.writer sbufs ;
+xml.writer xml.entities sbufs ;
 IN: html
 
 GENERIC: browser-link-href ( presented -- href )

extra/io/buffers/buffers.factor

@@ -2,8 +2,8 @@
 ! Copyright (C) 2006, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 IN: io.buffers
-USING: alien alien.c-types alien.syntax kernel kernel.private
+USING: alien alien.accessors alien.c-types alien.syntax kernel
-libc math sequences strings hints ;
+kernel.private libc math sequences strings hints ;
 
 TUPLE: buffer size ptr fill pos ;
 

extra/io/mmap/mmap.factor

@@ -1,7 +1,7 @@
-! Copyright (C) 2007 Doug Coleman.
+! Copyright (C) 2007, 2008 Doug Coleman, Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: continuations io.backend kernel quotations sequences
-system alien sequences.private ;
+system alien alien.accessors sequences.private ;
 IN: io.mmap
 
 TUPLE: mapped-file length address handle closed? ;

extra/io/monitor/monitor-docs.factor

@@ -8,35 +8,32 @@ $nl
 "Not all operating systems support recursive monitors; if recursive monitoring is not available, an error is thrown and the caller must implement alternative logic for monitoring subdirectories." } ;
 
 HELP: next-change
-{ $values { "monitor" "a monitor" } { "path" "a pathname string" } { "changes" "a sequence of change descriptors" } }
+{ $values { "monitor" "a monitor" } { "path" "a pathname string" } { "changes" "a change descriptor" } }
-{ $description "Waits for file system changes and outputs the pathname of the first changed file. The change descriptor is a sequence containing at least one change descriptor; see " { $link "io.monitor.descriptors" } "." } ;
+{ $description "Waits for file system changes and outputs the pathname of the first changed file. The change descriptor is aq sequence of symbols documented in " { $link "io.monitor.descriptors" } "." } ;
 
 HELP: with-monitor
 { $values { "path" "a pathname string" } { "recursive?" "a boolean" } { "quot" "a quotation with stack effect " { $snippet "( monitor -- )" } } }
 { $description "Opens a file system change monitor and passes it to the quotation. Closes the monitor after the quotation returns or throws an error." } ;
 
-HELP: +change-file+
+HELP: +add-file+
-{ $description "Indicates that the contents of the file have changed." } ;
+{ $description "Indicates that the file has been added to the directory." } ;
 
-HELP: +change-name+
+HELP: +remove-file+
-{ $description "Indicates that the file name has changed." } ;
+{ $description "Indicates that the file has been removed from the directory." } ;
 
-HELP: +change-size+
+HELP: +modify-file+
-{ $description "Indicates that the file size has changed." } ;
+{ $description "Indicates that the file contents have changed." } ;
 
-HELP: +change-attributes+
+HELP: +rename-file+
-{ $description "Indicates that file attributes has changed. Attributes are operating system-specific but may include the creation time and permissions." } ;
+{ $description "Indicates that file has been renamed." } ;
-
-HELP: +change-modified+
-{ $description "Indicates that the last modification time of the file has changed." } ;
 
 ARTICLE: "io.monitor.descriptors" "File system change descriptors"
 "Change descriptors output by " { $link next-change } ":"
-{ $subsection +change-file+ }
+{ $subsection +add-file+ }
-{ $subsection +change-name+ }
+{ $subsection +remove-file+ }
-{ $subsection +change-size+ }
+{ $subsection +modify-file+ }
-{ $subsection +change-attributes+ }
+{ $subsection +rename-file+ }
-{ $subsection +change-modified+ } ;
+{ $subsection +add-file+ } ;
 
 ARTICLE: "io.monitor" "File system change monitors"
 "File system change monitors listen for changes to file names, attributes and contents under a specified directory. They can optionally be recursive, in which case subdirectories are also monitored."

extra/io/monitor/monitor.factor

@@ -7,11 +7,10 @@ HOOK: <monitor> io-backend ( path recursive? -- monitor )
 
 HOOK: next-change io-backend ( monitor -- path changes )
 
-SYMBOL: +change-file+
+SYMBOL: +add-file+
-SYMBOL: +change-name+
+SYMBOL: +remove-file+
-SYMBOL: +change-size+
+SYMBOL: +modify-file+
-SYMBOL: +change-attributes+
+SYMBOL: +rename-file+
-SYMBOL: +change-modified+
 
 : with-monitor ( path recursive? quot -- )
     >r <monitor> r> with-disposal ; inline

extra/io/nonblocking/nonblocking.factor

@@ -67,17 +67,17 @@ timeout-queue global [ [ <dlist> ] unless* ] change-at
     dup timeout-queue get-global push-front*
     swap set-port-timeout-entry ;
 
-HOOK: expire-port io-backend ( port -- )
+HOOK: cancel-io io-backend ( port -- )
 
-M: object expire-port drop ;
+M: object cancel-io drop ;
 
 : expire-timeouts ( -- )
     timeout-queue get-global dup dlist-empty? [ drop ] [
         dup peek-back timeout?
-        [ pop-back expire-port expire-timeouts ] [ drop ] if
+        [ pop-back cancel-io expire-timeouts ] [ drop ] if
     ] if ;
 
-: touch-port ( port -- )
+: begin-timeout ( port -- )
     dup port-timeout dup zero? [
         2drop
     ] [
@@ -85,8 +85,13 @@ M: object expire-port drop ;
         dup unqueue-timeout queue-timeout
     ] if ;
 
-M: port set-timeout
+: end-timeout ( port -- )
-    [ set-port-timeout ] keep touch-port ;
+    unqueue-timeout ;
+
+: with-port-timeout ( port quot -- )
+    over begin-timeout keep end-timeout ; inline
+
+M: port set-timeout set-port-timeout ;
 
 GENERIC: (wait-to-read) ( port -- )
 
@@ -188,14 +193,18 @@ GENERIC: port-flush ( port -- )
 M: output-port stream-flush ( port -- )
     dup port-flush pending-error ;
 
-M: port dispose
+: close-port ( port type -- )
-    dup port-type closed eq? [
-        dup port-type >r closed over set-port-type r>
     output-port eq? [ dup port-flush ] when
+    dup cancel-io
     dup port-handle close-handle
     dup delegate [ buffer-free ] when*
-        f over set-delegate
+    f swap set-delegate ;
-    ] unless drop ;
+
+M: port dispose
+    dup port-type closed eq?
+    [ drop ]
+    [ dup port-type >r closed over set-port-type r> close-port ]
+    if ;
 
 TUPLE: server-port addr client ;
 

extra/io/streams/null/null.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2007 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 IN: io.streams.null
-USING: kernel io ;
+USING: kernel io continuations ;
 
 TUPLE: null-stream ;
 

extra/io/unix/backend/backend.factor

@@ -57,7 +57,11 @@ GENERIC: wait-for-events ( ms mx -- )
 M: mx register-io-task ( task mx -- )
     2dup check-io-task fd/container set-at ;
 
-: add-io-task ( task -- ) mx get-global register-io-task ;
+: add-io-task ( task -- )
+    mx get-global register-io-task stop ;
+
+: with-port-continuation ( port quot -- port )
+    [ callcc0 ] curry with-port-timeout ; inline
 
 M: mx unregister-io-task ( task mx -- )
     fd/container delete-at drop ;
@@ -98,7 +102,6 @@ M: integer close-handle ( fd -- )
     io-task-callbacks [ schedule-thread ] each ;
 
 : handle-io-task ( mx task -- )
-    dup io-task-port touch-port
     dup do-io-task [ pop-callbacks ] [ 2drop ] if ;
 
 : handle-timeout ( mx task -- )
@@ -133,7 +136,8 @@ M: read-task do-io-task
     [ [ reader-eof ] [ drop ] if ] keep ;
 
 M: input-port (wait-to-read)
-    [ <read-task> add-io-task stop ] callcc0 pending-error ;
+    [ <read-task> add-io-task ] with-port-continuation
+    pending-error ;
 
 ! Writers
 : write-step ( port -- ? )
@@ -151,11 +155,11 @@ M: write-task do-io-task
 
 : add-write-io-task ( port continuation -- )
     over port-handle mx get-global mx-writes at*
-    [ io-task-callbacks push drop ]
+    [ io-task-callbacks push stop ]
     [ drop <write-task> add-io-task ] if ;
 
 : (wait-to-write) ( port -- )
-    [ add-write-io-task stop ] callcc0 drop ;
+    [ add-write-io-task ] with-port-continuation drop ;
 
 M: port port-flush ( port -- )
     dup buffer-empty? [ drop ] [ (wait-to-write) ] if ;

extra/io/unix/sockets/sockets.factor

@@ -40,7 +40,7 @@ M: connect-task do-io-task
     0 < [ defer-error ] [ drop t ] if ;
 
 : wait-to-connect ( port -- )
-    [ <connect-task> add-io-task stop ] callcc0 drop ;
+    [ <connect-task> add-io-task ] with-port-continuation drop ;
 
 M: unix-io (client) ( addrspec -- stream )
     dup make-sockaddr/size >r >r
@@ -82,7 +82,7 @@ M: accept-task do-io-task
     over 0 >= [ do-accept t ] [ 2drop defer-error ] if ;
 
 : wait-to-accept ( server -- )
-    [ <accept-task> add-io-task stop ] callcc0 drop ;
+    [ <accept-task> add-io-task ] with-port-continuation drop ;
 
 USE: io.sockets
 
@@ -147,7 +147,7 @@ M: receive-task do-io-task
     ] if ;
 
 : wait-receive ( stream -- )
-    [ <receive-task> add-io-task stop ] callcc0 drop ;
+    [ <receive-task> add-io-task ] with-port-continuation drop ;
 
 M: unix-io receive ( datagram -- packet addrspec )
     dup check-datagram-port
@@ -178,7 +178,8 @@ M: send-task do-io-task
     swap 0 < [ io-task-port defer-error ] [ drop t ] if ;
 
 : wait-send ( packet sockaddr len stream -- )
-    [ <send-task> add-io-task stop ] callcc0 2drop 2drop ;
+    [ <send-task> add-io-task ] with-port-continuation
+    2drop 2drop ;
 
 M: unix-io send ( packet addrspec datagram -- )
     3dup check-datagram-send

extra/io/unix/unix-tests.factor

@@ -56,7 +56,7 @@ yield
 
         "Receive 2" print
 
-        "d" get receive >r >upper r>
+        "d" get receive >r " world" append r>
         
         "Send 1" print
         dup .
@@ -98,7 +98,7 @@ client-addr <datagram>
     "d" get send
 ] unit-test
 
-[ "HELLO" t ] [
+[ "hello world" t ] [
     "d" get receive
     server-addr =
     >r >string r>

extra/io/windows/ce/sockets/sockets.factor

@@ -42,9 +42,9 @@ M: windows-ce-io <server> ( addrspec -- duplex-stream )
     ] keep <server-port> ;
 
 M: windows-ce-io accept ( server -- client )
+    [
         dup check-server-port
         [
-        dup touch-port
             dup port-handle win32-file-handle
             swap server-port-addr sockaddr-type heap-size
             dup <byte-array> [
@@ -54,7 +54,8 @@ M: windows-ce-io accept ( server -- client )
                 [ windows.winsock:winsock-error ] when
             ] keep
         ] keep server-port-addr parse-sockaddr swap
-    <win32-socket> dup handle>duplex-stream <client-stream> ;
+        <win32-socket> dup handle>duplex-stream <client-stream>
+    ] with-port-timeout ;
 
 M: windows-ce-io <datagram> ( addrspec -- datagram )
     [

extra/io/windows/launcher/launcher.factor

@@ -119,8 +119,15 @@ TUPLE: CreateProcess-args
     drop STD_ERROR_HANDLE GetStdHandle ;
 
 : redirect-stderr ( args -- handle )
-    +stderr+ get GENERIC_WRITE CREATE_ALWAYS redirect
+    +stderr+ get
-    swap inherited-stderr ?closed ;
+    dup +stdout+ eq? [
+        drop
+        CreateProcess-args-lpStartupInfo
+        STARTUPINFO-hStdOutput
+    ] [
+        GENERIC_WRITE CREATE_ALWAYS redirect
+        swap inherited-stderr ?closed
+    ] if ;
 
 : inherited-stdin ( args -- handle )
     CreateProcess-args-stdin-pipe

extra/io/windows/nt/backend/backend.factor

@@ -2,7 +2,7 @@ USING: alien alien.c-types arrays assocs combinators
 continuations destructors io io.backend io.nonblocking
 io.windows libc kernel math namespaces sequences
 threads tuples.lib windows windows.errors windows.kernel32
-strings splitting io.files qualified ;
+strings splitting io.files qualified ascii ;
 QUALIFIED: windows.winsock
 IN: io.windows.nt.backend
 
@@ -122,7 +122,7 @@ M: windows-nt-io add-completion ( handle -- )
 : drain-overlapped ( timeout -- )
     handle-overlapped [ 0 drain-overlapped ] unless ;
 
-M: windows-nt-io expire-port
+M: windows-nt-io cancel-io
     port-handle win32-file-handle CancelIo drop ;
 
 M: windows-nt-io io-multiplex ( ms -- )

extra/io/windows/nt/files/files.factor

@@ -24,7 +24,6 @@ M: windows-nt-io FileArgs-overlapped ( port -- overlapped )
     swap buffer-consume ;
 
 : (flush-output) ( port -- )
-    dup touch-port
     dup make-FileArgs
     tuck setup-write WriteFile
     dupd overlapped-error? [
@@ -37,7 +36,7 @@ M: windows-nt-io FileArgs-overlapped ( port -- overlapped )
     ] if ;
 
 : flush-output ( port -- )
-    [ (flush-output) ] with-destructors ;
+    [ [ (flush-output) ] with-port-timeout ] with-destructors ;
 
 M: port port-flush
     dup buffer-empty? [ dup flush-output ] unless drop ;
@@ -52,17 +51,13 @@ M: port port-flush
     ] if ;
 
 : ((wait-to-read)) ( port -- )
-    dup touch-port
     dup make-FileArgs
     tuck setup-read ReadFile
     dupd overlapped-error? [
         >r FileArgs-lpOverlapped r>
         [ save-callback ] 2keep
         finish-read
-    ] [
+    ] [ 2drop ] if ;
-        2drop
-    ] if ;
 
 M: input-port (wait-to-read) ( port -- )
-    [ ((wait-to-read)) ] with-destructors ;
+    [ [ ((wait-to-read)) ] with-port-timeout ] with-destructors ;
-

extra/io/windows/nt/monitor/monitor.factor

@@ -4,7 +4,7 @@ USING: alien.c-types destructors io.windows
 io.windows.nt.backend kernel math windows windows.kernel32
 windows.types libc assocs alien namespaces continuations
 io.monitor io.nonblocking io.buffers io.files io sequences
-hashtables sorting arrays ;
+hashtables sorting arrays combinators ;
 IN: io.windows.nt.monitor
 
 TUPLE: monitor path recursive? queue closed? ;
@@ -46,29 +46,24 @@ M: windows-nt-io <monitor> ( path recursive? -- monitor )
 
 : read-changes ( monitor -- bytes )
     [
-        dup begin-reading-changes swap [ save-callback ] 2keep
+        [
+            dup begin-reading-changes
+            swap [ save-callback ] 2keep
             get-overlapped-result
+        ] with-port-timeout
     ] with-destructors ;
 
-: parse-action-flag ( action mask symbol -- action )
+: parse-action ( action -- changed )
-    >r over bitand 0 > [ r> , ] [ r> drop ] if ;
+    {
+        { [ dup FILE_ACTION_ADDED = ] [ +add-file+ ] }
+        { [ dup FILE_ACTION_REMOVED = ] [ +remove-file+ ] }
+        { [ dup FILE_ACTION_MODIFIED = ] [ +modify-file+ ] }
+        { [ dup FILE_ACTION_RENAMED_OLD_NAME = ] [ +rename-file+ ] }
+        { [ dup FILE_ACTION_RENAMED_NEW_NAME = ] [ +rename-file+ ] }
+        { [ t ] [ +modify-file+ ] }
+    } cond nip ;
 
-: parse-action ( action -- changes )
+: changed-file ( directory buffer -- changed path )
-    [
-        FILE_NOTIFY_CHANGE_FILE +change-file+ parse-action-flag
-        FILE_NOTIFY_CHANGE_DIR_NAME +change-name+ parse-action-flag
-        FILE_NOTIFY_CHANGE_ATTRIBUTES +change-attributes+ parse-action-flag
-        FILE_NOTIFY_CHANGE_SIZE +change-size+ parse-action-flag
-        FILE_NOTIFY_CHANGE_LAST_WRITE +change-modified+ parse-action-flag
-        FILE_NOTIFY_CHANGE_LAST_ACCESS +change-attributes+ parse-action-flag
-        FILE_NOTIFY_CHANGE_EA +change-attributes+ parse-action-flag
-        FILE_NOTIFY_CHANGE_CREATION +change-attributes+ parse-action-flag
-        FILE_NOTIFY_CHANGE_SECURITY +change-attributes+ parse-action-flag
-        FILE_NOTIFY_CHANGE_FILE_NAME +change-name+ parse-action-flag
-        drop
-    ] { } make ;
-
-: changed-file ( directory buffer -- changes path )
     {
         FILE_NOTIFY_INFORMATION-FileName
         FILE_NOTIFY_INFORMATION-FileNameLength
@@ -76,7 +71,7 @@ M: windows-nt-io <monitor> ( path recursive? -- monitor )
     } get-slots >r memory>u16-string path+ r> parse-action swap ;
 
 : (changed-files) ( directory buffer -- )
-    2dup changed-file namespace [ append ] change-at
+    2dup changed-file namespace [ swap add ] change-at
     dup FILE_NOTIFY_INFORMATION-NextEntryOffset dup zero?
     [ 3drop ] [ swap <displaced-alien> (changed-files) ] if ;
 

extra/io/windows/nt/sockets/sockets.factor

@@ -1,7 +1,8 @@
-USING: alien alien.c-types byte-arrays continuations destructors
+USING: alien alien.accessors alien.c-types byte-arrays
-io.nonblocking io io.sockets io.sockets.impl namespaces
+continuations destructors io.nonblocking io io.sockets
-io.streams.duplex io.windows io.windows.nt.backend
+io.sockets.impl namespaces io.streams.duplex io.windows
-windows.winsock kernel libc math sequences threads tuples.lib ;
+io.windows.nt.backend windows.winsock kernel libc math sequences
+threads tuples.lib ;
 IN: io.windows.nt.sockets
 
 : malloc-int ( object -- object )
@@ -128,9 +129,9 @@ TUPLE: AcceptEx-args port
     <client-stream> ;
 
 M: windows-nt-io accept ( server -- client )
+    [
         [
             dup check-server-port
-        dup touch-port
             \ AcceptEx-args construct-empty
             [ init-accept ] keep
             [ (accept) ] keep
@@ -138,6 +139,7 @@ M: windows-nt-io accept ( server -- client )
             AcceptEx-args-port pending-error
             dup duplex-stream-in pending-error
             dup duplex-stream-out pending-error
+        ] with-port-timeout
     ] with-destructors ;
 
 M: windows-nt-io <server> ( addrspec -- server )

extra/line-art/line-art.factor

@@ -1,6 +1,6 @@
 USING: arrays bunny combinators.lib continuations io io.files kernel
        math math.functions math.vectors multiline
-       namespaces
+       namespaces debugger
        opengl opengl.gl opengl-demo-support
        prettyprint
        sequences ui ui.gadgets ui.gestures ui.render ;
@@ -187,7 +187,7 @@ main()
     ] if ;
     
 M: line-art-gadget graft* ( gadget -- )
-    "2.0" { "GL_ARB_draw_buffers"
+    [ "2.0" { "GL_ARB_draw_buffers"
             "GL_ARB_shader_objects"
             "GL_ARB_multitexture"
             "GL_ARB_texture_float" }
@@ -196,16 +196,17 @@ M: line-art-gadget graft* ( gadget -- )
     GL_CULL_FACE glEnable
     GL_DEPTH_TEST glEnable
     (line-art-step1-program) over set-line-art-gadget-step1-program
-    (line-art-step2-program) swap set-line-art-gadget-step2-program ;
+    (line-art-step2-program) swap set-line-art-gadget-step2-program
+    ] [ ] [ :c ] cleanup ;
 
 M: line-art-gadget ungraft* ( gadget -- )
     dup line-art-gadget-framebuffer [
-        { [ line-art-gadget-step1-program delete-gl-program ]
+        { [ line-art-gadget-step1-program [ delete-gl-program ] when* ]
-          [ line-art-gadget-step2-program delete-gl-program ]
+          [ line-art-gadget-step2-program [ delete-gl-program ] when* ]
-          [ line-art-gadget-framebuffer delete-framebuffer ]
+          [ line-art-gadget-framebuffer [ delete-framebuffer ] when* ]
-          [ line-art-gadget-color-texture delete-texture ]
+          [ line-art-gadget-color-texture [ delete-texture ] when* ]
-          [ line-art-gadget-normal-texture delete-texture ]
+          [ line-art-gadget-normal-texture [ delete-texture ] when* ]
-          [ line-art-gadget-depth-texture delete-texture ]
+          [ line-art-gadget-depth-texture [ delete-texture ] when* ]
           [ f swap set-line-art-gadget-framebuffer-dim ]
           [ f swap set-line-art-gadget-framebuffer ] } call-with
     ] [ drop ] if ;

extra/multiline/tags.txt

@@ -0,0 +1 @@
+reflection

extra/opengl/tags.txt

@@ -1 +1,4 @@
+opengl.glu
+opengl.gl
+opengl
 bindings

extra/pack/pack-tests.factor

@@ -43,5 +43,5 @@ USING: io io.streams.string kernel namespaces pack strings tools.test ;
 
 [ "FRAM" ] [ "FRAM\0" [ read-c-string ] string-in ] unit-test
 [ f ] [ "" [ read-c-string ] string-in ] unit-test
-[ 5 ] [ "FRAM\0\u0005\0\0\0\0\0\0\0" [ read-c-string drop read-u64 ] string-in ] unit-test
+[ 5 ] [ "FRAM\0\u000005\0\0\0\0\0\0\0" [ read-c-string drop read-u64 ] string-in ] unit-test
 

extra/parser-combinators/parser-combinators-tests.factor

@@ -1,8 +1,7 @@
 ! Copyright (C) 2005 Chris Double.
 ! See http://factorcode.org/license.txt for BSD license.
-!
 USING: kernel lazy-lists tools.test strings math
-sequences parser-combinators arrays math.parser ;
+sequences parser-combinators arrays math.parser unicode.categories ;
 IN: scratchpad
 
 ! Testing <&>

extra/parser-combinators/parser-combinators.factor

@@ -1,7 +1,8 @@
 ! Copyright (C) 2004 Chris Double.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: lazy-lists promises kernel sequences strings math
-arrays splitting quotations combinators namespaces ;
+arrays splitting quotations combinators namespaces
+unicode.case unicode.categories ;
 IN: parser-combinators
 
 ! Parser combinator protocol

extra/parser-combinators/simple/tags.txt

@@ -0,0 +1 @@
+parsing

extra/parser-combinators/tags.txt

@@ -0,0 +1 @@
+parsing

extra/peg/tags.txt

@@ -1 +1,2 @@
+text
 parsing

extra/prolog/tags.txt

@@ -1 +1 @@
-prolog
+languages

extra/regexp/regexp-tests.factor

@@ -158,8 +158,8 @@ IN: regexp-tests
 [ t ] [ "SXY" "\\0123XY" f <regexp> matches? ] unit-test
 [ t ] [ "x" "\\x78" f <regexp> matches? ] unit-test
 [ f ] [ "y" "\\x78" f <regexp> matches? ] unit-test
-[ t ] [ "x" "\\u0078" f <regexp> matches? ] unit-test
+[ t ] [ "x" "\\u000078" f <regexp> matches? ] unit-test
-[ f ] [ "y" "\\u0078" f <regexp> matches? ] unit-test
+[ f ] [ "y" "\\u000078" f <regexp> matches? ] unit-test
 
 [ t ] [ "ab" "a+b" f <regexp> matches? ] unit-test
 [ f ] [ "b" "a+b" f <regexp> matches? ] unit-test

extra/regexp/tags.txt

@@ -0,0 +1,2 @@
+parsing
+text

extra/slides/slides.factor

@@ -33,7 +33,7 @@ IN: slides
         { list-style
             H{ { table-gap { 10 20 } } }
         }
-        { bullet "\u00b7" }
+        { bullet "\u0000b7" }
     } ;
 
 : $title ( string -- )

extra/tar/tar.factor

@@ -1,7 +1,6 @@
-USING: combinators io io.files io.streams.duplex
+USING: combinators io io.files io.streams.duplex continuations
 io.streams.string kernel math math.parser
-namespaces pack prettyprint sequences strings system ;
+namespaces pack prettyprint sequences strings system hexdump ;
-USING: hexdump tools.interpreter ;
 IN: tar
 
 : zero-checksum 256 ;

extra/tools/completion/completion.factor

@@ -1,8 +1,9 @@
-! Copyright (C) 2005, 2007 Slava Pestov.
+! Copyright (C) 2005, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 IN: tools.completion
 USING: kernel arrays sequences math namespaces strings io
-vectors words assocs combinators sorting ;
+vectors words assocs combinators sorting unicode.case
+unicode.categories ;
 
 : (fuzzy) ( accum ch i full -- accum i ? )
     index* 

extra/tuple-syntax/tags.txt

@@ -1 +1 @@
-syntax
+reflection

extra/ui/commands/commands.factor

@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: arrays definitions kernel sequences strings math assocs
 words generic namespaces assocs quotations splitting
-ui.gestures ;
+ui.gestures unicode.case unicode.categories ;
 IN: ui.commands
 
 SYMBOL: +nullary+
@@ -51,7 +51,7 @@ GENERIC: command-word ( command -- word )
     update-gestures ;
 
 : (command-name) ( string -- newstring )
-    "-" split " " join unclip ch>upper add* ;
+    "-" split " " join >title ;
 
 M: word command-name ( word -- str )
     word-name

extra/ui/freetype/freetype.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2005, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: alien alien.c-types arrays io kernel libc math
+USING: alien alien.accessors alien.c-types arrays io kernel libc
-math.vectors namespaces opengl opengl.gl prettyprint assocs
+math math.vectors namespaces opengl opengl.gl prettyprint assocs
 sequences io.files io.styles continuations freetype
 ui.gadgets.worlds ui.render ui.backend byte-arrays ;
 IN: ui.freetype

extra/ui/gadgets/buttons/buttons-tests.factor

@@ -17,7 +17,7 @@ TUPLE: foo-gadget ;
 T{ foo-gadget } <toolbar> "t" set
 
 [ 2 ] [ "t" get gadget-children length ] unit-test
-[ "Foo a" ] [ "t" get gadget-child gadget-child label-string ] unit-test
+[ "Foo A" ] [ "t" get gadget-child gadget-child label-string ] unit-test
 
 [ ] [
     2 <model> {

extra/ui/tools/search/search.factor

@@ -7,7 +7,7 @@ source-files strings tools.completion tools.crossref tuples
 ui.commands ui.gadgets ui.gadgets.editors
 ui.gadgets.lists ui.gadgets.scrollers ui.gadgets.tracks
 ui.gestures ui.operations vocabs words vocabs.loader
-tools.browser ;
+tools.browser unicode.case ;
 IN: ui.tools.search
 
 TUPLE: live-search field list ;

extra/ui/ui.factor

@@ -120,7 +120,9 @@ SYMBOL: ui-hook
     [ dup update-hand draw-world ] each ;
 
 : notify ( gadget -- )
-    dup gadget-graft-state dup first { f f } { t t } ? pick set-gadget-graft-state {
+    dup gadget-graft-state
+    dup first { f f } { t t } ?
+    pick set-gadget-graft-state {
         { { f t } [ dup activate-control graft* ] }
         { { t f } [ dup deactivate-control ungraft* ] }
     } case ;

extra/ui/windows/windows.factor

@@ -6,7 +6,7 @@ math math.vectors namespaces prettyprint sequences strings
 vectors words windows.kernel32 windows.gdi32 windows.user32
 windows.opengl32 windows.messages windows.types
 windows.nt windows threads timers libc combinators continuations
-command-line shuffle opengl ui.render ;
+command-line shuffle opengl ui.render unicode.case ascii ;
 IN: ui.windows
 
 TUPLE: windows-ui-backend ;
@@ -140,7 +140,10 @@ SYMBOL: mouse-captured
 : ctrl? ( -- ? ) left-ctrl? right-ctrl? or ;
 : alt? ( -- ? ) left-alt? right-alt? or ;
 : caps-lock? ( -- ? ) VK_CAPITAL GetKeyState zero? not ;
-: switch-case ( seq -- seq ) dup first CHAR: a >= [ >upper ] [ >lower ] if ;
+
+: switch-case ( seq -- seq )
+    dup first CHAR: a >= [ >upper ] [ >lower ] if ;
+
 : switch-case? ( -- ? ) shift? caps-lock? xor not ;
 
 : key-modifiers ( -- seq )

extra/unicode/breaks/breaks-tests.factor

@@ -1,7 +1,7 @@
 USING: tools.test unicode.breaks sequences math kernel ;
 
-[ "\u1112\u1161\u11abA\u0300a\r\r\n" ]
+[ "\u001112\u001161\u0011abA\u000300a\r\r\n" ]
-[ "\r\n\raA\u0300\u1112\u1161\u11ab" string-reverse ] unit-test
+[ "\r\n\raA\u000300\u001112\u001161\u0011ab" string-reverse ] unit-test
 [ "dcba" ] [ "abcd" string-reverse ] unit-test
-[ 3 ] [ "\u1112\u1161\u11abA\u0300a"
+[ 3 ] [ "\u001112\u001161\u0011abA\u000300a"
         dup last-grapheme head last-grapheme ] unit-test

extra/unicode/breaks/tags.txt

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

extra/unicode/case/case-tests.factor

@@ -1,14 +1,14 @@
 USING: unicode.case tools.test namespaces ;
 
 [ "Hello How Are You? I'M Good" ] [ "hEllo how ARE yOU? I'm good" >title ] unit-test
-[ "FUSS" ] [ "Fu\u00DF" >upper ] unit-test
+[ "FUSS" ] [ "Fu\u0000DF" >upper ] unit-test
-[ "\u03C3\u03C2" ] [ "\u03A3\u03A3" >lower ] unit-test
+[ "\u0003C3\u0003C2" ] [ "\u0003A3\u0003A3" >lower ] unit-test
 [ t ] [ "hello how are you?" lower? ] unit-test
 [
     "tr" locale set
-    [ "i\u0131i \u0131jj" ] [ "i\u0131I\u0307 IJj" >lower ] unit-test
+    [ "i\u000131i \u000131jj" ] [ "i\u000131I\u000307 IJj" >lower ] unit-test
-!    [ "I\u307\u0131i Ijj" ] [ "i\u0131I\u0307 IJj" >title ] unit-test
+!    [ "I\u00307\u000131i Ijj" ] [ "i\u000131I\u000307 IJj" >title ] unit-test
-    [ "I\u0307II\u0307 IJJ" ] [ "i\u0131I\u0307 IJj" >upper ] unit-test
+    [ "I\u000307II\u000307 IJJ" ] [ "i\u000131I\u000307 IJj" >upper ] unit-test
     "lt" locale set
     ! Lithuanian casing tests
 ] with-scope

extra/unicode/case/case.factor

@@ -13,7 +13,7 @@ SYMBOL: locale ! Just casing locale, or overall?
 
 : lithuanian? ( -- ? ) locale get "lt" = ;
 
-: dot-over ( -- ch ) CHAR: \u0307 ;
+: dot-over ( -- ch ) HEX: 307 ;
 
 : lithuanian-ch>upper ( ? next ch -- ? )
     rot [ 2drop f ]
@@ -46,7 +46,7 @@ SYMBOL: locale ! Just casing locale, or overall?
         { [ rot ] [ 2drop f ] }
         { [ dup CHAR: I = ] [
             drop dot-over =
-            dup CHAR: i CHAR: \u0131 ? ,
+            dup CHAR: i HEX: 131 ? ,
         ] }
         { [ t ] [ , drop f ] }
     } cond ;

extra/unicode/case/tags.txt

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

extra/unicode/categories/tags.txt

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