diff --git a/core/parser/parser.factor b/core/parser/parser.factor index 8b6ea57833..2643ea95d9 100755 --- a/core/parser/parser.factor +++ b/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 diff --git a/core/strings/strings-tests.factor b/core/strings/strings-tests.factor index 5ab7f1dffe..459ec7b153 100755 --- a/core/strings/strings-tests.factor +++ b/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 + + diff --git a/extra/benchmark/knucleotide/knucleotide.factor b/extra/benchmark/knucleotide/knucleotide.factor index f036a644ae..ad1ffc1c50 100644 --- a/extra/benchmark/knucleotide/knucleotide.factor +++ b/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 diff --git a/extra/benchmark/reverse-complement/reverse-complement.factor b/extra/benchmark/reverse-complement/reverse-complement.factor index 332489abed..7b09b586f4 100644 --- a/extra/benchmark/reverse-complement/reverse-complement.factor +++ b/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 ) diff --git a/extra/builder/builder.factor b/extra/builder/builder.factor index a2b5dffb4d..a9a4c159f8 100644 --- a/extra/builder/builder.factor +++ b/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" } +{ "git" "show" } [ readln ] with-stream " " split second "../git-id" [ 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" [ . ] with-stream 0 = diff --git a/extra/cryptlib/cryptlib.factor b/extra/cryptlib/cryptlib.factor index 65d2ffe48f..2ba81ef15a 100644 --- a/extra/cryptlib/cryptlib.factor +++ b/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 diff --git a/extra/cryptlib/streams/streams.factor b/extra/cryptlib/streams/streams.factor index 828476d2e2..04106285e0 100755 --- a/extra/cryptlib/streams/streams.factor +++ b/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 - ; \ No newline at end of file + ; diff --git a/extra/fjsc/fjsc.factor b/extra/fjsc/fjsc.factor index fdeed339d8..6beb48e05e 100755 --- a/extra/fjsc/fjsc.factor +++ b/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 ; diff --git a/extra/globs/globs.factor b/extra/globs/globs.factor index 901191b51e..7204693016 100755 --- a/extra/globs/globs.factor +++ b/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 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 diff --git a/extra/http/server/templating/templating.factor b/extra/http/server/templating/templating.factor index 69f8b4e7fd..f5de4664a1 100755 --- a/extra/http/server/templating/templating.factor +++ b/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 ; diff --git a/extra/id3/id3.factor b/extra/id3/id3.factor index 1d76bb0a5b..895efc59dc 100644 --- a/extra/id3/id3.factor +++ b/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 diff --git a/extra/io/server/server.factor b/extra/io/server/server.factor index 6e7cd5a940..408fd29714 100755 --- a/extra/io/server/server.factor +++ b/extra/io/server/server.factor @@ -29,7 +29,7 @@ SYMBOL: log-stream : with-log-file ( file quot -- ) >r 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 diff --git a/extra/io/sniffer/bsd/bsd.factor b/extra/io/sniffer/bsd/bsd.factor index ae87c05d38..66336425a1 100644 --- a/extra/io/sniffer/bsd/bsd.factor +++ b/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" } ; diff --git a/extra/irc/irc.factor b/extra/irc/irc.factor index 74d8951d10..5b4355986f 100755 --- a/extra/irc/irc.factor +++ b/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 diff --git a/extra/json/reader/reader.factor b/extra/json/reader/reader.factor index 0f774103e1..105989ab93 100644 --- a/extra/json/reader/reader.factor +++ b/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 diff --git a/extra/lint/lint.factor b/extra/lint/lint.factor index 44b234b254..a220eece01 100644 --- a/extra/lint/lint.factor +++ b/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 diff --git a/extra/parser-combinators/simple/simple.factor b/extra/parser-combinators/simple/simple.factor index 3b59068dd6..763f823348 100755 --- a/extra/parser-combinators/simple/simple.factor +++ b/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 ) diff --git a/extra/peg/ebnf/ebnf.factor b/extra/peg/ebnf/ebnf.factor index 5343bb513b..02be32d71f 100644 --- a/extra/peg/ebnf/ebnf.factor +++ b/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 ; diff --git a/extra/peg/peg.factor b/extra/peg/peg.factor index 3d9128fec9..41df8735e5 100644 --- a/extra/peg/peg.factor +++ b/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 ; diff --git a/extra/project-euler/017/017.factor b/extra/project-euler/017/017.factor index 296818db07..f87e9937fe 100644 --- a/extra/project-euler/017/017.factor +++ b/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 diff --git a/extra/project-euler/022/022.factor b/extra/project-euler/022/022.factor index b4910e5885..e9b0b5fbcf 100644 --- a/extra/project-euler/022/022.factor +++ b/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 diff --git a/extra/prolog/prolog.factor b/extra/prolog/prolog.factor index 580bfaf52e..ea55ac5bf5 100755 --- a/extra/prolog/prolog.factor +++ b/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 diff --git a/extra/regexp/regexp.factor b/extra/regexp/regexp.factor index c4b60e76e4..ef88e84f05 100755 --- a/extra/regexp/regexp.factor +++ b/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 diff --git a/extra/roman/roman.factor b/extra/roman/roman.factor index 130dfb127d..7466883c5f 100644 --- a/extra/roman/roman.factor +++ b/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 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 ; diff --git a/extra/tar/tar.factor b/extra/tar/tar.factor index d3412568fe..363ce6b412 100755 --- a/extra/tar/tar.factor +++ b/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 ; diff --git a/extra/unicode/case/case.factor b/extra/unicode/case/case.factor index 96ae9a790b..ee9e2a0381 100755 --- a/extra/unicode/case/case.factor +++ b/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 diff --git a/extra/unicode/normalize/normalize.factor b/extra/unicode/normalize/normalize.factor index b018d115f8..47637e8330 100644 --- a/extra/unicode/normalize/normalize.factor +++ b/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 diff --git a/extra/webapps/cgi/cgi.factor b/extra/webapps/cgi/cgi.factor index 9dd9dca39c..967036a797 100644 --- a/extra/webapps/cgi/cgi.factor +++ b/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 diff --git a/extra/webapps/pastebin/pastebin.factor b/extra/webapps/pastebin/pastebin.factor index e02e5c01f2..21bae57fe7 100755 --- a/extra/webapps/pastebin/pastebin.factor +++ b/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 ; diff --git a/extra/wrap/wrap.factor b/extra/wrap/wrap.factor index 4392ac81a6..41dea1bd13 100644 --- a/extra/wrap/wrap.factor +++ b/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 ) diff --git a/extra/xml/tokenize/tokenize.factor b/extra/xml/tokenize/tokenize.factor index 85a473f503..d99c306b2b 100644 --- a/extra/xml/tokenize/tokenize.factor +++ b/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 diff --git a/extra/xml/xml.factor b/extra/xml/xml.factor index 826b16b213..65a8e28dea 100644 --- a/extra/xml/xml.factor +++ b/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 diff --git a/extra/xmode/keyword-map/keyword-map.factor b/extra/xmode/keyword-map/keyword-map.factor index 350d8572a0..4e97e597b2 100644 --- a/extra/xmode/keyword-map/keyword-map.factor +++ b/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 diff --git a/extra/xmode/marker/marker.factor b/extra/xmode/marker/marker.factor index b8331fe6b6..91ccd43907 100755 --- a/extra/xmode/marker/marker.factor +++ b/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 diff --git a/extra/xmode/rules/rules.factor b/extra/xmode/rules/rules.factor index acc6308c6f..28237a7b2c 100755 --- a/extra/xmode/rules/rules.factor +++ b/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? ; diff --git a/vm/data_gc.c b/vm/data_gc.c index 3ca41d602c..601a677920 100755 --- a/vm/data_gc.c +++ b/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); diff --git a/vm/types.c b/vm/types.c index f34f5e57ca..24b5e7ff07 100755 --- a/vm/types.c +++ b/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) { diff --git a/vm/types.h b/vm/types.h index 6f4234af34..e5003ea069 100755 --- a/vm/types.h +++ b/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) {