steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Merge branch 'master' of git://factorcode.org/git/factor 

Conflicts:

	extra/html/parser/analyzer/analyzer.factor
db4
Doug Coleman 2008-03-06 17:12:15 -06:00
parent 61c77e616f e6d4afa1c1
commit ebc0127d01
183 changed files with 1002 additions and 1513 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
core/alien/c-types/c-types.factor
View File

@ -4,7 +4,7 @@ USING: bit-arrays byte-arrays float-arrays arrays
generator.registers assocs kernel kernel.private libc math
namespaces parser sequences strings words assocs splitting
math.parser cpu.architecture alien alien.accessors quotations
system compiler.units ;
system compiler.units io.files io.encodings.binary ;
IN: alien.c-types
DEFER: <int>
@ -273,6 +273,9 @@ M: long-long-type box-return ( type -- )
r> add*
] when ;
: malloc-file-contents ( path -- alien )
binary file-contents >byte-array malloc-byte-array ;
[
[ alien-cell ]
[ set-alien-cell ]

4
core/bootstrap/image/image.factor
View File

@ -7,7 +7,7 @@ strings sbufs vectors words quotations assocs system layouts
splitting growable classes tuples words.private
io.binary io.files vocabs vocabs.loader source-files
definitions debugger float-arrays quotations.private
sequences.private combinators ;
sequences.private combinators io.encodings.binary ;
IN: bootstrap.image
: my-arch ( -- arch )
@ -416,7 +416,7 @@ M: curry '
"Writing image to " write
architecture get boot-image-name resource-path
dup write "..." print flush
[ (write-image) ] with-file-writer ;
binary <file-writer> [ (write-image) ] with-stream ;
PRIVATE>

1
core/bootstrap/primitives.factor
View File

@ -623,6 +623,7 @@ builtins get num-tags get tail f union-class define-class
{ "fopen" "io.streams.c" }
{ "fgetc" "io.streams.c" }
{ "fread" "io.streams.c" }
{ "fputc" "io.streams.c" }
{ "fwrite" "io.streams.c" }
{ "fflush" "io.streams.c" }
{ "fclose" "io.streams.c" }

2
core/inference/known-words/known-words.factor
View File

@ -538,6 +538,8 @@ set-primitive-effect
\ fwrite { string alien } { } <effect> set-primitive-effect
\ fputc { object alien } { } <effect> set-primitive-effect
\ fread { integer string } { object } <effect> set-primitive-effect
\ fflush { alien } { } <effect> set-primitive-effect

10
core/io/backend/backend.factor
View File

@ -1,13 +1,17 @@
! Copyright (C) 2007, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: init kernel system namespaces ;
USING: init kernel system namespaces io io.encodings io.encodings.utf8 ;
IN: io.backend
SYMBOL: io-backend
HOOK: init-io io-backend ( -- )
HOOK: init-stdio io-backend ( -- )
HOOK: (init-stdio) io-backend ( -- stdin stdout stderr )
: init-stdio ( -- )
(init-stdio) utf8 <encoder> stderr set-global
utf8 <encoder-duplex> stdio set-global ;
HOOK: io-multiplex io-backend ( ms -- )
@ -19,7 +23,7 @@ HOOK: normalize-pathname io-backend ( str -- newstr )
M: object normalize-pathname ;
: set-io-backend ( backend -- )
: set-io-backend ( io-backend -- )
io-backend set-global init-io init-stdio ;
[ init-io embedded? [ init-stdio ] unless ]

2
core/io/binary/binary.factor Normal file → Executable file
View File

@ -10,7 +10,7 @@ IN: io.binary
: nth-byte ( x n -- b ) -8 * shift mask-byte ; inline
: >le ( x n -- str ) [ nth-byte ] with "" map-as ;
: >le ( x n -- str ) [ nth-byte ] with B{ } map-as ;
: >be ( x n -- str ) >le dup reverse-here ;
: d>w/w ( d -- w1 w2 )

2
core/io/encodings/binary/binary-docs.factor
View File

@ -2,4 +2,4 @@ USING: help.syntax help.markup ;
IN: io.encodings.binary
HELP: binary
{ $class-description "This is the encoding descriptor for binary I/O." } ;
{ $class-description "This is the encoding descriptor for binary I/O. Making an encoded stream with the binary encoding is a no-op; streams with this encoding deal with byte-arrays, not strings." } ;

6
core/io/encodings/binary/binary.factor
View File

@ -1,3 +1,3 @@
USING: kernel io.encodings ;
TUPLE: binary ;
! Copyright (C) 2008 Daniel Ehrenberg.
! See http://factorcode.org/license.txt for BSD license.
IN: io.encodings.binary SYMBOL: binary

68
core/io/encodings/encodings-docs.factor Normal file
View File

@ -0,0 +1,68 @@
USING: help.markup help.syntax ;
IN: io.encodings
ABOUT: "encodings"
ARTICLE: "io.encodings" "I/O encodings"
"Many streams deal with bytes, rather than Unicode code points, at some level. The translation between these two things is specified by an encoding. To abstract this away from the programmer, Factor provides a system where these streams are associated with an encoding which is always used when the stream is read from or written to. For most purposes, an encoding descriptor consisting of a symbol is all that is needed when initializing a stream."
{ $subsection "encodings-constructors" }
{ $subsection "encodings-descriptors" }
{ $subsection "encodings-protocol" } ;
ARTICLE: "encodings-constructors" "Constructing an encoded stream"
{ $subsection <encoder> }
{ $subsection <decoder> }
{ $subsection <encoder-duplex> } ;
HELP: <encoder> ( stream encoding -- newstream )
{ $values { "stream" "an output stream" }
{ "encoding" "an encoding descriptor" }
{ "newstream" "an encoded output stream" } }
{ $description "Wraps the given stream in a new stream using the given encoding for all output. The encoding descriptor can either be a class or an instance of something conforming to the " { $link "encodings-protocol" } "." } ;
HELP: <decoder> ( stream encoding -- newstream )
{ $values { "stream" "an input stream" }
{ "encoding" "an encoding descriptor" }
{ "newstream" "an encoded output stream" } }
{ $description "Wraps the given stream in a new stream using the given encoding for all input. The encoding descriptor can either be a class or an instance of something conforming to the " { $link "encodings-protocol" } "." } ;
HELP: <encoder-duplex> ( stream-in stream-out encoding -- duplex )
{ $values { "stream-in" "an input stream" }
{ "stream-out" "an output stream" }
{ "encoding" "an encoding descriptor" }
{ "duplex" "an encoded duplex stream" } }
{ $description "Wraps the given streams in an encoder or decoder stream, and puts them together in a duplex stream for input and output. If either input stream is already encoded, that encoding is stripped off before it is reencoded. The encoding descriptor must conform to the " { $link "encodings-protocol" } "." } ;
{ <encoder> <decoder> <encoder-duplex> } related-words
ARTICLE: "encodings-descriptors" "Encoding descriptors"
"An encoding descriptor is something which can be used for input or output streams to encode or decode files. It must conform to the " { $link "encodings-protocol" } ". Encodings which you can use are defined in the following vocabularies:"
$nl { $vocab-link "io.encodings.utf8" }
$nl { $vocab-link "io.encodings.ascii" }
$nl { $vocab-link "io.encodings.binary" }
$nl { $vocab-link "io.encodings.utf16" } ;
ARTICLE: "encodings-protocol" "Encoding protocol"
"An encoding descriptor must implement the following methods. The methods are implemented on tuple classes by instantiating the class and calling the method again."
{ $subsection decode-step }
{ $subsection init-decoder }
{ $subsection stream-write-encoded } ;
HELP: decode-step ( buf char encoding -- )
{ $values { "buf" "A string buffer which characters can be pushed to" }
{ "char" "An octet which is read from a stream" }
{ "encoding" "An encoding descriptor tuple" } }
{ $description "A single step in the decoding process must be defined for the decoding descriptor. When each octet is read, this word is called, and depending on the decoder's internal state, something may be pushed to the buffer or the state may change. This should not be used directly." } ;
HELP: stream-write-encoded ( string stream encoding -- )
{ $values { "string" "a string" }
{ "stream" "an output stream" }
{ "encoding" "an encoding descriptor" } }
{ $description "Encodes the string with the given encoding descriptor, outputing the result to the given stream. This should not be used directly." } ;
HELP: init-decoder ( stream encoding -- encoding )
{ $values { "stream" "an input stream" }
{ "encoding" "an encoding descriptor" } }
{ $description "Initializes the decoder tuple's state. The stream is exposed so that it can be read, eg for a BOM. This should not be used directly." } ;
{ init-decoder decode-step stream-write-encoded } related-words

8
core/io/streams/lines/lines-tests.factor → core/io/encodings/encodings-tests.factor
View File

@ -1,9 +1,9 @@
USING: io.streams.lines io.files io.streams.string io
tools.test kernel ;
IN: io.streams.lines.tests
USING: io.files io.streams.string io
tools.test kernel io.encodings.ascii ;
IN: io.streams.encodings.tests
: <resource-reader> ( resource -- stream )
resource-path <file-reader> ;
resource-path ascii <file-reader> ;
[ { } ]
[ "/core/io/test/empty-file.txt" <resource-reader> lines ]

160
core/io/encodings/encodings.factor
View File

@ -1,13 +1,24 @@
! Copyright (C) 2006, 2007 Daniel Ehrenberg.
! Copyright (C) 2008 Daniel Ehrenberg.
! See http://factorcode.org/license.txt for BSD license.
USING: math kernel sequences sbufs vectors io.streams.lines io.streams.plain
namespaces unicode growable strings io classes io.streams.c
continuations ;
USING: math kernel sequences sbufs vectors namespaces
growable strings io classes continuations combinators
io.styles io.streams.plain io.encodings.binary splitting
io.streams.duplex byte-arrays ;
IN: io.encodings
TUPLE: encode-error ;
! The encoding descriptor protocol
: encode-error ( -- * ) \ encode-error construct-empty throw ;
GENERIC: decode-step ( buf char encoding -- )
M: object decode-step drop swap push ;
GENERIC: init-decoder ( stream encoding -- encoding )
M: tuple-class init-decoder construct-empty init-decoder ;
M: object init-decoder nip ;
GENERIC: stream-write-encoded ( string stream encoding -- byte-array )
M: object stream-write-encoded drop stream-write ;
! Decoding
TUPLE: decode-error ;
@ -15,24 +26,12 @@ TUPLE: decode-error ;
SYMBOL: begin
: decoded ( buf ch -- buf ch state )
: push-decoded ( buf ch -- buf ch state )
over push 0 begin ;
: push-replacement ( buf -- buf ch state )
CHAR: replacement-character decoded ;
: finish-decoding ( buf ch state -- str )
begin eq? [ decode-error ] unless drop "" like ;
: start-decoding ( seq length -- buf ch state seq )
<sbuf> 0 begin roll ;
GENERIC: decode-step ( buf byte ch state encoding -- buf ch state )
: decode ( seq quot -- string )
>r dup length start-decoding r>
[ -rot ] swap compose each
finish-decoding ; inline
! This is the replacement character
HEX: fffd push-decoded ;
: space ( resizable -- room-left )
dup underlying swap [ length ] 2apply - ;
@ -42,54 +41,113 @@ GENERIC: decode-step ( buf byte ch state encoding -- buf ch state )
: end-read-loop ( buf ch state stream quot -- string/f )
2drop 2drop >string f like ;
: decode-read-loop ( buf ch state stream encoding -- string/f )
>r >r pick r> r> rot full? [ end-read-loop ] [
: decode-read-loop ( buf stream encoding -- string/f )
pick full? [ 2drop >string ] [
over stream-read1 [
-rot tuck >r >r >r -rot r> decode-step r> r> decode-read-loop
] [ end-read-loop ] if*
-rot tuck >r >r >r dupd r> decode-step r> r>
decode-read-loop
] [ 2drop >string f like ] if*
] if ;
: decode-read ( length stream encoding -- string )
>r swap start-decoding r>
decode-read-loop ;
rot <sbuf> -rot decode-read-loop ;
: <decoding> ( stream decoding-class -- decoded-stream )
construct-delegate <line-reader> ;
TUPLE: decoder code cr ;
: <decoder> ( stream encoding -- newstream )
dup binary eq? [ drop ] [
dupd init-decoder { set-delegate set-decoder-code }
decoder construct
] if ;
: <encoding> ( stream encoding-class -- encoded-stream )
construct-delegate <plain-writer> ;
: cr+ t swap set-decoder-cr ; inline
GENERIC: encode-string ( string encoding -- byte-array )
M: tuple-class encode-string construct-empty encode-string ;
: cr- f swap set-decoder-cr ; inline
MIXIN: encoding-stream
: line-ends/eof ( stream str -- str ) f like swap cr- ; inline
M: encoding-stream stream-read1 1 swap stream-read ;
: line-ends\r ( stream str -- str ) swap cr+ ; inline
M: encoding-stream stream-read
[ delegate ] keep decode-read ;
: line-ends\n ( stream str -- str )
over decoder-cr over empty? and
[ drop dup cr- stream-readln ] [ swap cr- ] if ; inline
M: encoding-stream stream-read-partial stream-read ;
: handle-readln ( stream str ch -- str )
{
{ f [ line-ends/eof ] }
{ CHAR: \r [ line-ends\r ] }
{ CHAR: \n [ line-ends\n ] }
} case ;
M: encoding-stream stream-read-until
: fix-read ( stream string -- string )
over decoder-cr [
over cr-
"\n" ?head [
swap stream-read1 [ add ] when*
] [ nip ] if
] [ nip ] if ;
M: decoder stream-read
tuck { delegate decoder-code } get-slots decode-read fix-read ;
M: decoder stream-read-partial stream-read ;
: decoder-read-until ( stream delim -- ch )
! Copied from { c-reader stream-read-until }!!!
[ swap read-until-loop ] "" make
over stream-read1 dup [
dup pick memq? [ 2nip ] [ , decoder-read-until ] if
] [
2nip
] if ;
M: decoder stream-read-until
! Copied from { c-reader stream-read-until }!!!
[ swap decoder-read-until ] "" make
swap over empty? over not and [ 2drop f f ] when ;
M: encoding-stream stream-write1
: fix-read1 ( stream char -- char )
over decoder-cr [
over cr-
dup CHAR: \n = [
drop stream-read1
] [ nip ] if
] [ nip ] if ;
M: decoder stream-read1
1 swap stream-read f like [ first ] [ f ] if* ;
M: decoder stream-readln ( stream -- str )
"\r\n" over stream-read-until handle-readln ;
! Encoding
TUPLE: encode-error ;
: encode-error ( -- * ) \ encode-error construct-empty throw ;
TUPLE: encoder code ;
: <encoder> ( stream encoding -- newstream )
dup binary eq? [ drop ] [
construct-empty { set-delegate set-encoder-code }
encoder construct
] if ;
M: encoder stream-write1
>r 1string r> stream-write ;
M: encoding-stream stream-write
[ encode-string ] keep delegate stream-write ;
M: encoder stream-write
{ delegate encoder-code } get-slots stream-write-encoded ;
M: encoding-stream dispose delegate dispose ;
M: encoder dispose delegate dispose ;
GENERIC: underlying-stream ( encoded-stream -- delegate )
M: encoding-stream underlying-stream delegate ;
INSTANCE: encoder plain-writer
GENERIC: set-underlying-stream ( new-underlying stream -- )
M: encoding-stream set-underlying-stream set-delegate ;
! Rebinding duplex streams which have not read anything yet
: set-encoding ( encoding stream -- ) ! This doesn't work now
[ underlying-stream swap construct-delegate ] keep
set-underlying-stream ;
: reencode ( stream encoding -- newstream )
over encoder? [ >r delegate r> ] when <encoder> ;
: redecode ( stream encoding -- newstream )
over decoder? [ >r delegate r> ] when <decoder> ;
: <encoder-duplex> ( stream-in stream-out encoding -- duplex )
tuck reencode >r redecode r> <duplex-stream> ;

10
core/io/encodings/latin1/latin1.factor
View File

@ -1,10 +0,0 @@
USING: io io.encodings strings kernel ;
IN: io.encodings.latin1
TUPLE: latin1 ;
M: latin1 stream-read delegate stream-read >string ;
M: latin1 stream-read-until delegate stream-read-until >string ;
M: latin1 stream-read-partial delegate stream-read-partial >string ;

0
core/io/encodings/latin1/authors.txt → core/io/encodings/string/authors.txt
View File

18
core/io/encodings/string/string-docs.factor Normal file
View File

@ -0,0 +1,18 @@
! Copyright (C) 2008 Daniel Ehrenberg.
! See http://factorcode.org/license.txt for BSD license.
USING: help.markup help.syntax byte-arrays strings ;
IN: io.encodings.string
ARTICLE: "io.encodings.string" "Encoding and decoding strings"
"Strings can be encoded or decoded to and from byte arrays through an encoding with the following words:"
{ $subsection encode }
{ $subsection decode } ;
HELP: decode
{ $values { "byte-array" byte-array } { "encoding" "an encoding descriptor" }
{ "string" string } }
{ $description "Decodes the byte array using the given encoding, outputting a string" } ;
HELP: encode
{ $values { "string" string } { "encoding" "an encoding descriptor" } { "byte-array" byte-array } }
{ $description "Encodes the given string into a byte array with the given encoding." } ;

11
core/io/encodings/string/string-tests.factor Normal file
View File

@ -0,0 +1,11 @@
! Copyright (C) 2008 Daniel Ehrenberg.
! See http://factorcode.org/license.txt for BSD license.
USING: strings io.encodings.utf8 io.encodings.utf16
io.encodings.string tools.test ;
IN: io.encodings.string.tests
[ "hello" ] [ "hello" utf8 decode ] unit-test
[ "he" ] [ "\0h\0e" utf16be decode ] unit-test
[ "hello" ] [ "hello" utf8 encode >string ] unit-test
[ "\0h\0e" ] [ "he" utf16be encode >string ] unit-test

10
core/io/encodings/string/string.factor Normal file
View File

@ -0,0 +1,10 @@
! Copyright (C) 2008 Daniel Ehrenberg.
! See http://factorcode.org/license.txt for BSD license.
USING: io io.streams.byte-array ;
IN: io.encodings.string
: decode ( byte-array encoding -- string )
<byte-reader> contents ;
: encode ( string encoding -- byte-array )
[ write ] with-byte-writer ;

1
core/io/encodings/string/summary.txt Normal file
View File

@ -0,0 +1 @@
Encoding and decoding strings

0
core/io/encodings/latin1/tags.txt → core/io/encodings/string/tags.factor
View File

45
core/io/encodings/utf16/utf16-docs.factor
View File

@ -1,45 +0,0 @@
USING: help.markup help.syntax io.encodings strings ;
IN: io.encodings.utf16
ARTICLE: "io.utf16" "Working with UTF16-encoded data"
"The UTF16 encoding is a variable-width encoding. Unicode code points are encoded as 2 or 4 byte sequences."
{ $subsection encode-utf16le }
{ $subsection encode-utf16be }
{ $subsection decode-utf16le }
{ $subsection decode-utf16be }
"Support for UTF16 data with a byte order mark:"
{ $subsection encode-utf16 }
{ $subsection decode-utf16 } ;
ABOUT: "io.utf16"
HELP: decode-utf16
{ $values { "seq" "a sequence of bytes" } { "str" string } }
{ $description "Decodes a sequence of bytes representing a Unicode string in UTF16 format. The bytes must begin with a UTF16 byte order mark, which determines if the input is in little or big endian. To decode data without a byte order mark, use " { $link decode-utf16le } " or " { $link decode-utf16be } "." }
{ $errors "Throws a " { $link decode-error } " if the input is malformed." } ;
HELP: decode-utf16be
{ $values { "seq" "a sequence of bytes" } { "str" string } }
{ $description "Decodes a sequence of bytes representing a Unicode string in big endian UTF16 format. The bytes must not begin with a UTF16 byte order mark. To decode data with a byte order mark, use " { $link decode-utf16 } "." }
{ $errors "Throws a " { $link decode-error } " if the input is malformed." } ;
HELP: decode-utf16le
{ $values { "seq" "a sequence of bytes" } { "str" string } }
{ $description "Decodes a sequence of bytes representing a Unicode string in little endian UTF16 format. The bytes must not begin with a UTF16 byte order mark. To decode data with a byte order mark, use " { $link decode-utf16 } "." }
{ $errors "Throws a " { $link decode-error } " if the input is malformed." } ;
{ decode-utf16 decode-utf16le decode-utf16be } related-words
HELP: encode-utf16be
{ $values { "str" string } { "seq" "a sequence of bytes" } }
{ $description "Encodes a Unicode string as a sequence of bytes in big endian UTF16 format." } ;
HELP: encode-utf16le
{ $values { "str" string } { "seq" "a sequence of bytes" } }
{ $description "Encodes a Unicode string as a sequence of bytes in little endian UTF16 format." } ;
HELP: encode-utf16
{ $values { "str" string } { "seq" "a sequence of bytes" } }
{ $description "Encodes a Unicode string as a sequence of bytes in UTF16 format with a byte order mark." } ;
{ encode-utf16 encode-utf16be encode-utf16le } related-words

28
core/io/encodings/utf16/utf16-tests.factor
View File

@ -1,28 +0,0 @@
USING: kernel tools.test io.encodings.utf16 arrays sbufs sequences io.encodings
io unicode ;
: decode-w/stream ( array encoding -- newarray )
>r >sbuf dup reverse-here r> <decoding> contents >array ;
: encode-w/stream ( array encoding -- newarray )
>r SBUF" " clone tuck r> <encoding> stream-write >array ;
[ { CHAR: x } ] [ { 0 CHAR: x } utf16be decode-w/stream ] unit-test
[ { HEX: 1D11E } ] [ { HEX: D8 HEX: 34 HEX: DD HEX: 1E } utf16be decode-w/stream ] unit-test
[ { CHAR: replacement-character } ] [ { BIN: 11011111 CHAR: q } utf16be decode-w/stream ] unit-test
[ { CHAR: replacement-character } ] [ { BIN: 11011011 CHAR: x BIN: 11011011 CHAR: x } utf16be decode-w/stream ] unit-test
[ { 0 120 216 52 221 30 } ] [ { CHAR: x HEX: 1d11e } utf16be encode-w/stream ] unit-test
[ { CHAR: x } ] [ { CHAR: x 0 } utf16le decode-w/stream ] unit-test
[ { 119070 } ] [ { HEX: 34 HEX: D8 HEX: 1E HEX: DD } utf16le decode-w/stream ] unit-test
[ { CHAR: replacement-character } ] [ { 0 BIN: 11011111 } utf16le decode-w/stream ] unit-test
[ { CHAR: replacement-character } ] [ { 0 BIN: 11011011 0 0 } utf16le decode-w/stream ] unit-test
[ { 119070 } ] [ { HEX: 34 HEX: D8 HEX: 1E HEX: DD } utf16le decode-w/stream ] unit-test
[ { 120 0 52 216 30 221 } ] [ { CHAR: x HEX: 1d11e } utf16le encode-w/stream ] unit-test
[ { CHAR: x } ] [ { HEX: ff HEX: fe CHAR: x 0 } utf16 decode-w/stream ] unit-test
[ { CHAR: x } ] [ { HEX: fe HEX: ff 0 CHAR: x } utf16 decode-w/stream ] unit-test
[ { HEX: ff HEX: fe 120 0 52 216 30 221 } ] [ { CHAR: x HEX: 1d11e } utf16 encode-w/stream ] unit-test

19
core/io/encodings/utf8/utf8-docs.factor
View File

@ -1,18 +1,11 @@
USING: help.markup help.syntax io.encodings strings ;
USING: help.markup help.syntax io.encodings strings io.files ;
IN: io.encodings.utf8
ARTICLE: "io.encodings.utf8" "Working with UTF8-encoded data"
"The UTF8 encoding is a variable-width encoding. 7-bit ASCII characters are encoded as single bytes, and other Unicode code points are encoded as 2 to 4 byte sequences."
{ $subsection encode-utf8 }
{ $subsection decode-utf8 } ;
"The UTF8 encoding is a variable-width encoding. 7-bit ASCII characters are encoded as single bytes, and other Unicode code points are encoded as 2 to 4 byte sequences. The encoding descriptor for UTF-8:"
{ $subsection utf8 } ;
HELP: utf8
{ $class-description "This is the class of encoding tuples which denote a UTF-8 encoding. This conforms to the " { $link "encodings-protocol" } "." } ;
ABOUT: "io.encodings.utf8"
HELP: decode-utf8
{ $values { "seq" "a sequence of bytes" } { "str" string } }
{ $description "Decodes a sequence of bytes representing a Unicode string in UTF8 format." }
{ $errors "Throws a " { $link decode-error } " if the input is malformed." } ;
HELP: encode-utf8
{ $values { "str" string } { "seq" "a sequence of bytes" } }
{ $description "Encodes a Unicode string as a sequence of bytes in UTF8 format." } ;

13
core/io/encodings/utf8/utf8-tests.factor
View File

@ -1,21 +1,20 @@
USING: io.encodings.utf8 tools.test sbufs kernel io io.encodings
sequences strings arrays unicode ;
USING: io.encodings.utf8 tools.test io.encodings.string strings arrays ;
: decode-utf8-w/stream ( array -- newarray )
>sbuf dup reverse-here utf8 <decoding> contents ;
utf8 decode >array ;
: encode-utf8-w/stream ( array -- newarray )
SBUF" " clone tuck utf8 <encoding> stream-write >array ;
utf8 encode >array ;
[ { CHAR: replacement-character } ] [ { BIN: 11110101 BIN: 10111111 BIN: 10000000 BIN: 11111111 } decode-utf8-w/stream >array ] unit-test
[ { CHAR: replacement-character } ] [ { BIN: 11110101 BIN: 10111111 BIN: 10000000 BIN: 11111111 } decode-utf8-w/stream ] unit-test
[ { BIN: 101111111000000111111 } ] [ { BIN: 11110101 BIN: 10111111 BIN: 10000000 BIN: 10111111 } decode-utf8-w/stream >array ] unit-test
[ { BIN: 101111111000000111111 } ] [ { BIN: 11110101 BIN: 10111111 BIN: 10000000 BIN: 10111111 } decode-utf8-w/stream ] unit-test
[ "x" ] [ "x" decode-utf8-w/stream >string ] unit-test
[ { BIN: 11111000000 } ] [ { BIN: 11011111 BIN: 10000000 } decode-utf8-w/stream >array ] unit-test
[ { CHAR: replacement-character } ] [ { BIN: 10000000 } decode-utf8-w/stream >array ] unit-test
[ { CHAR: replacement-character } ] [ { BIN: 10000000 } decode-utf8-w/stream ] unit-test
[ { BIN: 1111000000111111 } ] [ { BIN: 11101111 BIN: 10000000 BIN: 10111111 } decode-utf8-w/stream >array ] unit-test

46
core/io/encodings/utf8/utf8.factor
View File

@ -1,11 +1,13 @@
! Copyright (C) 2006, 2007 Daniel Ehrenberg.
! Copyright (C) 2006, 2008 Daniel Ehrenberg.
! See http://factorcode.org/license.txt for BSD license.
USING: math kernel sequences sbufs vectors growable io continuations
namespaces io.encodings combinators strings io.streams.c ;
namespaces io.encodings combinators strings ;
IN: io.encodings.utf8
! Decoding UTF-8
TUPLE: utf8 ch state ;
SYMBOL: double
SYMBOL: triple
SYMBOL: triple2
@ -23,7 +25,7 @@ SYMBOL: quad3
: begin-utf8 ( buf byte -- buf ch state )
{
{ [ dup -7 shift zero? ] [ decoded ] }
{ [ dup -7 shift zero? ] [ push-decoded ] }
{ [ dup -5 shift BIN: 110 number= ] [ BIN: 11111 bitand double ] }
{ [ dup -4 shift BIN: 1110 number= ] [ BIN: 1111 bitand triple ] }
{ [ dup -3 shift BIN: 11110 number= ] [ BIN: 111 bitand quad ] }
@ -31,7 +33,7 @@ SYMBOL: quad3
} cond ;
: end-multibyte ( buf byte ch -- buf ch state )
f append-nums [ decoded ] unless* ;
f append-nums [ push-decoded ] unless* ;
: decode-utf8-step ( buf byte ch state -- buf ch state )
{
@ -44,42 +46,42 @@ SYMBOL: quad3
{ quad3 [ end-multibyte ] }
} case ;
: decode-utf8 ( seq -- str )
[ decode-utf8-step ] decode ;
: unpack-state ( encoding -- ch state )
{ utf8-ch utf8-state } get-slots ;
: pack-state ( ch state encoding -- )
{ set-utf8-ch set-utf8-state } set-slots ;
M: utf8 decode-step ( buf char encoding -- )
[ unpack-state decode-utf8-step ] keep pack-state drop ;
M: utf8 init-decoder nip begin over set-utf8-state ;
! Encoding UTF-8
: encoded ( char -- )
BIN: 111111 bitand BIN: 10000000 bitor , ;
BIN: 111111 bitand BIN: 10000000 bitor write1 ;
: char>utf8 ( char -- )
{
{ [ dup -7 shift zero? ] [ , ] }
{ [ dup -7 shift zero? ] [ write1 ] }
{ [ dup -11 shift zero? ] [
dup -6 shift BIN: 11000000 bitor ,
dup -6 shift BIN: 11000000 bitor write1
encoded
] }
{ [ dup -16 shift zero? ] [
dup -12 shift BIN: 11100000 bitor ,
dup -12 shift BIN: 11100000 bitor write1
dup -6 shift encoded
encoded
] }
{ [ t ] [
dup -18 shift BIN: 11110000 bitor ,
dup -18 shift BIN: 11110000 bitor write1
dup -12 shift encoded
dup -6 shift encoded
encoded
] }
} cond ;
: encode-utf8 ( str -- seq )
[ [ char>utf8 ] each ] B{ } make ;
! Interface for streams
TUPLE: utf8 ;
INSTANCE: utf8 encoding-stream
M: utf8 encode-string drop encode-utf8 ;
M: utf8 decode-step drop decode-utf8-step ;
! In the future, this should detect and ignore a BOM at the beginning
M: utf8 stream-write-encoded
! For efficiency, this should be modified to avoid variable reads
drop [ [ char>utf8 ] each ] with-stream* ;

1
core/io/files/authors.txt
View File

@ -1 +1,2 @@
Slava Pestov
Daniel Ehrenberg

38
core/io/files/files-docs.factor
View File

@ -10,7 +10,9 @@ ARTICLE: "file-streams" "Reading and writing files"
"Utility combinators:"
{ $subsection with-file-reader }
{ $subsection with-file-writer }
{ $subsection with-file-appender } ;
{ $subsection with-file-appender }
{ $subsection file-contents }
{ $subsection file-lines } ;
ARTICLE: "pathnames" "Pathname manipulation"
"Pathname manipulation:"
@ -87,7 +89,6 @@ ARTICLE: "io.files" "Basic file operations"
{ $subsection "fs-meta" }
{ $subsection "directories" }
{ $subsection "delete-move-copy" }
{ $subsection "unique" }
{ $see-also "os" } ;
ABOUT: "io.files"
@ -114,33 +115,44 @@ HELP: file-name
} ;
HELP: <file-reader>
{ $values { "path" "a pathname string" } { "stream" "an input stream" } }
{ $description "Outputs an input stream for reading from the specified pathname." }
{ $values { "path" "a pathname string" } { "encoding" "an encoding descriptors" }
{ "stream" "an input stream" } }
{ $description "Outputs an input stream for reading from the specified pathname using the given encoding." }
{ $errors "Throws an error if the file is unreadable." } ;
HELP: <file-writer>
{ $values { "path" "a pathname string" } { "stream" "an output stream" } }
{ $description "Outputs an output stream for writing to the specified pathname. The file's length is truncated to zero." }
{ $values { "path" "a pathname string" } { "encoding" "an encoding descriptor" } { "stream" "an output stream" } }
{ $description "Outputs an output stream for writing to the specified pathname using the given encoding. The file's length is truncated to zero." }
{ $errors "Throws an error if the file cannot be opened for writing." } ;
HELP: <file-appender>
{ $values { "path" "a pathname string" } { "stream" "an output stream" } }
{ $description "Outputs an output stream for writing to the specified pathname. The stream begins writing at the end of the file." }
{ $values { "path" "a pathname string" } { "encoding" "an encoding descriptor" } { "stream" "an output stream" } }
{ $description "Outputs an output stream for writing to the specified pathname using the given encoding. The stream begins writing at the end of the file." }
{ $errors "Throws an error if the file cannot be opened for writing." } ;
HELP: with-file-reader
{ $values { "path" "a pathname string" } { "quot" "a quotation" } }
{ $values { "path" "a pathname string" } { "encoding" "an encoding descriptor" } { "quot" "a quotation" } }
{ $description "Opens a file for reading and calls the quotation using " { $link with-stream } "." }
{ $errors "Throws an error if the file is unreadable." } ;
HELP: with-file-writer
{ $values { "path" "a pathname string" } { "quot" "a quotation" } }
{ $description "Opens a file for writing and calls the quotation using " { $link with-stream } "." }
{ $values { "path" "a pathname string" } { "encoding" "an encoding descriptor" } { "quot" "a quotation" } }
{ $description "Opens a file for writing using the given encoding and calls the quotation using " { $link with-stream } "." }
{ $errors "Throws an error if the file cannot be opened for writing." } ;
HELP: with-file-appender
{ $values { "path" "a pathname string" } { "quot" "a quotation" } }
{ $description "Opens a file for appending and calls the quotation using " { $link with-stream } "." }
{ $values { "path" "a pathname string" } { "encoding" "an encoding descriptor" } { "quot" "a quotation" } }
{ $description "Opens a file for appending using the given encoding and calls the quotation using " { $link with-stream } "." }
{ $errors "Throws an error if the file cannot be opened for writing." } ;
HELP: file-lines
{ $values { "path" "a pathname string" } { "encoding" "an encoding descriptor" } { "seq" "an array of strings" } }
{ $description "Opens the file at the given path using the given encoding, and returns a list of the lines in that file." }
{ $errors "Throws an error if the file cannot be opened for writing." } ;
HELP: file-contents
{ $values { "path" "a pathname string" } { "encoding" "an encoding descriptor" } { "str" "a string" } }
{ $description "Opens the file at the given path using the given encoding, and the contents of that file as a string." }
{ $errors "Throws an error if the file cannot be opened for writing." } ;
HELP: cwd

32
core/io/files/files-tests.factor
View File

@ -1,34 +1,34 @@
IN: io.files.tests
USING: tools.test io.files io threads kernel continuations ;
USING: tools.test io.files io threads kernel continuations io.encodings.ascii ;
[ "passwd" ] [ "/etc/passwd" file-name ] unit-test
[ "awk" ] [ "/usr/libexec/awk/" file-name ] unit-test
[ "awk" ] [ "/usr/libexec/awk///" file-name ] unit-test
[ ] [
"test-foo.txt" temp-file [
"test-foo.txt" temp-file ascii [
"Hello world." print
] with-file-writer
] unit-test
[ ] [
"test-foo.txt" temp-file <file-appender> [
"test-foo.txt" temp-file ascii [
"Hello appender." print
] with-stream
] with-file-appender
] unit-test
[ ] [
"test-bar.txt" temp-file <file-appender> [
"test-bar.txt" temp-file ascii [
"Hello appender." print
] with-stream
] with-file-appender
] unit-test
[ "Hello world.\nHello appender.\n" ] [
"test-foo.txt" temp-file file-contents
"test-foo.txt" temp-file ascii file-contents
] unit-test
[ "Hello appender.\n" ] [
"test-bar.txt" temp-file file-contents
"test-bar.txt" temp-file ascii file-contents
] unit-test
[ ] [ "test-foo.txt" temp-file delete-file ] unit-test
@ -42,7 +42,7 @@ USING: tools.test io.files io threads kernel continuations ;
[ ] [ "test-blah" temp-file make-directory ] unit-test
[ ] [
"test-blah/fooz" temp-file <file-writer> dispose
"test-blah/fooz" temp-file ascii <file-writer> dispose
] unit-test
[ t ] [
@ -55,11 +55,11 @@ USING: tools.test io.files io threads kernel continuations ;
[ f ] [ "test-blah" temp-file exists? ] unit-test
[ ] [ "test-quux.txt" temp-file [ [ yield "Hi" write ] "Test" spawn drop ] with-file-writer ] unit-test
[ ] [ "test-quux.txt" temp-file ascii [ [ yield "Hi" write ] "Test" spawn drop ] with-file-writer ] unit-test
[ ] [ "test-quux.txt" temp-file delete-file ] unit-test
[ ] [ "test-quux.txt" temp-file [ [ yield "Hi" write ] "Test" spawn drop ] with-file-writer ] unit-test
[ ] [ "test-quux.txt" temp-file ascii [ [ yield "Hi" write ] "Test" spawn drop ] with-file-writer ] unit-test
[ ] [ "test-quux.txt" "quux-test.txt" [ temp-file ] 2apply move-file ] unit-test
[ t ] [ "quux-test.txt" temp-file exists? ] unit-test
@ -70,7 +70,7 @@ USING: tools.test io.files io threads kernel continuations ;
[ ] [
"delete-tree-test/a/b/c/d" temp-file
[ "Hi" print ] with-file-writer
ascii [ "Hi" print ] with-file-writer
] unit-test
[ ] [
@ -83,7 +83,7 @@ USING: tools.test io.files io threads kernel continuations ;
[ ] [
"copy-tree-test/a/b/c/d" temp-file
[ "Foobar" write ] with-file-writer
ascii [ "Foobar" write ] with-file-writer
] unit-test
[ ] [
@ -92,7 +92,7 @@ USING: tools.test io.files io threads kernel continuations ;
] unit-test
[ "Foobar" ] [
"copy-destination/a/b/c/d" temp-file file-contents
"copy-destination/a/b/c/d" temp-file ascii file-contents
] unit-test
[ ] [
@ -105,7 +105,7 @@ USING: tools.test io.files io threads kernel continuations ;
] unit-test
[ "Foobar" ] [
"copy-destination/copy-tree-test/a/b/c/d" temp-file file-contents
"copy-destination/copy-tree-test/a/b/c/d" temp-file ascii file-contents
] unit-test
[ ] [
@ -113,7 +113,7 @@ USING: tools.test io.files io threads kernel continuations ;
] unit-test
[ "Foobar" ] [
"d" temp-file file-contents
"d" temp-file ascii file-contents
] unit-test
[ ] [ "d" temp-file delete-file ] unit-test

82
core/io/files/files.factor
View File

@ -1,11 +1,28 @@
! Copyright (C) 2004, 2008 Slava Pestov.
! Copyright (C) 2004, 2008 Slava Pestov, Daniel Ehrenberg.
! See http://factorcode.org/license.txt for BSD license.
USING: io.backend io.files.private io hashtables kernel math
memory namespaces sequences strings assocs arrays definitions
system combinators splitting sbufs continuations ;
system combinators splitting sbufs continuations io.encodings
io.encodings.binary ;
IN: io.files
HOOK: (file-reader) io-backend ( path -- stream )
HOOK: (file-writer) io-backend ( path -- stream )
HOOK: (file-appender) io-backend ( path -- stream )
: <file-reader> ( path encoding -- stream )
swap (file-reader) swap <decoder> ;
: <file-writer> ( path encoding -- stream )
swap (file-writer) swap <encoder> ;
: <file-appender> ( path encoding -- stream )
swap (file-appender) swap <encoder> ;
HOOK: rename-file io-backend ( from to -- )
! Pathnames
: path-separator? ( ch -- ? ) windows? "/\\" "/" ? member? ;
@ -147,6 +164,14 @@ HOOK: move-file io-backend ( from to -- )
! Copying files
HOOK: copy-file io-backend ( from to -- )
M: object copy-file
dup parent-directory make-directories
binary <file-writer> [
swap binary <file-reader> [
swap stream-copy
] with-disposal
] with-disposal ;
: copy-file-into ( from to -- )
to-directory copy-file ;
@ -181,6 +206,28 @@ DEFER: copy-tree-into
: resource-exists? ( path -- ? )
?resource-path exists? ;
! Pathname presentations
TUPLE: pathname string ;
C: <pathname> pathname
M: pathname <=> [ pathname-string ] compare ;
: file-lines ( path encoding -- seq ) <file-reader> lines ;
: file-contents ( path encoding -- str )
dupd <file-reader> swap file-length <sbuf>
[ stream-copy ] keep >string ;
: with-file-reader ( path encoding quot -- )
>r <file-reader> r> with-stream ; inline
: with-file-writer ( path encoding quot -- )
>r <file-writer> r> with-stream ; inline
: with-file-appender ( path encoding quot -- )
>r <file-appender> r> with-stream ; inline
: temp-directory ( -- path )
"temp" resource-path
dup exists? not
@ -189,35 +236,6 @@ DEFER: copy-tree-into
: temp-file ( name -- path ) temp-directory swap path+ ;
! Pathname presentations
TUPLE: pathname string ;
C: <pathname> pathname
M: pathname <=> [ pathname-string ] compare ;
! Streams
HOOK: <file-reader> io-backend ( path -- stream )
HOOK: <file-writer> io-backend ( path -- stream )
HOOK: <file-appender> io-backend ( path -- stream )
: file-lines ( path -- seq ) <file-reader> lines ;
: file-contents ( path -- str )
dup <file-reader> swap file-length <sbuf>
[ stream-copy ] keep >string ;
: with-file-reader ( path quot -- )
>r <file-reader> r> with-stream ; inline
: with-file-writer ( path quot -- )
>r <file-writer> r> with-stream ; inline
: with-file-appender ( path quot -- )
>r <file-appender> r> with-stream ; inline
! Home directory
: home ( -- dir )
{

2
core/io/io-docs.factor
View File

@ -100,7 +100,7 @@ $nl
{ $subsection "stream-protocol" }
{ $subsection "stdio" }
{ $subsection "stream-utils" }
{ $see-also "io.streams.string" "io.streams.lines" "io.streams.plain" "io.streams.duplex" } ;
{ $see-also "io.streams.string" "io.streams.plain" "io.streams.duplex" } ;
ABOUT: "streams"

11
core/io/io-tests.factor Normal file → Executable file
View File

@ -1,5 +1,6 @@
USING: arrays io io.files kernel math parser strings system
tools.test words namespaces ;
tools.test words namespaces io.encodings.latin1
io.encodings.binary ;
IN: io.tests
[ f ] [
@ -8,7 +9,7 @@ IN: io.tests
] unit-test
: <resource-reader> ( resource -- stream )
resource-path <file-reader> ;
resource-path latin1 <file-reader> ;
[
"This is a line.\rThis is another line.\r"
@ -31,10 +32,10 @@ IN: io.tests
! [ ] [ "123" write 9000 CHAR: x <string> write flush ] unit-test
[ "" ] [
[
"/core/io/test/binary.txt" <resource-reader>
[ 0.2 read ] with-stream
] unit-test
] must-fail
[
{
@ -53,7 +54,7 @@ IN: io.tests
] unit-test
[ ] [
image [
image binary [
10 [ 65536 read drop ] times
] with-file-reader
] unit-test

33
core/io/streams/byte-array/byte-array-docs.factor Normal file
View File

@ -0,0 +1,33 @@
USING: help.syntax help.markup io byte-arrays quotations ;
IN: io.streams.byte-array
ABOUT: "io.streams.byte-array"
ARTICLE: "io.streams.byte-array" "Byte-array streams"
"Byte array streams:"
{ $subsection <byte-reader> }
{ $subsection <byte-writer> }
"Utility combinators:"
{ $subsection with-byte-reader }
{ $subsection with-byte-writer } ;
HELP: <byte-reader>
{ $values { "byte-array" byte-array }
{ "encoding" "an encoding descriptor" } }
{ $description "Provides an input stream reading off the given byte array using the given encoding." } ;
HELP: <byte-writer>
{ $values { "encoding" "an encoding descriptor" }
{ "stream" "an output stream" } }
{ $description "Provides an output stream, putting things in the given encoding, storing everything written to it in a byte-array." } ;
HELP: with-byte-reader
{ $values { "encoding" "an encoding descriptor" }
{ "quot" quotation } { "byte-array" byte-array } }
{ $description "Calls the quotation in a new dynamic scope with " { $link stdio } " rebound to an input stream reading the byte array in the given encoding from beginning to end." } ;
HELP: with-byte-writer
{ $values { "encoding" "an encoding descriptor" }
{ "quot" quotation }
{ "byte-array" byte-array } }
{ $description "Calls the quotation in a new dynamic scope with " { $link stdio } " rebound to a new byte array writer, putting things in the given encoding. The accumulated byte array is output when the quotation returns." } ;

4
core/io/streams/byte-array/byte-array.factor
View File

@ -3,14 +3,14 @@ sequences io namespaces ;
IN: io.streams.byte-array
: <byte-writer> ( encoding -- stream )
512 <byte-vector> swap <encoding> ;
512 <byte-vector> swap <encoder> ;
: with-byte-writer ( encoding quot -- byte-array )
>r <byte-writer> r> [ stdio get ] compose with-stream*
>byte-array ; inline
: <byte-reader> ( byte-array encoding -- stream )
>r >byte-vector dup reverse-here r> <decoding> ;
>r >byte-vector dup reverse-here r> <decoder> ;
: with-byte-reader ( byte-array encoding quot -- )
>r <byte-reader> r> with-stream ; inline

5
core/io/streams/c/c-docs.factor
View File

@ -6,7 +6,6 @@ ARTICLE: "io.streams.c" "ANSI C streams"
"C streams are found in the " { $vocab-link "io.streams.c" } " vocabulary; they are " { $link "stream-protocol" } " implementations which read and write C " { $snippet "FILE*" } " handles."
{ $subsection <c-reader> }
{ $subsection <c-writer> }
{ $subsection <duplex-c-stream> }
"Underlying primitives used to implement the above:"
{ $subsection fopen }
{ $subsection fwrite }
@ -31,10 +30,6 @@ HELP: <c-writer> ( out -- stream )
{ $description "Creates a stream which writes data by calling C standard library functions." }
{ $notes "Usually C streams are only used during bootstrap, and non-blocking OS-specific I/O routines are used during normal operation." } ;
HELP: <duplex-c-stream>
{ $values { "in" "a C FILE* handle" } { "out" "a C FILE* handle" } { "stream" "a new stream" } }
{ $description "Creates a stream which reads and writes data by calling C standard library functions, wrapping the input portion in a " { $link line-reader } " and the output portion in a " { $link plain-writer } "." } ;
HELP: fopen ( path mode -- alien )
{ $values { "path" "a pathname string" } { "mode" "an access mode specifier" } { "alien" "a C FILE* handle" } }
{ $description "Opens a file named by " { $snippet "path" } ". The " { $snippet "mode" } " parameter should be something like " { $snippet "\"r\"" } " or " { $snippet "\"rw\"" } "; consult the " { $snippet "fopen(3)" } " manual page for details." }

6
core/io/streams/c/c-tests.factor
View File

@ -1,10 +1,12 @@
USING: tools.test io.files io io.streams.c ;
USING: tools.test io.files io io.streams.c
io.encodings.ascii strings ;
IN: io.streams.c.tests
[ "hello world" ] [
"test.txt" temp-file [
"test.txt" temp-file ascii [
"hello world" write
] with-file-writer
"test.txt" temp-file "rb" fopen <c-reader> contents
>string
] unit-test

41
core/io/streams/c/c.factor
View File

@ -1,9 +1,8 @@
! Copyright (C) 2004, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel kernel.private namespaces io
strings sequences math generic threads.private classes
io.backend io.streams.lines io.streams.plain io.streams.duplex
io.files continuations ;
USING: kernel kernel.private namespaces io io.encodings
sequences math generic threads.private classes io.backend
io.streams.duplex io.files continuations byte-arrays ;
IN: io.streams.c
TUPLE: c-writer handle ;
@ -11,7 +10,7 @@ TUPLE: c-writer handle ;
C: <c-writer> c-writer
M: c-writer stream-write1
>r 1string r> stream-write ;
c-writer-handle fputc ;
M: c-writer stream-write
c-writer-handle fwrite ;
@ -27,7 +26,7 @@ TUPLE: c-reader handle ;
C: <c-reader> c-reader
M: c-reader stream-read
>r >fixnum r> c-reader-handle fread ;
c-reader-handle fread ;
M: c-reader stream-read-partial
stream-read ;
@ -43,41 +42,39 @@ M: c-reader stream-read1
] if ;
M: c-reader stream-read-until
[ swap read-until-loop ] "" make swap
[ swap read-until-loop ] B{ } make swap
over empty? over not and [ 2drop f f ] when ;
M: c-reader dispose
c-reader-handle fclose ;
: <duplex-c-stream> ( in out -- stream )
>r <c-reader> <line-reader> r>
<c-writer> <plain-writer>
<duplex-stream> ;
M: object init-io ;
: stdin-handle 11 getenv ;
: stdout-handle 12 getenv ;
: stderr-handle 38 getenv ;
M: object init-stdio
stdin-handle stdout-handle <duplex-c-stream> stdio set-global
stderr-handle <c-writer> <plain-writer> stderr set-global ;
M: object (init-stdio)
stdin-handle <c-reader>
stdout-handle <c-writer>
stderr-handle <c-writer> ;
M: object io-multiplex 60 60 * 1000 * or (sleep) ;
M: object <file-reader>
"rb" fopen <c-reader> <line-reader> ;
M: object (file-reader)
"rb" fopen <c-reader> ;
M: object <file-writer>
"wb" fopen <c-writer> <plain-writer> ;
M: object (file-writer)
"wb" fopen <c-writer> ;
M: object <file-appender>
"ab" fopen <c-writer> <plain-writer> ;
M: object (file-appender)
"ab" fopen <c-writer> ;
: show ( msg -- )
#! A word which directly calls primitives. It is used to
#! print stuff from contexts where the I/O system would
#! otherwise not work (tools.deploy.shaker, the I/O
#! multiplexer thread).
"\r\n" append stdout-handle fwrite stdout-handle fflush ;
"\r\n" append >byte-array
stdout-handle fwrite
stdout-handle fflush ;

1
core/io/streams/lines/authors.txt
View File

@ -1 +0,0 @@
Slava Pestov

17
core/io/streams/lines/lines-docs.factor
View File

@ -1,17 +0,0 @@
USING: help.markup help.syntax io strings ;
IN: io.streams.lines
ARTICLE: "io.streams.lines" "Line reader streams"
"Line reader streams wrap an underlying stream and provide a default implementation of " { $link stream-readln } "."
{ $subsection line-reader }
{ $subsection <line-reader> } ;
ABOUT: "io.streams.lines"
HELP: line-reader
{ $class-description "An input stream which delegates to an underlying stream while providing an implementation of the " { $link stream-readln } " word in terms of the underlying stream's " { $link stream-read-until } ". Line readers are created by calling " { $link <line-reader> } "." } ;
HELP: <line-reader>
{ $values { "stream" "an input stream" } { "new-stream" "an input stream" } }
{ $description "Creates a new " { $link line-reader } "." }
{ $notes "Stream constructors should call this word to wrap streams that do not natively support reading lines. Unix (" { $snippet "\\n" } "), Windows (" { $snippet "\\r\\n" } ") and MacOS (" { $snippet "\\r" } ") line endings are supported." } ;

57
core/io/streams/lines/lines.factor
View File

@ -1,57 +0,0 @@
! Copyright (C) 2004, 2007 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
IN: io.streams.lines
USING: arrays generic io kernel math namespaces sequences
vectors combinators splitting ;
TUPLE: line-reader cr ;
: <line-reader> ( stream -- new-stream )
line-reader construct-delegate ;
: cr+ t swap set-line-reader-cr ; inline
: cr- f swap set-line-reader-cr ; inline
: line-ends/eof ( stream str -- str ) f like swap cr- ; inline
: line-ends\r ( stream str -- str ) swap cr+ ; inline
: line-ends\n ( stream str -- str )
over line-reader-cr over empty? and
[ drop dup cr- stream-readln ] [ swap cr- ] if ; inline
: handle-readln ( stream str ch -- str )
{
{ f [ line-ends/eof ] }
{ CHAR: \r [ line-ends\r ] }
{ CHAR: \n [ line-ends\n ] }
} case ;
M: line-reader stream-readln ( stream -- str )
"\r\n" over delegate stream-read-until handle-readln ;
: fix-read ( stream string -- string )
over line-reader-cr [
over cr-
"\n" ?head [
swap stream-read1 [ add ] when*
] [ nip ] if
] [ nip ] if ;
M: line-reader stream-read
tuck delegate stream-read fix-read ;
M: line-reader stream-read-partial
tuck delegate stream-read-partial fix-read ;
: fix-read1 ( stream char -- char )
over line-reader-cr [
over cr-
dup CHAR: \n = [
drop stream-read1
] [ nip ] if
] [ nip ] if ;
M: line-reader stream-read1 ( stream -- char )
dup delegate stream-read1 fix-read1 ;

1
core/io/streams/lines/summary.txt
View File

@ -1 +0,0 @@
Read lines of text from a character-oriented stream

11
core/io/streams/plain/plain-docs.factor
View File

@ -8,17 +8,10 @@ ARTICLE: "io.streams.plain" "Plain writer streams"
{ $link make-span-stream } ", "
{ $link make-block-stream } " and "
{ $link make-cell-stream } "."
{ $subsection plain-writer }
{ $subsection <plain-writer> } ;
{ $subsection plain-writer } ;
ABOUT: "io.streams.plain"
HELP: plain-writer
{ $class-description "An output stream which delegates to an underlying stream while providing an implementation of the extended stream output protocol in a trivial way. Plain writers are created by calling " { $link <plain-writer> } "." }
{ $see-also "stream-protocol" } ;
HELP: <plain-writer>
{ $values { "stream" "an input stream" } { "new-stream" "an input stream" } }
{ $description "Creates a new " { $link plain-writer } "." }
{ $notes "Stream constructors should call this word to wrap streams that do not natively support the extended stream output protocol." }
{ $class-description "An output stream mixin providing an implementation of the extended stream output protocol in a trivial way." }
{ $see-also "stream-protocol" } ;

8
core/io/streams/plain/plain.factor
View File

@ -1,13 +1,9 @@
! Copyright (C) 2005, 2007 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel io io.streams.nested ;
IN: io.streams.plain
USING: generic assocs kernel math namespaces sequences
io.styles io io.streams.nested ;
TUPLE: plain-writer ;
: <plain-writer> ( stream -- new-stream )
plain-writer construct-delegate ;
MIXIN: plain-writer
M: plain-writer stream-nl
CHAR: \n swap stream-write1 ;

2
core/io/streams/string/string-docs.factor
View File

@ -26,4 +26,4 @@ HELP: <string-reader>
HELP: with-string-reader
{ $values { "str" string } { "quot" quotation } }
{ $description "Calls the quotation in a new dynamic scope with " { $link stdio } " rebound to an input stream reading " { $snippet "str" } " from beginning to end. The accumulated string is output when the quotation returns." } ;
{ $description "Calls the quotation in a new dynamic scope with " { $link stdio } " rebound to an input stream reading " { $snippet "str" } " from beginning to end." } ;

53
core/io/streams/string/string.factor
View File

@ -2,8 +2,8 @@
! See http://factorcode.org/license.txt for BSD license.
IN: io.streams.string
USING: io kernel math namespaces sequences sbufs strings
generic splitting io.streams.plain io.streams.lines growable
continuations ;
generic splitting growable continuations io.streams.plain
io.encodings ;
M: growable dispose drop ;
@ -12,38 +12,19 @@ M: growable stream-write push-all ;
M: growable stream-flush drop ;
: <string-writer> ( -- stream )
512 <sbuf> <plain-writer> ;
512 <sbuf> ;
: with-string-writer ( quot -- str )
<string-writer> swap [ stdio get ] compose with-stream*
>string ; inline
: format-column ( seq ? -- seq )
[
[ 0 [ length max ] reduce ] keep
swap [ CHAR: \s pad-right ] curry map
] unless ;
: map-last ( seq quot -- seq )
swap dup length <reversed>
[ zero? rot [ call ] keep swap ] 2map nip ; inline
: format-table ( table -- seq )
flip [ format-column ] map-last
flip [ " " join ] map ;
M: plain-writer stream-write-table
[ drop format-table [ print ] each ] with-stream* ;
M: plain-writer make-cell-stream 2drop <string-writer> ;
M: growable stream-read1 dup empty? [ drop f ] [ pop ] if ;
: harden-as ( seq growble-exemplar -- newseq )
underlying like ;
: growable-read-until ( growable n -- str )
dupd tail-slice swap harden-as dup reverse-here ;
>fixnum dupd tail-slice swap harden-as dup reverse-here ;
: find-last-sep swap [ memq? ] curry find-last drop ;
@ -69,7 +50,31 @@ M: growable stream-read-partial
stream-read ;
: <string-reader> ( str -- stream )
>sbuf dup reverse-here <line-reader> ;
>sbuf dup reverse-here f <decoder> ;
: with-string-reader ( str quot -- )
>r <string-reader> r> with-stream ; inline
INSTANCE: growable plain-writer
: format-column ( seq ? -- seq )
[
[ 0 [ length max ] reduce ] keep
swap [ CHAR: \s pad-right ] curry map
] unless ;
: map-last ( seq quot -- seq )
swap dup length <reversed>
[ zero? rot [ call ] keep swap ] 2map nip ; inline
: format-table ( table -- seq )
flip [ format-column ] map-last
flip [ " " join ] map ;
M: plain-writer stream-write-table
[ drop format-table [ print ] each ] with-stream* ;
M: plain-writer make-cell-stream 2drop <string-writer> ;
M: growable stream-readln ( stream -- str )
"\r\n" over stream-read-until handle-readln ;

4
core/listener/listener.factor
View File

@ -1,7 +1,7 @@
! Copyright (C) 2003, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: arrays hashtables io kernel math math.parser memory
namespaces parser sequences strings io.styles io.streams.lines
namespaces parser sequences strings io.styles
io.streams.duplex vectors words generic system combinators
tuples continuations debugger definitions compiler.units ;
IN: listener
@ -32,7 +32,7 @@ GENERIC: stream-read-quot ( stream -- quot/f )
3drop f
] if ;
M: line-reader stream-read-quot
M: object stream-read-quot
V{ } clone read-quot-loop ;
M: duplex-stream stream-read-quot

4
core/parser/parser.factor
View File

@ -4,7 +4,7 @@ USING: arrays definitions generic assocs kernel math
namespaces prettyprint sequences strings vectors words
quotations inspector io.styles io combinators sorting
splitting math.parser effects continuations debugger
io.files io.streams.string io.streams.lines vocabs
io.files io.streams.string vocabs io.encodings.utf8
source-files classes hashtables compiler.errors compiler.units ;
IN: parser
@ -500,7 +500,7 @@ SYMBOL: interactive-vocabs
[
[
[ parsing-file ] keep
[ ?resource-path <file-reader> ] keep
[ ?resource-path utf8 <file-reader> ] keep
parse-stream
] with-compiler-errors
] [

8
core/source-files/source-files.factor
View File

@ -4,8 +4,8 @@ USING: arrays definitions generic assocs kernel math
namespaces prettyprint sequences strings vectors words
quotations inspector io.styles io combinators sorting
splitting math.parser effects continuations debugger
io.files io.crc32 io.streams.string io.streams.lines vocabs
hashtables graphs compiler.units ;
io.files io.crc32 io.streams.string vocabs
hashtables graphs compiler.units io.encodings.utf8 ;
IN: source-files
SYMBOL: source-files
@ -17,7 +17,7 @@ uses definitions ;
: (source-modified?) ( path modified checksum -- ? )
pick file-modified rot [ 0 or ] 2apply >
[ swap file-lines lines-crc32 = not ] [ 2drop f ] if ;
[ swap utf8 file-lines lines-crc32 = not ] [ 2drop f ] if ;
: source-modified? ( path -- ? )
dup source-files get at [
@ -70,7 +70,7 @@ uses definitions ;
swap ?resource-path dup exists?
[
over record-modified
file-lines swap record-checksum
utf8 file-lines swap record-checksum
] [ 2drop ] if
] assoc-each ;

2
core/vocabs/loader/loader.factor
View File

@ -2,7 +2,7 @@
! See http://factorcode.org/license.txt for BSD license.
USING: namespaces sequences io.files kernel assocs words vocabs
definitions parser continuations inspector debugger io io.styles
io.streams.lines hashtables sorting prettyprint source-files
hashtables sorting prettyprint source-files
arrays combinators strings system math.parser compiler.errors
splitting init ;
IN: vocabs.loader

4
core/words/words-docs.factor
View File

@ -1,5 +1,5 @@
USING: definitions help.markup help.syntax kernel
kernel.private parser words.private vocabs classes quotations
USING: definitions help.markup help.syntax kernel parser
kernel.private words.private vocabs classes quotations
strings effects compiler.units ;
IN: words

6
core/words/words-tests.factor
View File

@ -141,7 +141,11 @@ SYMBOL: quot-uses-b
[ { + } ] [ \ quot-uses-b uses ] unit-test
[ "IN: words.tests FORGET: undef-test : undef-test ; << undef-test >>" eval ]
"undef-test" "words.tests" lookup [
[ forget ] with-compilation-unit
] when*
[ "IN: words.tests : undef-test ; << undef-test >>" eval ]
[ [ undefined? ] is? ] must-fail-with
[ ] [

4
extra/benchmark/fasta/fasta.factor
View File

@ -1,6 +1,6 @@
! Based on http://shootout.alioth.debian.org/gp4/benchmark.php?test=fasta&lang=java&id=2
USING: math kernel io io.files locals multiline assocs sequences
sequences.private benchmark.reverse-complement hints
sequences.private benchmark.reverse-complement hints io.encodings.ascii
byte-arrays float-arrays ;
IN: benchmark.fasta
@ -94,7 +94,7 @@ HINTS: random fixnum ;
n [ ]
seed [ initial-seed ] |
out [
out ascii [
n 2 * ALU "Homo sapiens alu" "ONE" write-repeat-fasta
initial-seed

4
extra/benchmark/knucleotide/knucleotide.factor
View File

@ -1,4 +1,4 @@
USING: kernel io io.files splitting strings
USING: kernel io io.files splitting strings io.encodings.ascii
hashtables sequences assocs math namespaces prettyprint
math.parser combinators arrays sorting unicode.case ;
@ -57,7 +57,7 @@ IN: benchmark.knucleotide
: knucleotide ( -- )
"extra/benchmark/knucleotide/knucleotide-input.txt" resource-path
[ read-input ] with-file-reader
ascii [ read-input ] with-file-reader
process-input ;
MAIN: knucleotide

4
extra/benchmark/mandel/mandel.factor
View File

@ -1,6 +1,6 @@
IN: benchmark.mandel
USING: arrays io kernel math namespaces sequences strings sbufs
math.functions math.parser io.files colors.hsv ;
math.functions math.parser io.files colors.hsv io.encodings.binary ;
: max-color 360 ; inline
: zoom-fact 0.8 ; inline
@ -66,6 +66,6 @@ SYMBOL: cols
: mandel-main ( -- )
"mandel.ppm" temp-file
[ mandel write ] with-file-writer ;
binary [ mandel write ] with-file-writer ;
MAIN: mandel-main

4
extra/benchmark/raytracer/raytracer.factor
View File

@ -3,7 +3,7 @@
USING: float-arrays compiler generic io io.files kernel math
math.functions math.vectors math.parser namespaces sequences
sequences.private words ;
sequences.private words io.encodings.binary ;
IN: benchmark.raytracer
! parameters
@ -171,6 +171,6 @@ DEFER: create ( level c r -- scene )
: raytracer-main
"raytracer.pnm" temp-file
[ run write ] with-file-writer ;
binary [ run write ] with-file-writer ;
MAIN: raytracer-main

6
extra/benchmark/reverse-complement/reverse-complement.factor
View File

@ -1,6 +1,6 @@
USING: io io.files io.streams.duplex kernel sequences
sequences.private strings vectors words memoize splitting
hints unicode.case continuations ;
hints unicode.case continuations io.encodings.latin1 ;
IN: benchmark.reverse-complement
MEMO: trans-map ( -- str )
@ -32,8 +32,8 @@ HINTS: do-line vector string ;
readln [ do-line (reverse-complement) ] [ show-seq ] if* ;
: reverse-complement ( infile outfile -- )
<file-writer> [
swap <file-reader> [
latin1 <file-writer> [
swap latin1 <file-reader> [
swap <duplex-stream> [
500000 <vector> (reverse-complement)
] with-stream

8
extra/benchmark/sockets/sockets.factor
View File

@ -1,4 +1,4 @@
USING: io.sockets io kernel math threads
USING: io.sockets io kernel math threads io.encodings.ascii
debugger tools.time prettyprint concurrency.count-downs
namespaces arrays continuations ;
IN: benchmark.sockets
@ -24,13 +24,13 @@ SYMBOL: counter
: simple-server ( -- )
[
server-addr <server> dup "server" set [
server-addr ascii <server> dup "server" set [
server-loop
] with-disposal
] ignore-errors ;
: simple-client ( -- )
server-addr <client> [
server-addr ascii <client> [
CHAR: b write1 flush
number-of-requests
[ CHAR: a dup write1 flush read1 assert= ] times
@ -38,7 +38,7 @@ SYMBOL: counter
] with-stream ;
: stop-server ( -- )
server-addr <client> [
server-addr ascii <client> [
CHAR: x write1
] with-stream ;

4
extra/benchmark/sum-file/sum-file.factor
View File

@ -1,12 +1,12 @@
USING: io io.files math math.parser kernel prettyprint
benchmark.random ;
benchmark.random io.encodings.ascii ;
IN: benchmark.sum-file
: sum-file-loop ( n -- n' )
readln [ string>number + sum-file-loop ] when* ;
: sum-file ( file -- )
[ 0 sum-file-loop ] with-file-reader . ;
ascii [ 0 sum-file-loop ] with-file-reader . ;
: sum-file-main ( -- )
random-numbers-path sum-file ;

4
extra/bootstrap/image/upload/upload.factor
View File

@ -2,7 +2,7 @@
! See http://factorcode.org/license.txt for BSD license.
IN: bootstrap.image.upload
USING: http.client crypto.md5 splitting assocs kernel io.files
bootstrap.image sequences io namespaces io.launcher math ;
bootstrap.image sequences io namespaces io.launcher math io.encodings.ascii ;
SYMBOL: upload-images-destination
@ -16,7 +16,7 @@ SYMBOL: upload-images-destination
: boot-image-names images [ boot-image-name ] map ;
: compute-checksums ( -- )
checksums [
checksums ascii [
boot-image-names [ dup write bl file>md5str print ] each
] with-file-writer ;

4
extra/bunny/model/model.factor
View File

@ -1,5 +1,5 @@
USING: alien alien.c-types arrays sequences math math.vectors math.matrices
math.parser io io.files kernel opengl opengl.gl opengl.glu
math.parser io io.files kernel opengl opengl.gl opengl.glu io.encodings.ascii
opengl.capabilities shuffle http.client vectors splitting tools.time system
combinators combinators.cleave float-arrays continuations namespaces
sequences.lib ;
@ -35,7 +35,7 @@ IN: bunny.model
: read-model ( stream -- model )
"Reading model" print flush [
[ parse-model ] with-file-reader
ascii [ parse-model ] with-file-reader
[ normals ] 2keep 3array
] time ;

6
extra/concurrency/distributed/distributed.factor
View File

@ -2,7 +2,7 @@
! See http://factorcode.org/license.txt for BSD license.
USING: serialize sequences concurrency.messaging
threads io io.server qualified arrays
namespaces kernel ;
namespaces kernel io.encodings.binary ;
QUALIFIED: io.sockets
IN: concurrency.distributed
@ -15,7 +15,7 @@ SYMBOL: local-node ( -- addrspec )
[
local-node set-global
"concurrency.distributed"
[ handle-node-client ] with-server
binary [ handle-node-client ] with-server
] 2curry f spawn drop ;
: start-node ( port -- )
@ -28,7 +28,7 @@ C: <remote-process> remote-process
M: remote-process send ( message thread -- )
{ remote-process-id remote-process-node } get-slots
io.sockets:<client> [ 2array serialize ] with-stream ;
binary io.sockets:<client> [ 2array serialize ] with-stream ;
M: thread (serialize) ( obj -- )
thread-id local-node get-global

6
extra/cpu/8080/emulator/emulator.factor
View File

@ -3,7 +3,7 @@
!
USING: kernel math sequences words arrays io io.files namespaces
math.parser assocs quotations parser parser-combinators
tools.time ;
tools.time io.encodings.binary ;
IN: cpu.8080.emulator
TUPLE: cpu b c d e f h l a pc sp halted? last-interrupt cycles ram ;
@ -439,7 +439,7 @@ M: cpu reset ( cpu -- )
: load-rom ( filename cpu -- )
#! Load the contents of the file into ROM.
#! (address 0x0000-0x1FFF).
cpu-ram swap [
cpu-ram swap binary [
0 swap (load-rom)
] with-file-reader ;
@ -455,7 +455,7 @@ SYMBOL: rom-root
#! file path shoul dbe relative to the '/roms' resource path.
rom-dir [
cpu-ram [
swap first2 rom-dir swap path+ [
swap first2 rom-dir swap path+ binary [
swap (load-rom)
] with-file-reader
] curry each

6
extra/crypto/hmac/hmac.factor
View File

@ -1,6 +1,6 @@
USING: arrays combinators crypto.common crypto.md5 crypto.sha1
crypto.md5.private io io.binary io.files io.streams.string
kernel math math.vectors memoize sequences ;
kernel math math.vectors memoize sequences io.encodings.binary ;
IN: crypto.hmac
: sha1-hmac ( Ko Ki -- hmac )
@ -32,7 +32,7 @@ MEMO: opad ( -- seq ) 64 HEX: 5c <array> ;
[ init-hmac sha1-hmac ] with-stream ;
: file>sha1-hmac ( K path -- hmac )
<file-reader> stream>sha1-hmac ;
binary <file-reader> stream>sha1-hmac ;
: string>sha1-hmac ( K string -- hmac )
<string-reader> stream>sha1-hmac ;
@ -42,7 +42,7 @@ MEMO: opad ( -- seq ) 64 HEX: 5c <array> ;
[ init-hmac md5-hmac ] with-stream ;
: file>md5-hmac ( K path -- hmac )
<file-reader> stream>md5-hmac ;
binary <file-reader> stream>md5-hmac ;
: string>md5-hmac ( K string -- hmac )
<string-reader> stream>md5-hmac ;

5
extra/crypto/md5/md5.factor
View File

@ -2,7 +2,8 @@
USING: kernel io io.binary io.files io.streams.string math
math.functions math.parser namespaces splitting strings
sequences crypto.common byte-arrays locals sequences.private ;
sequences crypto.common byte-arrays locals sequences.private
io.encodings.binary ;
IN: crypto.md5
<PRIVATE
@ -186,5 +187,5 @@ PRIVATE>
: string>md5 ( string -- byte-array ) <string-reader> stream>md5 ;
: string>md5str ( string -- md5-string ) string>md5 hex-string ;
: file>md5 ( path -- byte-array ) <file-reader> stream>md5 ;
: file>md5 ( path -- byte-array ) binary <file-reader> stream>md5 ;
: file>md5str ( path -- md5-string ) file>md5 hex-string ;

6
extra/crypto/sha1/sha1.factor
View File

@ -1,6 +1,6 @@
USING: arrays combinators crypto.common kernel io io.binary
USING: arrays combinators crypto.common kernel io io.encodings.binary
io.files io.streams.string math.vectors strings sequences
namespaces math parser sequences vectors
namespaces math parser sequences vectors io.binary
hashtables ;
IN: crypto.sha1
@ -123,7 +123,7 @@ SYMBOL: K
: string>sha1 ( string -- sha1 ) <string-reader> stream>sha1 ;
: string>sha1str ( string -- str ) string>sha1 hex-string ;
: string>sha1-bignum ( string -- n ) string>sha1 be> ;
: file>sha1 ( file -- sha1 ) <file-reader> stream>sha1 ;
: file>sha1 ( file -- sha1 ) binary <file-reader> stream>sha1 ;
: string>sha1-interleave ( string -- seq )
[ zero? ] left-trim

6
extra/db/tuples/tuples-tests.factor
View File

@ -1,7 +1,7 @@
! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: io.files kernel tools.test db db.tuples
db.types continuations namespaces db.postgresql math
db.types continuations namespaces math
prettyprint tools.walker db.sqlite calendar
math.intervals ;
IN: db.tuples.tests
@ -161,8 +161,8 @@ TUPLE: annotation n paste-id summary author mode contents ;
: test-sqlite ( quot -- )
>r "tuples-test.db" temp-file sqlite-db r> with-db ;
: test-postgresql ( -- )
>r { "localhost" "postgres" "" "factor-test" } postgresql-db r> with-db ;
! : test-postgresql ( -- )
! >r { "localhost" "postgres" "" "factor-test" } postgresql-db r> with-db ;
[ native-person-schema test-tuples ] test-sqlite
[ assigned-person-schema test-tuples ] test-sqlite

2
extra/documents/documents.factor
View File

@ -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 unicode.categories ;
splitting combinators unicode.categories ;
IN: documents
: +col ( loc n -- newloc ) >r first2 r> + 2array ;

4
extra/editors/jedit/jedit.factor
View File

@ -3,11 +3,11 @@
USING: arrays definitions io kernel math
namespaces parser prettyprint sequences strings words
editors io.files io.sockets io.streams.string io.binary
math.parser ;
math.parser io.encodings.ascii ;
IN: editors.jedit
: jedit-server-info ( -- port auth )
home "/.jedit/server" path+ [
home "/.jedit/server" path+ ascii [
readln drop
readln string>number
readln string>number

6
extra/graphics/bitmap/bitmap.factor
View File

@ -4,7 +4,7 @@
USING: alien arrays byte-arrays combinators
graphics.viewer io io.binary io.files kernel libc math
math.functions namespaces opengl opengl.gl prettyprint
sequences strings ui ui.gadgets.panes ;
sequences strings ui ui.gadgets.panes io.encodings.binary ;
IN: graphics.bitmap
! Currently can only handle 24bit bitmaps.
@ -59,7 +59,7 @@ TUPLE: bitmap magic size reserved offset header-length width
dup color-index-length read swap set-bitmap-color-index ;
: load-bitmap ( path -- bitmap )
[
binary [
T{ bitmap } clone
dup parse-file-header
dup parse-bitmap-header
@ -69,7 +69,7 @@ TUPLE: bitmap magic size reserved offset header-length width
raw-bitmap>string >byte-array over set-bitmap-array ;
: save-bitmap ( bitmap path -- )
[
binary [
"BM" write
dup bitmap-array length 14 + 40 + 4 >le write
0 4 >le write

4
extra/help/cookbook/cookbook.factor
View File

@ -191,11 +191,11 @@ ARTICLE: "cookbook-io" "Input and output cookbook"
}
"Print the lines of a file in sorted order:"
{ $code
"\"lines.txt\" file-lines natural-sort [ print ] each"
"utf8 \"lines.txt\" file-lines natural-sort [ print ] each"
}
"Read 1024 bytes from a file:"
{ $code
"\"data.bin\" [ 1024 read ] with-file-reader"
"\"data.bin\" binary [ 1024 read ] with-file-reader"
}
"Convert a file of 4-byte cells from little to big endian or vice versa, by directly mapping it into memory and operating on it with sequence words:"
{ $code

7
extra/help/handbook/handbook.factor
View File

@ -2,7 +2,7 @@ USING: help help.markup help.syntax help.definitions help.topics
namespaces words sequences classes assocs vocabs kernel arrays
prettyprint.backend kernel.private io generic math system
strings sbufs vectors byte-arrays bit-arrays float-arrays
quotations ;
quotations io.streams.byte-array io.encodings.string ;
IN: help.handbook
ARTICLE: "conventions" "Conventions"
@ -176,9 +176,9 @@ ARTICLE: "io" "Input and output"
{ $subsection "streams" }
"Wrapper streams:"
{ $subsection "io.streams.duplex" }
{ $subsection "io.streams.lines" }
{ $subsection "io.streams.plain" }
{ $subsection "io.streams.string" }
{ $subsection "io.streams.byte-array" }
"Utilities:"
{ $subsection "stream-binary" }
{ $subsection "styles" }
@ -186,6 +186,9 @@ ARTICLE: "io" "Input and output"
{ $subsection "io.files" }
{ $subsection "io.mmap" }
{ $subsection "io.monitors" }
{ $heading "Encodings" }
{ $subsection "io.encodings" }
{ $subsection "io.encodings.string" }
{ $heading "Other features" }
{ $subsection "network-streams" }
{ $subsection "io.launcher" }

15
extra/html/parser/analyzer/analyzer.factor
View File

@ -1,14 +1,7 @@
USING: assocs html.parser kernel math sequences strings ascii
arrays shuffle unicode.case namespaces splitting
http.server.responders sequences.lib ;
arrays shuffle unicode.case namespaces splitting http ;
IN: html.parser.analyzer
: multi-find* ( n seq quots -- i elt )
;
: multi-find ( seq quots -- i elt )
0 -rot ;
: (find-relative)
[ >r + dup r> ?nth* [ 2drop f f ] unless ] [ 2drop f ] if ;
@ -128,8 +121,8 @@ IN: html.parser.analyzer
: href-contains? ( str tag -- ? )
tag-attributes "href" swap at* [ subseq? ] [ 2drop f ] if ;
: query>hash* ( str -- hash )
"?" split1 nip query>hash ;
: query>assoc* ( str -- hash )
"?" split1 nip query>assoc ;
! clear "http://fark.com" http-get parse-html find-links [ "go.pl" swap start ] subset [ "=" split peek ] map
@ -137,5 +130,5 @@ IN: html.parser.analyzer
! "a" over find-opening-tags-by-name
! [ nip "shipposition.phtml?call=GBTT" swap href-contains? ] assoc-subset
! first first 8 + over nth
! tag-attributes "href" swap at query>hash*
! tag-attributes "href" swap at query>assoc*
! "lat" over at "lon" rot at

5
extra/http/client/client.factor
View File

@ -2,8 +2,7 @@
! See http://factorcode.org/license.txt for BSD license.
USING: assocs http kernel math math.parser namespaces sequences
io io.sockets io.streams.string io.files io.timeouts strings
splitting continuations calendar vectors hashtables
accessors ;
splitting calendar continuations accessors vectors io.encodings.binary ;
IN: http.client
: parse-url ( url -- resource host port )
@ -79,7 +78,7 @@ PRIVATE>
: download-to ( url file -- )
#! Downloads the contents of a URL to a file.
swap http-get-stream check-response
[ swap <file-writer> stream-copy ] with-disposal ;
[ swap binary <file-writer> stream-copy ] with-disposal ;
: download ( url -- )
dup download-name download-to ;

10
extra/http/http.factor
View File

@ -2,9 +2,9 @@
! See http://factorcode.org/license.txt for BSD license.
USING: hashtables io io.streams.string kernel math namespaces
math.parser assocs sequences strings splitting ascii
io.encodings.utf8 namespaces unicode.case combinators
vectors sorting new-slots accessors calendar calendar.format
quotations arrays ;
io.encodings.utf8 io.encodings.string namespaces
unicode.case combinators vectors sorting new-slots accessors
calendar calendar.format quotations arrays ;
IN: http
: http-port 80 ; inline
@ -18,7 +18,7 @@ IN: http
swap "/_-." member? or ; foldable
: push-utf8 ( ch -- )
1string encode-utf8 [ CHAR: % , >hex 2 CHAR: 0 pad-left % ] each ;
1string utf8 encode [ CHAR: % , >hex 2 CHAR: 0 pad-left % ] each ;
: url-encode ( str -- str )
[ [
@ -50,7 +50,7 @@ IN: http
] if ;
: url-decode ( str -- str )
[ 0 swap url-decode-iter ] "" make decode-utf8 ;
[ 0 swap url-decode-iter ] "" make utf8 decode ;
: crlf "\r\n" write ;

4
extra/http/server/server.factor
View File

@ -4,7 +4,7 @@ USING: assocs kernel namespaces io io.timeouts strings splitting
threads http sequences prettyprint io.server logging calendar
new-slots html.elements accessors math.parser combinators.lib
vocabs.loader debugger html continuations random combinators
destructors ;
destructors io.encodings.latin1 ;
IN: http.server
GENERIC: call-responder ( request path responder -- response )
@ -165,7 +165,7 @@ LOG: httpd-hit NOTICE
: httpd ( port -- )
internet-server "http.server"
[ handle-client ] with-server ;
latin1 [ handle-client ] with-server ;
: httpd-main ( -- ) 8888 httpd ;

4
extra/http/server/templating/fhtml/fhtml-tests.factor Normal file → Executable file
View File

@ -1,4 +1,4 @@
USING: io io.files io.streams.string
USING: io io.files io.streams.string io.encodings.utf8
http.server.templating.fhtml kernel tools.test sequences ;
IN: http.server.templating.fhtml.tests
@ -8,7 +8,7 @@ IN: http.server.templating.fhtml.tests
".fhtml" append resource-path
[ run-template-file ] with-string-writer
] keep
".html" append resource-path file-contents = ;
".html" append resource-path utf8 file-contents = ;
[ t ] [ "example" test-template ] unit-test
[ t ] [ "bug" test-template ] unit-test

8
extra/http/server/templating/fhtml/fhtml.factor
View File

@ -2,10 +2,10 @@
! Copyright (C) 2006, 2007 Slava Pestov
! See http://factorcode.org/license.txt for BSD license.
USING: continuations sequences kernel parser namespaces io
io.files io.streams.lines io.streams.string html html.elements
io.files io.streams.string html html.elements
source-files debugger combinators math quotations generic
strings splitting accessors http.server.static http.server
assocs ;
assocs io.encodings.utf8 ;
IN: http.server.templating.fhtml
@ -83,7 +83,7 @@ DEFER: <% delimiter
templating-vocab use+
! so that reload works properly
dup source-file file set
?resource-path file-contents
?resource-path utf8 file-contents
[ eval-template ] [ html-error. drop ] recover
] with-file-vocabs
] curry assert-depth ;
@ -93,7 +93,7 @@ DEFER: <% delimiter
swap path+ run-template-file ;
: template-convert ( infile outfile -- )
[ run-template-file ] with-file-writer ;
utf8 [ run-template-file ] with-file-writer ;
! file responder integration
: serve-fhtml ( filename -- response )

4
extra/icfp/2006/2006.factor
View File

@ -2,7 +2,7 @@
! See http://factorcode.org/license.txt for BSD license.
USING: kernel math sequences kernel.private namespaces arrays io
io.files splitting io.binary math.functions vectors quotations
combinators ;
combinators io.encodings.binary ;
IN: icfp.2006
SYMBOL: regs
@ -134,7 +134,7 @@ SYMBOL: open-arrays
[ run-op exec-loop ] unless ;
: load-platters ( path -- )
file-contents 4 group [ be> ] map
binary file-contents 4 group [ be> ] map
0 arrays get set-nth ;
: init ( path -- )

2
extra/io/buffers/buffers-docs.factor
View File

@ -30,7 +30,7 @@ $nl
ABOUT: "buffers"
HELP: buffer
{ $class-description "The class of I/O buffers, which resemble FIFO queues, but are optimize for holding bytes, are have underlying storage allocated at a fixed address. Buffers must be de-allocated manually."
{ $class-description "The class of I/O buffers, which resemble FIFO queues, but are optimized for holding bytes, are have underlying storage allocated at a fixed address. Buffers must be de-allocated manually."
$nl
"Buffers have two internal pointers:"
{ $list

15
extra/io/encodings/ascii/ascii.factor Normal file
View File

@ -0,0 +1,15 @@
! Copyright (C) 2008 Daniel Ehrenberg.
! See http://factorcode.org/license.txt for BSD license.
USING: io io.encodings strings kernel math sequences byte-arrays io.encodings ;
IN: io.encodings.ascii
: encode-check<= ( string stream max -- )
[ pick <= [ encode-error ] [ stream-write1 ] if ] 2curry each ;
TUPLE: ascii ;
M: ascii stream-write-encoded ( string stream encoding -- )
drop 127 encode-check<= ;
M: ascii decode-step
drop dup 128 >= [ decode-error ] [ swap push ] if ;

0
core/io/encodings/utf16/authors.txt → extra/io/encodings/ascii/authors.txt
View File

1
extra/io/encodings/ascii/summary.txt Normal file
View File

@ -0,0 +1 @@
ASCII encoding for streams

0
core/io/encodings/utf16/tags.txt → extra/io/encodings/ascii/tags.txt
View File

1
extra/io/encodings/latin1/authors.txt Normal file
View File

@ -0,0 +1 @@
Daniel Ehrenberg

0
core/io/encodings/latin1/latin1-docs.factor → extra/io/encodings/latin1/latin1-docs.factor
View File

12
extra/io/encodings/latin1/latin1.factor Executable file
View File

@ -0,0 +1,12 @@
! Copyright (C) 2008 Daniel Ehrenberg.
! See http://factorcode.org/license.txt for BSD license.
USING: io io.encodings strings kernel io.encodings.ascii sequences math ;
IN: io.encodings.latin1
TUPLE: latin1 ;
M: latin1 stream-write-encoded
drop 255 encode-check<= ;
M: latin1 decode-step
drop dup 256 >= [ decode-error ] [ swap push ] if ;

0
core/io/encodings/latin1/summary.txt → extra/io/encodings/latin1/summary.txt
View File

1
extra/io/encodings/latin1/tags.txt Normal file
View File

@ -0,0 +1 @@
text

0
core/io/encodings/utf16/.utf16.factor.swo → extra/io/encodings/utf16/.utf16.factor.swo
View File

1
extra/io/encodings/utf16/authors.txt Normal file
View File

@ -0,0 +1 @@
Daniel Ehrenberg

0
core/io/encodings/utf16/summary.txt → extra/io/encodings/utf16/summary.txt
View File

1
extra/io/encodings/utf16/tags.txt Normal file
View File

@ -0,0 +1 @@
text

22
extra/io/encodings/utf16/utf16-docs.factor Normal file
View File

@ -0,0 +1,22 @@
USING: help.markup help.syntax io.encodings strings ;
IN: io.encodings.utf16
ARTICLE: "utf16" "Working with UTF-16-encoded data"
"The UTF-16 encoding is a variable-width encoding. Unicode code points are encoded as 2 or 4 byte sequences. There are three encoding descriptor classes for working with UTF-16, depending on endianness or the presence of a BOM:"
{ $subsection utf16le }
{ $subsection utf16be }
{ $subsection utf16 }
"All of these conform to the " { $link "encodings-protocol" } "." ;
ABOUT: "utf16"
HELP: utf16le
{ $class-description "The encoding protocol for UTF-16LE, that is, UTF-16 in little endian, without a byte order mark. Streams can be made which read or write wth this encoding." } ;
HELP: utf16be
{ $class-description "The encoding protocol for UTF-16BE, that is, UTF-16 in big endian, without a byte order mark. Streams can be made which read or write wth this encoding." } ;
HELP: utf16
{ $class-description "The encoding protocol for UTF-16, that is, UTF-16 with a byte order mark. This is the most useful for general input and output in UTF-16. Streams can be made which read or write wth this encoding." } ;
{ utf16 utf16le utf16be } related-words

22
extra/io/encodings/utf16/utf16-tests.factor Executable file
View File

@ -0,0 +1,22 @@
USING: kernel tools.test io.encodings.utf16 arrays sbufs
sequences io.encodings io unicode io.encodings.string ;
[ { CHAR: x } ] [ { 0 CHAR: x } utf16be decode >array ] unit-test
[ { HEX: 1D11E } ] [ { HEX: D8 HEX: 34 HEX: DD HEX: 1E } utf16be decode >array ] unit-test
[ { CHAR: replacement-character } ] [ { BIN: 11011111 CHAR: q } utf16be decode >array ] unit-test
[ { CHAR: replacement-character } ] [ { BIN: 11011011 CHAR: x BIN: 11011011 CHAR: x } utf16be decode >array ] unit-test
[ { 0 120 216 52 221 30 } ] [ { CHAR: x HEX: 1d11e } utf16be encode >array ] unit-test
[ { CHAR: x } ] [ { CHAR: x 0 } utf16le decode >array ] unit-test
[ { 119070 } ] [ { HEX: 34 HEX: D8 HEX: 1E HEX: DD } utf16le decode >array ] unit-test
[ { CHAR: replacement-character } ] [ { 0 BIN: 11011111 } utf16le decode >array ] unit-test
[ { CHAR: replacement-character } ] [ { 0 BIN: 11011011 0 0 } utf16le decode >array ] unit-test
[ { 119070 } ] [ { HEX: 34 HEX: D8 HEX: 1E HEX: DD } utf16le decode >array ] unit-test
[ { 120 0 52 216 30 221 } ] [ { CHAR: x HEX: 1d11e } utf16le encode >array ] unit-test
[ { CHAR: x } ] [ { HEX: ff HEX: fe CHAR: x 0 } utf16 decode >array ] unit-test
[ { CHAR: x } ] [ { HEX: fe HEX: ff 0 CHAR: x } utf16 decode >array ] unit-test
[ { HEX: ff HEX: fe 120 0 52 216 30 221 } ] [ { CHAR: x HEX: 1d11e } utf16 encode >array ] unit-test

115
core/io/encodings/utf16/utf16.factor → extra/io/encodings/utf16/utf16.factor
View File

@ -1,9 +1,13 @@
! Copyright (C) 2006, 2007 Daniel Ehrenberg.
! Copyright (C) 2006, 2008 Daniel Ehrenberg.
! See http://factorcode.org/license.txt for BSD license.
USING: math kernel sequences sbufs vectors namespaces io.binary
io.encodings combinators splitting io byte-arrays ;
IN: io.encodings.utf16
! UTF-16BE decoding
TUPLE: utf16be ch state ;
SYMBOL: double
SYMBOL: quad1
SYMBOL: quad2
@ -16,7 +20,7 @@ SYMBOL: ignore
8 shift bitor ;
: end-multibyte ( buf byte ch -- buf ch state )
append-nums decoded ;
append-nums push-decoded ;
: begin-utf16be ( buf byte -- buf ch state )
dup -3 shift BIN: 11011 number= [
@ -36,12 +40,24 @@ SYMBOL: ignore
{ double [ end-multibyte ] }
{ quad1 [ append-nums quad2 ] }
{ quad2 [ handle-quad2be ] }
{ quad3 [ append-nums HEX: 10000 + decoded ] }
{ quad3 [ append-nums HEX: 10000 + push-decoded ] }
{ ignore [ 2drop push-replacement ] }
} case ;
: decode-utf16be ( seq -- str )
[ decode-utf16be-step ] decode ;
: unpack-state-be ( encoding -- ch state )
{ utf16be-ch utf16be-state } get-slots ;
: pack-state-be ( ch state encoding -- )
{ set-utf16be-ch set-utf16be-state } set-slots ;
M: utf16be decode-step
[ unpack-state-be decode-utf16be-step ] keep pack-state-be drop ;
M: utf16be init-decoder nip begin over set-utf16be-state ;
! UTF-16LE decoding
TUPLE: utf16le ch state ;
: handle-double ( buf byte ch -- buf ch state )
swap dup -3 shift BIN: 11011 = [
@ -52,7 +68,7 @@ SYMBOL: ignore
: handle-quad3le ( buf byte ch -- buf ch state )
swap dup -2 shift BIN: 110111 = [
BIN: 11 bitand append-nums HEX: 10000 + decoded
BIN: 11 bitand append-nums HEX: 10000 + push-decoded
] [ 2drop push-replacement ] if ;
: decode-utf16le-step ( buf byte ch state -- buf ch state )
@ -64,8 +80,18 @@ SYMBOL: ignore
{ quad3 [ handle-quad3le ] }
} case ;
: decode-utf16le ( seq -- str )
[ decode-utf16le-step ] decode ;
: unpack-state-le ( encoding -- ch state )
{ utf16le-ch utf16le-state } get-slots ;
: pack-state-le ( ch state encoding -- )
{ set-utf16le-ch set-utf16le-state } set-slots ;
M: utf16le decode-step
[ unpack-state-le decode-utf16le-step ] keep pack-state-le drop ;
M: utf16le init-decoder nip begin over set-utf16le-state ;
! UTF-16LE/BE encoding
: encode-first
-10 shift
@ -80,73 +106,50 @@ SYMBOL: ignore
: char>utf16be ( char -- )
dup HEX: FFFF > [
HEX: 10000 -
dup encode-first swap , ,
encode-second swap , ,
] [ h>b/b , , ] if ;
dup encode-first swap write1 write1
encode-second swap write1 write1
] [ h>b/b write1 write1 ] if ;
: encode-utf16be ( str -- seq )
[ [ char>utf16be ] each ] B{ } make ;
: stream-write-utf16be ( string stream -- )
[ [ char>utf16be ] each ] with-stream* ;
M: utf16be stream-write-encoded ( string stream encoding -- )
drop stream-write-utf16be ;
: char>utf16le ( char -- )
dup HEX: FFFF > [
HEX: 10000 -
dup encode-first , ,
encode-second , ,
] [ h>b/b swap , , ] if ;
dup encode-first write1 write1
encode-second write1 write1
] [ h>b/b swap write1 write1 ] if ;
: encode-utf16le ( str -- seq )
[ [ char>utf16le ] each ] B{ } make ;
: stream-write-utf16le ( string stream -- )
[ [ char>utf16le ] each ] with-stream* ;
M: utf16le stream-write-encoded ( string stream encoding -- )
drop stream-write-utf16le ;
! UTF-16
: bom-le B{ HEX: ff HEX: fe } ; inline
: bom-be B{ HEX: fe HEX: ff } ; inline
: encode-utf16 ( str -- seq )
encode-utf16le bom-le swap append ;
: start-utf16le? ( seq1 -- seq2 ? ) bom-le ?head ;
: start-utf16be? ( seq1 -- seq2 ? ) bom-be ?head ;
: decode-utf16 ( seq -- str )
{
{ [ start-utf16le? ] [ decode-utf16le ] }
{ [ start-utf16be? ] [ decode-utf16be ] }
{ [ t ] [ decode-error ] }
} cond ;
TUPLE: utf16 started? ;
TUPLE: utf16le ;
INSTANCE: utf16le encoding-stream
M: utf16le encode-string drop encode-utf16le ;
M: utf16le decode-step drop decode-utf16le-step ;
TUPLE: utf16be ;
INSTANCE: utf16be encoding-stream
M: utf16be encode-string drop encode-utf16be ;
M: utf16be decode-step drop decode-utf16be-step ;
TUPLE: utf16 encoding ;
INSTANCE: utf16 encoding-stream
M: utf16 underlying-stream delegate dup delegate [ ] [ ] ?if ; ! necessary?
M: utf16 set-underlying-stream delegate set-delegate ; ! necessary?
M: utf16 encode-string
>r encode-utf16le r>
dup utf16-encoding [ drop ]
[ t swap set-utf16-encoding bom-le swap append ] if ;
M: utf16 stream-write-encoded
dup utf16-started? [ drop ]
[ t swap set-utf16-started? bom-le over stream-write ] if
stream-write-utf16le ;
: bom>le/be ( bom -- le/be )
dup bom-le sequence= [ drop utf16le ] [
bom-be sequence= [ utf16be ] [ decode-error ] if
] if ;
: read-bom ( utf16 -- encoding )
2 over delegate stream-read bom>le/be construct-empty
[ swap set-utf16-encoding ] keep ;
M: utf16 decode-step
! inefficient: checks if bom is done many times
! This should transform itself into utf16be or utf16le after reading BOM
dup utf16-encoding [ ] [ read-bom ] ?if decode-step ;
M: utf16 init-decoder ( stream encoding -- newencoding )
2 rot stream-read bom>le/be construct-empty init-decoder ;

3
extra/io/launcher/launcher-docs.factor
View File

@ -159,8 +159,9 @@ HELP: process-stream
HELP: <process-stream>
{ $values
{ "desc" "a launch descriptor" }
{ "encoding" "an encoding descriptor" }
{ "stream" "a bidirectional stream" } }
{ $description "Launches a process and redirects its input and output via a pair of pipes which may be read and written as a stream." }
{ $description "Launches a process and redirects its input and output via a pair of pipes which may be read and written as a stream of the given encoding." }
{ $notes "Closing the stream will block until the process exits." } ;
HELP: with-process-stream

16
extra/io/launcher/launcher.factor
View File

@ -1,9 +1,9 @@
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: io io.backend io.nonblocking io.streams.duplex
io.timeouts system kernel namespaces strings hashtables
sequences assocs combinators vocabs.loader init threads
continuations math ;
USING: io io.backend io.timeouts system kernel namespaces
strings hashtables sequences assocs combinators vocabs.loader
init threads continuations math io.encodings io.streams.duplex
io.nonblocking ;
IN: io.launcher
! Non-blocking process exit notification facility
@ -125,13 +125,13 @@ M: process set-timeout set-process-timeout ;
M: process timed-out kill-process ;
HOOK: process-stream* io-backend ( desc -- stream process )
HOOK: (process-stream) io-backend ( desc -- in out process )
TUPLE: process-stream process ;
: <process-stream> ( desc -- stream )
>descriptor
[ process-stream* ] keep
: <process-stream> ( desc encoding -- stream )
swap >descriptor
[ (process-stream) >r rot <encoder-duplex> r> ] keep
+timeout+ swap at [ over set-timeout ] when*
{ set-delegate set-process-stream-process }
process-stream construct ;

7
extra/io/mmap/mmap-tests.factor
View File

@ -1,9 +1,10 @@
USING: io io.mmap io.files kernel tools.test continuations sequences ;
USING: io io.mmap io.files kernel tools.test continuations
sequences io.encodings.ascii ;
IN: io.mmap.tests
[ "mmap-test-file.txt" resource-path delete-file ] ignore-errors
[ ] [ "mmap-test-file.txt" resource-path [ "12345" write ] with-file-writer ] unit-test
[ ] [ "mmap-test-file.txt" resource-path ascii [ "12345" write ] with-file-writer ] unit-test
[ ] [ "mmap-test-file.txt" resource-path dup file-length [ CHAR: 2 0 pick set-nth drop ] with-mapped-file ] unit-test
[ 5 ] [ "mmap-test-file.txt" resource-path dup file-length [ length ] with-mapped-file ] unit-test
[ "22345" ] [ "mmap-test-file.txt" resource-path file-contents ] unit-test
[ "22345" ] [ "mmap-test-file.txt" resource-path ascii file-contents ] unit-test
[ "mmap-test-file.txt" resource-path delete-file ] ignore-errors

44
extra/io/nonblocking/nonblocking.factor
View File

@ -2,9 +2,9 @@
! See http://factorcode.org/license.txt for BSD license.
IN: io.nonblocking
USING: math kernel io sequences io.buffers io.timeouts generic
sbufs system io.streams.lines io.streams.plain io.streams.duplex
byte-vectors system io.streams.duplex io.encodings
io.backend continuations debugger classes byte-arrays namespaces
splitting dlists assocs ;
splitting dlists assocs io.encodings.binary ;
SYMBOL: default-buffer-size
64 1024 * default-buffer-size set-global
@ -38,16 +38,14 @@ GENERIC: close-handle ( handle -- )
: <buffered-port> ( handle type -- port )
default-buffer-size get <buffer> swap <port> ;
: <reader> ( handle -- stream )
input-port <buffered-port> <line-reader> ;
: <reader> ( handle -- input-port )
input-port <buffered-port> ;
: <writer> ( handle -- stream )
output-port <buffered-port> <plain-writer> ;
: <writer> ( handle -- output-port )
output-port <buffered-port> ;
: handle>duplex-stream ( in-handle out-handle -- stream )
<writer>
[ >r <reader> r> <duplex-stream> ] [ ] [ dispose ]
cleanup ;
: <reader&writer> ( read-handle write-handle -- input-port output-port )
swap <reader> [ swap <writer> ] [ ] [ dispose drop ] cleanup ;
: pending-error ( port -- )
dup port-error f rot set-port-error [ throw ] when* ;
@ -73,7 +71,7 @@ GENERIC: (wait-to-read) ( port -- )
M: input-port stream-read1
dup wait-to-read1 [ buffer-pop ] unless-eof ;
: read-step ( count port -- string/f )
: read-step ( count port -- byte-array/f )
[ wait-to-read ] 2keep
[ dupd buffer> ] unless-eof nip ;
@ -92,10 +90,10 @@ M: input-port stream-read
>r 0 max >fixnum r>
2dup read-step dup [
pick over length > [
pick <sbuf>
pick <byte-vector>
[ push-all ] keep
[ read-loop ] keep
"" like
B{ } like
] [
2nip
] if
@ -103,7 +101,7 @@ M: input-port stream-read
2nip
] if ;
: read-until-step ( separators port -- string/f separator/f )
: read-until-step ( separators port -- byte-array/f separator/f )
dup wait-to-read1
dup port-eof? [
f swap set-port-eof? drop f f
@ -111,7 +109,7 @@ M: input-port stream-read
buffer-until
] if ;
: read-until-loop ( seps port sbuf -- separator/f )
: read-until-loop ( seps port byte-vector -- separator/f )
2over read-until-step over [
>r over push-all r> dup [
>r 3drop r>
@ -122,18 +120,20 @@ M: input-port stream-read
>r 2drop 2drop r>
] if ;
M: input-port stream-read-until ( seps port -- str/f sep/f )
M: input-port stream-read-until ( seps port -- byte-array/f sep/f )
2dup read-until-step dup [
>r 2nip r>
] [
over [
drop >sbuf [ read-until-loop ] keep "" like swap
drop >byte-vector
[ read-until-loop ] keep
B{ } like swap
] [
>r 2nip r>
] if
] if ;
M: input-port stream-read-partial ( max stream -- string/f )
M: input-port stream-read-partial ( max stream -- byte-array/f )
>r 0 max >fixnum r> read-step ;
: can-write? ( len writer -- ? )
@ -171,11 +171,11 @@ M: port dispose
[ dup port-type >r closed over set-port-type r> close-port ]
if ;
TUPLE: server-port addr client ;
TUPLE: server-port addr client client-addr encoding ;
: <server-port> ( handle addr -- server )
>r f server-port <port> r>
{ set-delegate set-server-port-addr }
: <server-port> ( handle addr encoding -- server )
rot f server-port <port>
{ set-server-port-addr set-server-port-encoding set-delegate }
server-port construct ;
: check-server-port ( port -- )

2
extra/io/server/server-tests.factor
View File

@ -1,4 +1,4 @@
IN: io.server.tests
USING: tools.test io.server io.server.private ;
{ 1 0 } [ [ ] server-loop ] must-infer-as
{ 2 0 } [ [ ] server-loop ] must-infer-as

10
extra/io/server/server.factor
View File

@ -25,7 +25,7 @@ LOG: accepted-connection NOTICE
>r accept r> [ with-client ] 2curry "Client" spawn drop
] 2keep accept-loop ; inline
: server-loop ( addrspec quot -- )
: server-loop ( addrspec encoding quot -- )
>r <server> dup servers get push r>
[ accept-loop ] curry with-disposal ; inline
@ -39,12 +39,12 @@ PRIVATE>
: internet-server ( port -- seq )
f swap t resolve-host ;
: with-server ( seq service quot -- )
: with-server ( seq service encoding quot -- )
V{ } clone [
servers [
[ server-loop ] curry with-logging
swap servers [
[ server-loop ] 2curry with-logging
] with-variable
] 3curry parallel-each ; inline
] 3curry curry parallel-each ; inline
: stop-server ( -- )
servers get [ dispose ] each ;

1
extra/io/sockets/authors.txt
View File

@ -1 +1,2 @@
Slava Pestov
Daniel Ehrenberg

13
extra/io/sockets/sockets-docs.factor
View File

@ -92,20 +92,20 @@ HELP: inet6
} ;
HELP: <client>
{ $values { "addrspec" "an address specifier" } { "stream" "a bidirectional stream" } }
{ $description "Opens a network connection and outputs a bidirectional stream." }
{ $values { "addrspec" "an address specifier" } { "encoding" "an encding descriptor" } { "stream" "a bidirectional stream" } }
{ $description "Opens a network connection and outputs a bidirectional stream using the given encoding." }
{ $errors "Throws an error if the connection cannot be established." }
{ $examples
{ $code "\"www.apple.com\" \"http\" <inet> <client>" }
{ $code "\"www.apple.com\" \"http\" <inet> utf8 <client>" }
} ;
HELP: <server>
{ $values { "addrspec" "an address specifier" } { "server" "a handle" } }
{ $values { "addrspec" "an address specifier" } { "encoding" "an encoding descriptor" } { "server" "a handle" } }
{ $description
"Begins listening for network connections to a local address. Server objects responds to two words:"
{ $list
{ { $link dispose } " - stops listening on the port and frees all associated resources" }
{ { $link accept } " - blocks until there is a connection" }
{ { $link accept } " - blocks until there is a connection, and returns a stream of the encoding passed to the constructor" }
}
}
{ $notes
@ -119,7 +119,7 @@ HELP: <server>
HELP: accept
{ $values { "server" "a handle" } { "client" "a bidirectional stream" } }
{ $description "Waits for a connection to a server socket created by " { $link <server> } ", and outputs a bidirectional stream when the connection has been established."
{ $description "Waits for a connection to a server socket created by " { $link <server> } ", and outputs a bidirectional stream when the connection has been established. The encoding of this stream is the one that was passed to the server constructor."
$nl
"The returned client stream responds to the " { $link client-stream-addr } " word with the address of the incoming connection." }
{ $errors "Throws an error if the server socket is closed or otherwise is unavailable." } ;
@ -139,6 +139,7 @@ HELP: <datagram>
"To accept UDP/IP packets from the loopback interface only, use an address specifier returned by the following code, where 1234 is the desired port number:"
{ $code "\"localhost\" 1234 t resolve-host" }
"Since " { $link resolve-host } " can return multiple address specifiers, your code must create a datagram socket for each one and co-ordinate packet sending accordingly."
"Datagrams are low-level binary ports that don't map onto streams, so the constructor does not use an encoding"
}
{ $errors "Throws an error if the port is already in use, or if the OS forbids access." } ;

Some files were not shown because too many files have changed in this diff Show More