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

Conflicts:

	extra/http/http.factor
db4
Doug Coleman 2008-02-01 22:47:05 -06:00
commit ea8ad2b04c
47 changed files with 189 additions and 137 deletions

View File

@ -347,45 +347,49 @@ SYMBOL: bootstrap-syntax
call call
] with-scope ; inline ] 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 -- ) : with-interactive-vocabs ( quot -- )
[ [
"scratchpad" in set "scratchpad" in set
{ interactive-vocabs get set-use
"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
call call
] with-scope ; inline ] with-scope ; inline

View File

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

View File

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

View File

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

View File

@ -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 system namespaces sequences splitting math.parser
unix prettyprint tools.time calendar bake vars ; 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 ; : target ( -- target ) `{ ,[ os ] %[ cpu "." split ] } "-" join ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@ -61,7 +59,7 @@ if
"factor" cd "factor" cd
{ "/usr/bin/git" "show" } <process-stream> { "git" "show" } <process-stream>
[ readln ] with-stream [ readln ] with-stream
" " split second " " split second
"../git-id" <file-writer> [ print ] with-stream "../git-id" <file-writer> [ print ] with-stream
@ -76,7 +74,7 @@ if
"builder: vm compile" throw "builder: vm compile" throw
] if ] if
"wget http://factorcode.org/images/latest/" boot-image append system "wget http://factorcode.org/images/latest/" boot-image-name append system
0 = 0 =
[ ] [ ]
[ [
@ -84,7 +82,11 @@ if
"builder: image download" throw "builder: image download" throw
] if ] 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 benchmark nip
"../boot-time" <file-writer> [ . ] with-stream "../boot-time" <file-writer> [ . ] with-stream
0 = 0 =

View File

@ -6,7 +6,7 @@
! Adapted from cryptlib.h ! Adapted from cryptlib.h
! Tested with cryptlib 3.3.1.0 ! Tested with cryptlib 3.3.1.0
USING: cryptlib.libcl kernel hashtables alien math 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 IN: cryptlib

View File

@ -3,7 +3,7 @@
USING: cryptlib cryptlib.libcl kernel alien sequences continuations USING: cryptlib cryptlib.libcl kernel alien sequences continuations
byte-arrays namespaces io.buffers math generic io strings byte-arrays namespaces io.buffers math generic io strings
io.streams.lines io.streams.plain io.streams.duplex combinators io.streams.lines io.streams.plain io.streams.duplex combinators
alien.c-types ; alien.c-types continuations ;
IN: cryptlib.streams IN: cryptlib.streams
@ -154,4 +154,4 @@ M: crypt-stream dispose ( stream -- )
dispose dispose
end end
; ;

View File

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

View File

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

View File

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

View File

@ -4,7 +4,7 @@
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: io kernel namespaces prettyprint quotations 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 IN: html.elements

View File

@ -3,7 +3,7 @@
USING: generic assocs help http io io.styles io.files continuations USING: generic assocs help http io io.styles io.files continuations
io.streams.string kernel math math.parser namespaces io.streams.string kernel math math.parser namespaces
quotations assocs sequences strings words html.elements quotations assocs sequences strings words html.elements
xml.writer xml.entities sbufs ; xml.entities sbufs continuations ;
IN: html IN: html
GENERIC: browser-link-href ( presented -- href ) GENERIC: browser-link-href ( presented -- href )

View File

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

View File

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

View File

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

View File

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

View File

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

View File

@ -7,7 +7,7 @@ sequences io.sniffer.backend ;
QUALIFIED: unix QUALIFIED: unix
IN: io.sniffer.bsd 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-UNION: ifreq_props "sockaddr-in" "short" "int" "caddr_t" ;
C-STRUCT: ifreq { { "char" 16 } "name" } { "ifreq_props" "props" } ; C-STRUCT: ifreq { { "char" 16 } "name" } { "ifreq_props" "props" } ;

View File

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

View File

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

View File

@ -1,9 +1,8 @@
! Copyright (C) 2007 Doug Coleman. ! Copyright (C) 2007 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license. ! 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 macros math namespaces prettyprint quotations sequences
vectors vocabs words ; vectors vocabs words html.elements slots.private tar ;
USING: html.elements slots.private tar ;
IN: lint IN: lint
SYMBOL: def-hash SYMBOL: def-hash

View File

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

View File

@ -1,7 +1,8 @@
! Copyright (C) 2007 Chris Double. ! Copyright (C) 2007 Chris Double.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: kernel parser words arrays strings math.parser sequences 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 IN: peg.ebnf
TUPLE: ebnf-non-terminal symbol ; TUPLE: ebnf-non-terminal symbol ;

View File

@ -1,7 +1,8 @@
! Copyright (C) 2007 Chris Double. ! Copyright (C) 2007 Chris Double.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: kernel sequences strings namespaces math assocs shuffle 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 IN: peg
TUPLE: parse-result remaining ast ; TUPLE: parse-result remaining ast ;

View File

@ -1,6 +1,7 @@
! Copyright (c) 2007 Aaron Schaefer. ! Copyright (c) 2007 Aaron Schaefer.
! See http://factorcode.org/license.txt for BSD license. ! 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 IN: project-euler.017
! http://projecteuler.net/index.php?section=problems&id=17 ! http://projecteuler.net/index.php?section=problems&id=17

View File

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

View File

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

View File

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

View File

@ -2,7 +2,7 @@
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: arrays assocs kernel math math.vectors namespaces 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 IN: roman
<PRIVATE <PRIVATE

View File

@ -1,6 +1,6 @@
! Copyright (C) 2006 Daniel Ehrenberg ! Copyright (C) 2006 Daniel Ehrenberg
! See http://factorcode.org/license.txt for BSD license. ! 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 IN: rot13
: rotate ( ch base -- ch ) tuck - 13 + 26 mod + ; : rotate ( ch base -- ch ) tuck - 13 + 26 mod + ;

View File

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

View File

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

View File

@ -1,14 +1,14 @@
USING: math arrays sequences kernel splitting strings ; USING: math arrays sequences kernel splitting strings ;
IN: strings.lib 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 ) ! : >Upper ( str -- str )
dup empty? [ ! dup empty? [
unclip ch>upper 1string swap append ! unclip ch>upper 1string swap append
] unless ; ! ] unless ;
: >Upper-dashes ( str -- str ) ! : >Upper-dashes ( str -- str )
"-" split [ >Upper ] map "-" join ; ! "-" split [ >Upper ] map "-" join ;

View File

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

View File

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

View File

@ -2,17 +2,6 @@ USING: sequences namespaces unicode.data kernel combinators.lib
math arrays ; math arrays ;
IN: unicode.normalize 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 ! Conjoining Jamo behavior
: hangul-base HEX: ac00 ; inline : hangul-base HEX: ac00 ; inline

View File

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

View File

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

View File

@ -12,15 +12,17 @@ SYMBOL: width
: (split-chunk) ( words -- ) : (split-chunk) ( words -- )
-1 over [ length + 1+ dup width get > ] find drop nip -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 ( words -- lines )
[ (split-chunk) ] { } make ; [ (split-chunk) ] { } make ;
: join-spaces ( words-seqs -- lines )
[ [ " " join ] map ] map concat ;
: broken-lines ( string width -- lines ) : broken-lines ( string width -- lines )
width [ width [
line-chunks line-chunks [ split-chunk ] map join-spaces
[ split-chunk [ " " join ] map ] map concat
] with-variable ; ] with-variable ;
: line-break ( string width -- newstring ) : line-break ( string width -- newstring )

View File

@ -2,7 +2,7 @@
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: xml.errors xml.data xml.utilities xml.char-classes USING: xml.errors xml.data xml.utilities xml.char-classes
xml.entities kernel state-parser kernel namespaces strings math 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 IN: xml.tokenize
! XML namespace processing: ns = namespace ! XML namespace processing: ns = namespace

View File

@ -3,7 +3,7 @@
USING: io io.streams.string io.files kernel math namespaces USING: io io.streams.string io.files kernel math namespaces
prettyprint sequences arrays generic strings vectors prettyprint sequences arrays generic strings vectors
xml.char-classes xml.data xml.errors xml.tokenize xml.writer 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 IN: xml
! -- Overall parser with data tree ! -- Overall parser with data tree

View File

@ -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 IN: xmode.keyword-map
! Based on org.gjt.sp.jedit.syntax.KeywordMap ! Based on org.gjt.sp.jedit.syntax.KeywordMap

View File

@ -2,7 +2,7 @@ IN: xmode.marker
USING: kernel namespaces xmode.rules xmode.tokens USING: kernel namespaces xmode.rules xmode.tokens
xmode.marker.state xmode.marker.context xmode.utilities xmode.marker.state xmode.marker.context xmode.utilities
xmode.catalog sequences math assocs combinators combinators.lib 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 ! Based on org.gjt.sp.jedit.syntax.TokenMarker

View File

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

View File

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

View File

@ -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) void set_string_nth(F_STRING* string, CELL index, CELL value)
{ {
bput(SREF(string,index),value & 0xff); bput(SREF(string,index),value & 0xff);
F_BYTE_ARRAY *aux;
if(string->aux == F) if(string->aux == F)
{ {
if(value <= 0xff) if(value <= 0xff)
return; return;
else else
{ {
string->aux = tag_object(allot_byte_array( REGISTER_UNTAGGED(string);
aux = allot_byte_array(
untag_fixnum_fast(string->length) 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); 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->length = tag_fixnum(capacity);
string->hashcode = F; string->hashcode = F;
string->aux = F; string->aux = F;
set_string_nth(string,capacity,0); set_string_nth(string,capacity,0);
return string; return string;
} }
/* allocates memory */
void fill_string(F_STRING *string, CELL start, CELL capacity, CELL fill) void fill_string(F_STRING *string, CELL start, CELL capacity, CELL fill)
{ {
if(fill == 0) 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 else
{ {
CELL i; CELL i;
for(i = start; i < capacity; i++) for(i = start; i < capacity; i++)
{
REGISTER_UNTAGGED(string);
set_string_nth(string,i,fill); 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 *allot_string(CELL capacity, CELL fill)
{ {
F_STRING* string = allot_string_internal(capacity); F_STRING* string = allot_string_internal(capacity);
REGISTER_UNTAGGED(string);
fill_string(string,0,capacity,fill); fill_string(string,0,capacity,fill);
UNREGISTER_UNTAGGED(string);
return string; return string;
} }
@ -506,7 +531,23 @@ F_STRING* reallot_string(F_STRING* string, CELL capacity, CELL fill)
UNREGISTER_UNTAGGED(string); UNREGISTER_UNTAGGED(string);
memcpy(new_string + 1,string + 1,to_copy); 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); fill_string(new_string,to_copy,capacity,fill);
UNREGISTER_UNTAGGED(string);
return new_string; return new_string;
} }
@ -529,7 +570,9 @@ DEFINE_PRIMITIVE(resize_string)
CELL i; \ CELL i; \
for(i = 0; i < length; i++) \ for(i = 0; i < length; i++) \
{ \ { \
REGISTER_UNTAGGED(s); \
set_string_nth(s,i,(utype)*string); \ set_string_nth(s,i,(utype)*string); \
UNREGISTER_UNTAGGED(s); \
string++; \ string++; \
} \ } \
return s; \ return s; \
@ -552,6 +595,7 @@ DEFINE_PRIMITIVE(resize_string)
MEMORY_TO_STRING(char,u8) MEMORY_TO_STRING(char,u8)
MEMORY_TO_STRING(u16,u16) MEMORY_TO_STRING(u16,u16)
MEMORY_TO_STRING(u32,u32)
bool check_string(F_STRING *s, CELL max) bool check_string(F_STRING *s, CELL max)
{ {

View File

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