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

Conflicts:

	extra/http/http.factor

core/parser/parser.factor

@@ -347,45 +347,49 @@ SYMBOL: bootstrap-syntax
         call
     ] with-scope ; inline
 
+SYMBOL: interactive-vocabs
+
+{
+    "arrays"
+    "assocs"
+    "combinators"
+    "compiler.errors"
+    "continuations"
+    "debugger"
+    "definitions"
+    "editors"
+    "generic"
+    "help"
+    "inspector"
+    "io"
+    "io.files"
+    "kernel"
+    "listener"
+    "math"
+    "memory"
+    "namespaces"
+    "prettyprint"
+    "sequences"
+    "slicing"
+    "sorting"
+    "strings"
+    "syntax"
+    "tools.annotations"
+    "tools.crossref"
+    "tools.memory"
+    "tools.profiler"
+    "tools.test"
+    "tools.time"
+    "vocabs"
+    "vocabs.loader"
+    "words"
+    "scratchpad"
+} interactive-vocabs set-global
+
 : with-interactive-vocabs ( quot -- )
     [
         "scratchpad" in set
-        {
-            "arrays"
-            "assocs"
-            "combinators"
-            "compiler.errors"
-            "continuations"
-            "debugger"
-            "definitions"
-            "editors"
-            "generic"
-            "help"
-            "inspector"
-            "io"
-            "io.files"
-            "kernel"
-            "listener"
-            "math"
-            "memory"
-            "namespaces"
-            "prettyprint"
-            "sequences"
-            "slicing"
-            "sorting"
-            "strings"
-            "syntax"
-            "tools.annotations"
-            "tools.crossref"
-            "tools.memory"
-            "tools.profiler"
-            "tools.test"
-            "tools.time"
-            "vocabs"
-            "vocabs.loader"
-            "words"
-            "scratchpad"
-        } set-use
+	interactive-vocabs get set-use
         call
     ] with-scope ; inline
 

core/strings/strings-tests.factor

@@ -51,6 +51,9 @@ unit-test
 [ "ab" ] [ 2 "abc" resize-string ] unit-test
 [ "abc\0\0\0" ] [ 6 "abc" resize-string ] unit-test
 
+[ "\u001234b" ] [ 2 "\u001234bc" resize-string ] unit-test
+[ "\u001234bc\0\0\0" ] [ 6 "\u001234bc" resize-string ] unit-test
+
 ! Random tester found this
 [ { "kernel-error" 3 12 -7 } ]
 [ [ 2 -7 resize-string ] catch ] unit-test
@@ -88,3 +91,5 @@ unit-test
 	"\udeadbe" clone
 	CHAR: \u123456 over clone set-first
 ] unit-test
+
+

extra/benchmark/knucleotide/knucleotide.factor

@@ -1,6 +1,6 @@
 USING: kernel io io.files splitting strings
        hashtables sequences assocs math namespaces prettyprint
-       math.parser combinators arrays sorting ;
+       math.parser combinators arrays sorting unicode.case ;
 
 IN: benchmark.knucleotide
 

extra/benchmark/reverse-complement/reverse-complement.factor

@@ -1,6 +1,6 @@
 USING: io io.files io.streams.duplex kernel sequences
 sequences.private strings vectors words memoize splitting
-hints ;
+hints unicode.case ;
 IN: benchmark.reverse-complement
 
 MEMO: trans-map ( -- str )

extra/builder/builder.factor

@@ -1,5 +1,5 @@
 
-USING: kernel io io.files io.launcher
+USING: kernel io io.files io.launcher tools.deploy.backend
        system namespaces sequences splitting math.parser
        unix prettyprint tools.time calendar bake vars ;
 
@@ -31,8 +31,6 @@ SYMBOL: builder-recipients
   
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
-: boot-image ( -- filename ) `{ "boot" ,[ cpu ] "image" } "." join ;
-
 : target ( -- target ) `{ ,[ os ] %[ cpu "." split ] } "-" join ;
 
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@@ -61,7 +59,7 @@ if
 
 "factor" cd
 
-{ "/usr/bin/git" "show" } <process-stream>
+{ "git" "show" } <process-stream>
 [ readln ] with-stream
 " " split second
 "../git-id" <file-writer> [ print ] with-stream
@@ -76,7 +74,7 @@ if
   "builder: vm compile" throw
 ] if
 
-"wget http://factorcode.org/images/latest/" boot-image append system
+"wget http://factorcode.org/images/latest/" boot-image-name append system
 0 =
 [ ]
 [
@@ -84,7 +82,11 @@ if
   "builder: image download" throw
 ] if
 
-[ "./factor -i=" boot-image " -no-user-init > ../boot-log" 3append system ]
+[
+  "./factor -i=" boot-image-name " -no-user-init > ../boot-log"
+  3append
+  system
+]
 benchmark nip
 "../boot-time" <file-writer> [ . ] with-stream
 0 =

extra/cryptlib/cryptlib.factor

@@ -6,7 +6,7 @@
 ! Adapted from cryptlib.h
 ! Tested with cryptlib 3.3.1.0
 USING: cryptlib.libcl kernel hashtables alien math 
-namespaces sequences assocs libc alien.c-types continuations ;
+namespaces sequences assocs libc alien.c-types alien.accessors continuations ;
 
 IN: cryptlib
 

extra/cryptlib/streams/streams.factor

@@ -3,7 +3,7 @@
 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 ;
+alien.c-types continuations ;
 
 IN: cryptlib.streams
 
@@ -154,4 +154,4 @@ M: crypt-stream dispose ( stream -- )
     
     dispose 
     end 
-    ;
+    ;

extra/fjsc/fjsc.factor

@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel peg strings promises sequences math math.parser
        namespaces words quotations arrays hashtables io
-       io.streams.string assocs memoize ;
+       io.streams.string assocs memoize ascii ;
 IN: fjsc
 
 TUPLE: ast-number value ;

extra/globs/globs.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2007 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: parser-combinators regexp lazy-lists sequences kernel
-promises strings ;
+promises strings unicode.case ;
 IN: globs
 
 <PRIVATE

extra/hexdump/hexdump.factor

@@ -1,6 +1,6 @@
 USING: arrays combinators.lib io io.streams.string
-kernel math math.parser namespaces prettyprint
-sequences splitting strings ;
+       kernel math math.parser namespaces prettyprint
+       sequences splitting strings ascii ;
 IN: hexdump
 
 <PRIVATE

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 xml.entities compiler.units effects ;
+sequences strings words xml.entities compiler.units effects ;
 
 IN: html.elements
 

extra/html/html.factor

@@ -3,7 +3,7 @@
 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 xml.entities sbufs ;
+xml.entities sbufs continuations ;
 IN: html
 
 GENERIC: browser-link-href ( presented -- href )

extra/http/http-tests.factor

@@ -14,3 +14,5 @@ IN: temporary
 [ "hello world"   ] [ "hello world%x"  url-decode ] unit-test
 [ "hello%20world" ] [ "hello world"    url-encode ] unit-test
 [ "%20%21%20"     ] [ " ! "            url-encode ] unit-test
+
+[ "\u001234hi\u002045" ] [ "\u001234hi\u002045" url-encode url-decode ] unit-test

extra/http/http.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2003, 2007 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: hashtables io kernel math namespaces math.parser assocs
-sequences strings splitting assocs.lib ;
+sequences strings splitting ascii io.utf8 assocs.lib ;
 IN: http
 
 : header-line ( line -- )
@@ -20,18 +20,15 @@ IN: http
     dup letter?
     over LETTER? or
     over digit? or
-    swap "/_-?." member? or ; foldable
+    swap "/_-." member? or ; foldable
+
+: push-utf8 ( string -- )
+    1string encode-utf8 [ CHAR: % , >hex 2 CHAR: 0 pad-left % ] each ;
 
 : url-encode ( str -- str )
-    [
-        [
-            dup url-quotable? [
-                ,
-            ] [
-                CHAR: % , >hex 2 CHAR: 0 pad-left %
-            ] if
-        ] each
-    ] "" make ;
+    [ [
+        dup url-quotable? [ , ] [ push-utf8 ] if
+    ] each ] "" make ;
 
 : url-decode-hex ( index str -- )
     2dup length 2 - >= [
@@ -58,7 +55,7 @@ IN: http
     ] if ;
 
 : url-decode ( str -- str )
-    [ 0 swap url-decode-iter ] "" make ;
+    [ 0 swap url-decode-iter ] "" make decode-utf8 ;
 
 : hash>query ( hash -- str )
     [ [ url-encode ] 2apply "=" swap 3append ] { } assoc>map

extra/http/server/templating/templating.factor

@@ -25,7 +25,7 @@ M: template-lexer skip-word
         {
             { [ 2dup nth CHAR: " = ] [ drop 1+ ] }
             { [ 2dup swap tail-slice "%>" head? ] [ drop 2 + ] }
-            { [ t ] [ [ blank? ] skip ] }
+            { [ t ] [ f skip ] }
         } cond
     ] change-column ;
 

extra/id3/id3.factor

@@ -4,7 +4,7 @@
 
 USING: arrays combinators io io.binary io.files io.paths
 io.utf16 kernel math math.parser namespaces sequences
-splitting strings assocs ;
+splitting strings assocs unicode.categories ;
 
 IN: id3
 

extra/io/server/server.factor

@@ -29,7 +29,7 @@ SYMBOL: log-stream
 
 : with-log-file ( file quot -- )
     >r <file-appender> r>
-    [ with-log-stream ] with-disposal ; inline
+    [ with-log-stream ] curry with-disposal ; inline
 
 : with-log-stdio ( quot -- )
     stdio get swap with-log-stream ;
@@ -47,11 +47,11 @@ SYMBOL: log-stream
     dup log-client
     [ swap with-stream ] 2curry concurrency:spawn drop ; inline
 
-: accept-loop ( server quot -- server quot )
+: accept-loop ( server quot -- )
     [ swap accept with-client ] 2keep accept-loop ; inline
 
 : server-loop ( server quot -- )
-    [ accept-loop ] compose with-disposal ; inline
+    [ accept-loop ] curry with-disposal ; inline
 
 : spawn-server ( addrspec quot -- )
     "Waiting for connections on " pick unparse append

extra/io/sniffer/bsd/bsd.factor

@@ -7,7 +7,7 @@ sequences io.sniffer.backend ;
 QUALIFIED: unix
 IN: io.sniffer.bsd
 
-M: unix-io destruct-handle ( obj -- ) close drop ;
+M: unix-io destruct-handle ( obj -- ) unix:close drop ;
 
 C-UNION: ifreq_props "sockaddr-in" "short" "int" "caddr_t" ;
 C-STRUCT: ifreq { { "char" 16 } "name" } { "ifreq_props" "props" } ;

extra/irc/irc.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2007 Doug Coleman, Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: arrays calendar io io.sockets kernel match namespaces
-sequences splitting strings continuations threads ;
+sequences splitting strings continuations threads ascii ;
 IN: irc
 
 ! "setup" objects

extra/json/reader/reader.factor

@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel parser-combinators namespaces sequences promises strings 
        assocs math math.parser math.vectors math.functions
-       lazy-lists hashtables ;
+       lazy-lists hashtables ascii ;
 IN: json.reader
 
 ! Grammar for JSON from RFC 4627

extra/lint/lint.factor

@@ -1,9 +1,8 @@
 ! Copyright (C) 2007 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: alien arrays assocs combinators.lib io kernel
+USING: alien alien.accessors arrays assocs combinators.lib io kernel
 macros math namespaces prettyprint quotations sequences
-vectors vocabs words ;
-USING: html.elements slots.private tar ;
+vectors vocabs words html.elements slots.private tar ;
 IN: lint
 
 SYMBOL: def-hash

extra/parser-combinators/simple/simple.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2006 Chris Double.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel strings math sequences lazy-lists words
-math.parser promises parser-combinators ;
+math.parser promises parser-combinators unicode.categories ;
 IN: parser-combinators.simple
 
 : 'digit' ( -- parser )

extra/peg/ebnf/ebnf.factor

@@ -1,7 +1,8 @@
 ! Copyright (C) 2007 Chris Double.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel parser words arrays strings math.parser sequences 
-       quotations vectors namespaces math assocs continuations peg ;
+       quotations vectors namespaces math assocs continuations peg
+       unicode.categories ;
 IN: peg.ebnf
 
 TUPLE: ebnf-non-terminal symbol ;

extra/peg/peg.factor

@@ -1,7 +1,8 @@
 ! Copyright (C) 2007 Chris Double.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel sequences strings namespaces math assocs shuffle 
-       vectors arrays combinators.lib memoize math.parser match ;
+       vectors arrays combinators.lib memoize math.parser match
+       unicode.categories ;
 IN: peg
 
 TUPLE: parse-result remaining ast ;

extra/project-euler/017/017.factor

@@ -1,6 +1,7 @@
 ! Copyright (c) 2007 Aaron Schaefer.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: combinators.lib kernel math.ranges math.text.english sequences strings ;
+USING: combinators.lib kernel math.ranges math.text.english sequences strings
+       ascii ;
 IN: project-euler.017
 
 ! http://projecteuler.net/index.php?section=problems&id=17

extra/project-euler/022/022.factor

@@ -1,7 +1,7 @@
 ! Copyright (c) 2007 Aaron Schaefer.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: io.files kernel math math.parser namespaces sequences sorting splitting
-    strings system vocabs ;
+    strings system vocabs ascii ;
 IN: project-euler.022
 
 ! http://projecteuler.net/index.php?section=problems&id=22

extra/prolog/prolog.factor

@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 
 USING: kernel sequences arrays vectors namespaces math strings
-    combinators continuations quotations io assocs ;
+    combinators continuations quotations io assocs ascii ;
 
 IN: prolog
 

extra/regexp/regexp.factor

@@ -1,7 +1,7 @@
 USING: arrays combinators kernel lazy-lists math math.parser
 namespaces parser parser-combinators parser-combinators.simple
 promises quotations sequences combinators.lib strings
-assocs prettyprint.backend memoize ;
+assocs prettyprint.backend memoize unicode.case unicode.categories ;
 USE: io
 IN: regexp
 

extra/roman/roman.factor

@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 
 USING: arrays assocs kernel math math.vectors namespaces
-quotations sequences sequences.lib sequences.private strings ;
+quotations sequences sequences.lib sequences.private strings unicode.case ;
 IN: roman
 
 <PRIVATE

extra/rot13/rot13.factor

@@ -1,6 +1,6 @@
 ! Copyright (C) 2006 Daniel Ehrenberg
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel math sequences strings io combinators ;
+USING: kernel math sequences strings io combinators ascii ;
 IN: rot13
 
 : rotate ( ch base -- ch ) tuck - 13 + 26 mod + ;

extra/sequences/lib/lib.factor

@@ -1,6 +1,6 @@
 USING: combinators.lib kernel sequences math namespaces assocs 
-random sequences.private shuffle math.functions mirrors ;
-USING: arrays math.parser sorting strings ;
+random sequences.private shuffle math.functions mirrors
+arrays math.parser sorting strings ascii ;
 IN: sequences.lib
 
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

extra/state-parser/state-parser.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2005, 2006 Daniel Ehrenberg
 ! See http://factorcode.org/license.txt for BSD license.
 USING: io io.streams.string kernel math namespaces sequences
-strings circular prettyprint debugger ;
+strings circular prettyprint debugger unicode.categories ;
 IN: state-parser
 
 ! * Basic underlying words

extra/strings/lib/lib.factor

@@ -1,14 +1,14 @@
 USING: math arrays sequences kernel splitting strings ;
 IN: strings.lib
 
-: char>digit ( c -- i ) 48 - ;
+! : char>digit ( c -- i ) 48 - ;
 
-: string>digits ( s -- seq ) [ char>digit ] { } map-as ;
+! : string>digits ( s -- seq ) [ char>digit ] { } map-as ;
 
-: >Upper ( str -- str )
-    dup empty? [
-        unclip ch>upper 1string swap append
-    ] unless ;
+! : >Upper ( str -- str )
+!     dup empty? [
+!         unclip ch>upper 1string swap append
+!     ] unless ;
 
-: >Upper-dashes ( str -- str )
-    "-" split [ >Upper ] map "-" join ;
+! : >Upper-dashes ( str -- str )
+!     "-" split [ >Upper ] map "-" join ;

extra/tar/tar.factor

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

extra/unicode/case/case.factor

@@ -1,5 +1,6 @@
-USING: kernel unicode.data sequences sequences.next namespaces assocs.lib
-unicode.normalize math unicode.categories combinators assocs ;
+USING: kernel unicode.data sequences sequences.next namespaces
+assocs.lib unicode.normalize math unicode.categories combinators
+assocs ;
 IN: unicode.case
 
 : ch>lower ( ch -- lower ) simple-lower at-default ;
@@ -20,7 +21,7 @@ SYMBOL: locale ! Just casing locale, or overall?
     [ swap dot-over = over "ij" member? and swap , ] if ;
 
 : lithuanian>upper ( string -- lower )
-    [ f swap [ lithuanian-ch>upper ] each-next drop ] "" make* ;
+    [ f swap [ lithuanian-ch>upper ] each-next drop ] "" make ;
 
 : mark-above? ( ch -- ? )
     combining-class 230 = ;
@@ -32,14 +33,14 @@ SYMBOL: locale ! Just casing locale, or overall?
     dup , "IJ" member? swap mark-above? and [ dot-over , ] when ;
 
 : lithuanian>lower ( string -- lower )
-    [ [ lithuanian-ch>lower ] each-next ] "" make* ;
+    [ [ lithuanian-ch>lower ] each-next ] "" make ;
 
 : turk-ch>upper ( ch -- )
     dup CHAR: i = 
     [ drop CHAR: I , dot-over , ] [ , ] if ;
 
 : turk>upper ( string -- upper-i )
-    [ [ turk-ch>upper ] each ] "" make* ;
+    [ [ turk-ch>upper ] each ] "" make ;
 
 : turk-ch>lower ( ? next ch -- ? )
     {
@@ -52,7 +53,7 @@ SYMBOL: locale ! Just casing locale, or overall?
     } cond ;
 
 : turk>lower ( string -- lower-i )
-    [ f swap [ turk-ch>lower ] each-next drop ] "" make* ;
+    [ f swap [ turk-ch>lower ] each-next drop ] "" make ;
 
 : word-boundary ( prev char -- new ? )
     dup non-starter? [ drop dup ] when
@@ -76,7 +77,7 @@ SYMBOL: locale ! Just casing locale, or overall?
                 [ -rot nip call , ] ?if
             ] 2keep
         ] each 2drop
-    ] "" make* ; inline
+    ] "" make ; inline
 
 : >lower ( string -- lower )
     i-dot? [ turk>lower ] when

extra/unicode/normalize/normalize.factor

@@ -2,17 +2,6 @@ USING: sequences namespaces unicode.data kernel combinators.lib
 math arrays ;
 IN: unicode.normalize
 
-! Utility word--probably unnecessary
-: make* ( seq quot exemplar -- newseq )
-    ! quot has access to original seq on stack
-    ! this just makes the new-resizable the same length as seq
-    [
-        [
-            pick length swap new-resizable
-            [ building set call ] keep
-        ] keep like
-    ] with-scope ; inline
-
 ! Conjoining Jamo behavior
 
 : hangul-base HEX: ac00 ; inline

extra/webapps/cgi/cgi.factor

@@ -1,8 +1,8 @@
-! Copyright (C) 2007 Slava Pestov.
+! Copyright (C) 2007, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: namespaces kernel assocs io.files combinators
 arrays io.launcher io http.server.responders webapps.file
-sequences strings math.parser ;
+sequences strings math.parser unicode.case ;
 IN: webapps.cgi
 
 SYMBOL: cgi-root
@@ -31,7 +31,7 @@ SYMBOL: cgi-root
 
         "method" get >upper "REQUEST_METHOD" set
         "raw-query" get "QUERY_STRING" set
-	"Cookie" header-param "HTTP_COOKIE" set 
+        "Cookie" header-param "HTTP_COOKIE" set 
 
         "User-Agent" header-param "HTTP_USER_AGENT" set
         "Accept" header-param "HTTP_ACCEPT" set

extra/webapps/pastebin/pastebin.factor

@@ -1,6 +1,6 @@
 USING: calendar furnace furnace.validator io.files kernel
-namespaces sequences http.server.responders html math math.parser rss
-xml.writer xmode.code2html ;
+namespaces sequences http.server.responders html math.parser rss
+xml.writer xmode.code2html math ;
 IN: webapps.pastebin
 
 TUPLE: pastebin pastes ;

extra/wrap/wrap.factor

@@ -12,15 +12,17 @@ SYMBOL: width
 
 : (split-chunk) ( words -- )
     -1 over [ length + 1+ dup width get > ] find drop nip
-    [ cut-slice swap , (split-chunk) ] [ , ] if* ;
+    [ 1 max cut-slice swap , (split-chunk) ] [ , ] if* ;
 
 : split-chunk ( words -- lines )
     [ (split-chunk) ] { } make ;
 
+: join-spaces ( words-seqs -- lines )
+    [ [ " " join ] map ] map concat ;
+
 : broken-lines ( string width -- lines )
     width [
-        line-chunks
-        [ split-chunk [ " " join ] map ] map concat
+        line-chunks [ split-chunk ] map join-spaces
     ] with-variable ;
 
 : line-break ( string width -- newstring )

extra/xml/tokenize/tokenize.factor

@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: xml.errors xml.data xml.utilities xml.char-classes
 xml.entities kernel state-parser kernel namespaces strings math
-math.parser sequences assocs arrays splitting combinators ;
+math.parser sequences assocs arrays splitting combinators unicode.case ;
 IN: xml.tokenize
 
 ! XML namespace processing: ns = namespace

extra/xml/xml.factor

@@ -3,7 +3,7 @@
 USING: io io.streams.string io.files kernel math namespaces
 prettyprint sequences arrays generic strings vectors
 xml.char-classes xml.data xml.errors xml.tokenize xml.writer
-xml.utilities state-parser assocs ;
+xml.utilities state-parser assocs unicode.categories ;
 IN: xml
 
 !   -- Overall parser with data tree

extra/xmode/keyword-map/keyword-map.factor

@@ -1,4 +1,5 @@
-USING: kernel strings assocs sequences hashtables sorting ;
+USING: kernel strings assocs sequences hashtables sorting
+       unicode.case unicode.categories ;
 IN: xmode.keyword-map
 
 ! Based on org.gjt.sp.jedit.syntax.KeywordMap

extra/xmode/marker/marker.factor

@@ -2,7 +2,7 @@ IN: xmode.marker
 USING: kernel namespaces xmode.rules xmode.tokens
 xmode.marker.state xmode.marker.context xmode.utilities
 xmode.catalog sequences math assocs combinators combinators.lib
-strings regexp splitting parser-combinators ;
+strings regexp splitting parser-combinators ascii unicode.case ;
 
 ! Based on org.gjt.sp.jedit.syntax.TokenMarker
 

extra/xmode/rules/rules.factor

@@ -1,5 +1,5 @@
 USING: xmode.tokens xmode.keyword-map kernel
-sequences vectors assocs strings memoize regexp ;
+sequences vectors assocs strings memoize regexp unicode.case ;
 IN: xmode.rules
 
 TUPLE: string-matcher string ignore-case? ;

vm/data_gc.c

@@ -505,7 +505,6 @@ CELL binary_payload_start(CELL pointer)
 	switch(untag_header(get(pointer)))
 	{
 	/* these objects do not refer to other objects at all */
-	case STRING_TYPE:
 	case FLOAT_TYPE:
 	case BYTE_ARRAY_TYPE:
 	case BIT_ARRAY_TYPE:
@@ -522,6 +521,8 @@ CELL binary_payload_start(CELL pointer)
 		return CELLS * 2;
 	case QUOTATION_TYPE:
 		return sizeof(F_QUOTATION) - CELLS * 2;
+	case STRING_TYPE:
+		return sizeof(F_STRING);
 	/* everything else consists entirely of pointers */
 	default:
 		return unaligned_object_size(pointer);

vm/types.c

@@ -431,23 +431,30 @@ CELL string_nth(F_STRING* string, CELL index)
 	}
 }
 
+/* allocates memory */
 void set_string_nth(F_STRING* string, CELL index, CELL value)
 {
 	bput(SREF(string,index),value & 0xff);
 
+	F_BYTE_ARRAY *aux;
+
 	if(string->aux == F)
 	{
 		if(value <= 0xff)
 			return;
 		else
 		{
-			string->aux = tag_object(allot_byte_array(
+			REGISTER_UNTAGGED(string);
+			aux = allot_byte_array(
 				untag_fixnum_fast(string->length)
-				* sizeof(u16)));
+				* sizeof(u16));
+			UNREGISTER_UNTAGGED(string);
+			string->aux = tag_object(aux);
 		}
 	}
+	else
+		aux = untag_object(string->aux);
 
-	F_BYTE_ARRAY *aux = untag_object(string->aux);
 	cput(BREF(aux,index * sizeof(u16)),value >> 8);
 }
 
@@ -463,20 +470,36 @@ F_STRING* allot_string_internal(CELL capacity)
 	string->length = tag_fixnum(capacity);
 	string->hashcode = F;
 	string->aux = F;
+
 	set_string_nth(string,capacity,0);
+
 	return string;
 }
 
+/* allocates memory */
 void fill_string(F_STRING *string, CELL start, CELL capacity, CELL fill)
 {
 	if(fill == 0)
-		memset((void*)SREF(string,start),'\0',capacity - start);
+	{
+		memset((void *)SREF(string,start),'\0',capacity - start);
+
+		if(string->aux != F)
+		{
+			F_BYTE_ARRAY *aux = untag_object(string->aux);
+			memset((void *)BREF(aux,start * sizeof(u16)),'\0',
+				(capacity - start) * sizeof(u16));
+		}
+	}
 	else
 	{
 		CELL i;
 
 		for(i = start; i < capacity; i++)
+		{
+			REGISTER_UNTAGGED(string);
 			set_string_nth(string,i,fill);
+			UNREGISTER_UNTAGGED(string);
+		}
 	}
 }
 
@@ -484,7 +507,9 @@ void fill_string(F_STRING *string, CELL start, CELL capacity, CELL fill)
 F_STRING *allot_string(CELL capacity, CELL fill)
 {
 	F_STRING* string = allot_string_internal(capacity);
+	REGISTER_UNTAGGED(string);
 	fill_string(string,0,capacity,fill);
+	UNREGISTER_UNTAGGED(string);
 	return string;
 }
 
@@ -506,7 +531,23 @@ F_STRING* reallot_string(F_STRING* string, CELL capacity, CELL fill)
 	UNREGISTER_UNTAGGED(string);
 
 	memcpy(new_string + 1,string + 1,to_copy);
+
+	if(string->aux != F)
+	{
+		REGISTER_UNTAGGED(string);
+		REGISTER_UNTAGGED(new_string);
+		F_BYTE_ARRAY *new_aux = allot_byte_array(capacity * sizeof(u16));
+		new_string->aux = tag_object(new_aux);
+		UNREGISTER_UNTAGGED(new_string);
+		UNREGISTER_UNTAGGED(string);
+
+		F_BYTE_ARRAY *aux = untag_object(string->aux);
+		memcpy(new_aux + 1,aux + 1,to_copy * sizeof(u16));
+	}
+
+	REGISTER_UNTAGGED(string);
 	fill_string(new_string,to_copy,capacity,fill);
+	UNREGISTER_UNTAGGED(string);
 
 	return new_string;
 }
@@ -529,7 +570,9 @@ DEFINE_PRIMITIVE(resize_string)
 		CELL i; \
 		for(i = 0; i < length; i++) \
 		{ \
+			REGISTER_UNTAGGED(s); \
 			set_string_nth(s,i,(utype)*string); \
+			UNREGISTER_UNTAGGED(s); \
 			string++; \
 		} \
 		return s; \
@@ -552,6 +595,7 @@ DEFINE_PRIMITIVE(resize_string)
 
 MEMORY_TO_STRING(char,u8)
 MEMORY_TO_STRING(u16,u16)
+MEMORY_TO_STRING(u32,u32)
 
 bool check_string(F_STRING *s, CELL max)
 {

vm/types.h

@@ -83,8 +83,8 @@ INLINE CELL array_capacity(F_ARRAY* array)
 	return array->capacity >> TAG_BITS;
 }
 
-#define BREF(byte_array,index) ((CELL)byte_array + sizeof(F_BYTE_ARRAY) + index)
-#define SREF(string,index) ((CELL)string + sizeof(F_STRING) + index)
+#define BREF(byte_array,index) ((CELL)byte_array + sizeof(F_BYTE_ARRAY) + (index))
+#define SREF(string,index) ((CELL)string + sizeof(F_STRING) + (index))
 
 INLINE F_STRING* untag_string(CELL tagged)
 {