From 63ba6faee2904df1123ba4c4a162272a71998b36 Mon Sep 17 00:00:00 2001 From: Daniel Ehrenberg Date: Sat, 16 Feb 2008 15:35:44 -0600 Subject: [PATCH 01/38] Changes to I/O system for encodings --- core/io/encodings/encodings.factor | 105 +++++++++++++++++------- core/io/files/files.factor | 31 ++++--- core/io/streams/c/c.factor | 12 +-- core/io/streams/lines/lines.factor | 52 +----------- core/io/streams/plain/plain.factor | 19 +---- extra/io/nonblocking/nonblocking.factor | 4 +- extra/io/unix/files/files.factor | 6 +- extra/io/windows/windows.factor | 6 +- 8 files changed, 113 insertions(+), 122 deletions(-) diff --git a/core/io/encodings/encodings.factor b/core/io/encodings/encodings.factor index 2d94e3ea80..cab625ad73 100755 --- a/core/io/encodings/encodings.factor +++ b/core/io/encodings/encodings.factor @@ -1,13 +1,11 @@ ! Copyright (C) 2006, 2007 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 io.streams.c continuations +io.styles io.streams.nested ; IN: io.encodings -TUPLE: encode-error ; - -: encode-error ( -- * ) \ encode-error construct-empty throw ; +! Decoding TUPLE: decode-error ; @@ -19,7 +17,8 @@ SYMBOL: begin over push 0 begin ; : push-replacement ( buf -- buf ch state ) - CHAR: replacement-character decoded ; + ! This is the replacement character + HEX: fffd decoded ; : finish-decoding ( buf ch state -- str ) begin eq? [ decode-error ] unless drop "" like ; @@ -53,43 +52,89 @@ GENERIC: decode-step ( buf byte ch state encoding -- buf ch state ) >r swap start-decoding r> decode-read-loop ; -: ( stream decoding-class -- decoded-stream ) - construct-delegate ; +TUPLE: decoded code cr ; +: ( stream decoding-class -- decoded-stream ) + construct-empty { set-delegate set-decoded-code } decoded construct ; -: ( stream encoding-class -- encoded-stream ) - construct-delegate ; +: cr+ t swap set-line-reader-cr ; inline -GENERIC: encode-string ( string encoding -- byte-array ) -M: tuple-class encode-string construct-empty encode-string ; +: cr- f swap set-line-reader-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 line-reader-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 line-reader-cr [ + over cr- + "\n" ?head [ + swap stream-read1 [ add ] when* + ] [ nip ] if + ] [ nip ] if ; + +M: decoded stream-read + tuck { delegate decoded-code } get-slots decode-read fix-read ; + +M: decoded stream-read-partial tuck stream-read fix-read ; + +M: decoded stream-read-until ! Copied from { c-reader stream-read-until }!!! [ swap read-until-loop ] "" make swap over empty? over not and [ 2drop f f ] when ; -M: encoding-stream stream-write1 +: fix-read1 ( stream char -- char ) + over line-reader-cr [ + over cr- + dup CHAR: \n = [ + drop stream-read1 + ] [ nip ] if + ] [ nip ] if ; + +M: decoded stream-read1 1 over stream-read ; + +M: line-reader stream-readln ( stream -- str ) + "\r\n" over stream-read-until handle-readln ; + +! Encoding + +TUPLE: encode-error ; + +: encode-error ( -- * ) \ encode-error construct-empty throw ; + +TUPLE: encoded code ; +: ( stream encoding-class -- encoded-stream ) + construct-empty { set-delegate set-encoded-code } encoded construct ; + +GENERIC: encode-string ( string encoding -- byte-array ) +M: tuple-class encode-string construct-empty encode-string ; + +M: encoded stream-write1 >r 1string r> stream-write ; -M: encoding-stream stream-write - [ encode-string ] keep delegate stream-write ; +M: encoded stream-write + [ encoding-code encode-string ] keep delegate stream-write ; -M: encoding-stream dispose delegate dispose ; +M: encoded dispose delegate dispose ; -GENERIC: underlying-stream ( encoded-stream -- delegate ) -M: encoding-stream underlying-stream delegate ; +M: encoded stream-nl + CHAR: \n swap stream-write1 ; -GENERIC: set-underlying-stream ( new-underlying stream -- ) -M: encoding-stream set-underlying-stream set-delegate ; +M: encoded stream-format + nip stream-write ; -: set-encoding ( encoding stream -- ) ! This doesn't work now - [ underlying-stream swap construct-delegate ] keep - set-underlying-stream ; +M: encoded make-span-stream + ; + +M: encoded make-block-stream + nip ; diff --git a/core/io/files/files.factor b/core/io/files/files.factor index 4b19dd6943..5a9411aadb 100755 --- a/core/io/files/files.factor +++ b/core/io/files/files.factor @@ -3,17 +3,17 @@ IN: io.files 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 ; HOOK: cd io-backend ( path -- ) HOOK: cwd io-backend ( -- path ) -HOOK: io-backend ( path -- stream ) +HOOK: file-reader* io-backend ( path -- stream ) -HOOK: io-backend ( path -- stream ) +HOOK: file-writer* io-backend ( path -- stream ) -HOOK: io-backend ( path -- stream ) +HOOK: file-appender* io-backend ( path -- stream ) HOOK: delete-file io-backend ( path -- ) @@ -140,16 +140,25 @@ C: pathname M: pathname <=> [ pathname-string ] compare ; -: file-lines ( path -- seq ) lines ; +: ( path encoding -- stream ) + swap file-reader* swap ; -: file-contents ( path -- str ) - dup swap file-length [ stream-copy ] keep >string ; +: ( path encoding -- stream ) + swap file-writer* swap ; -: with-file-writer ( path quot -- ) - >r r> with-stream ; inline +: ( path encoding -- stream ) + swap file-appender* swap ; -: with-file-reader ( path quot -- ) +: file-lines ( path encoding -- seq ) lines ; + +: file-contents ( path encoding -- str ) + dupd swap file-length [ stream-copy ] keep >string ; + +: with-file-writer ( path encoding quot -- ) >r r> with-stream ; inline -: with-file-appender ( path quot -- ) +: with-file-reader ( path encoding quot -- ) + >r r> with-stream ; inline + +: with-file-appender ( path encoding quot -- ) >r r> with-stream ; inline diff --git a/core/io/streams/c/c.factor b/core/io/streams/c/c.factor index 288ab212d1..9c1a099318 100755 --- a/core/io/streams/c/c.factor +++ b/core/io/streams/c/c.factor @@ -66,14 +66,14 @@ M: object init-stdio M: object io-multiplex (sleep) ; -M: object - "rb" fopen ; +M: object file-reader* + "rb" fopen ; -M: object - "wb" fopen ; +M: object file-writer* + "wb" fopen ; -M: object - "ab" fopen ; +M: object file-appender* + "ab" fopen ; : show ( msg -- ) #! A word which directly calls primitives. It is used to diff --git a/core/io/streams/lines/lines.factor b/core/io/streams/lines/lines.factor index 391c602cc3..a6a5721ad8 100755 --- a/core/io/streams/lines/lines.factor +++ b/core/io/streams/lines/lines.factor @@ -1,57 +1,9 @@ ! 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 ; +USING: io.encodings.latin1 io.encodings ; TUPLE: line-reader cr ; : ( 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 ; + latin1 ; diff --git a/core/io/streams/plain/plain.factor b/core/io/streams/plain/plain.factor index 70421eb1c2..e6cf9c8afa 100644 --- a/core/io/streams/plain/plain.factor +++ b/core/io/streams/plain/plain.factor @@ -1,22 +1,7 @@ ! Copyright (C) 2005, 2007 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. IN: io.streams.plain -USING: generic assocs kernel math namespaces sequences -io.styles io io.streams.nested ; - -TUPLE: plain-writer ; +USING: io.encodings.latin1 io.encodings ; : ( stream -- new-stream ) - plain-writer construct-delegate ; - -M: plain-writer stream-nl - CHAR: \n swap stream-write1 ; - -M: plain-writer stream-format - nip stream-write ; - -M: plain-writer make-span-stream - ; - -M: plain-writer make-block-stream - nip ; + latin1 ; diff --git a/extra/io/nonblocking/nonblocking.factor b/extra/io/nonblocking/nonblocking.factor index 72507f26b6..dfdd05af53 100755 --- a/extra/io/nonblocking/nonblocking.factor +++ b/extra/io/nonblocking/nonblocking.factor @@ -40,10 +40,10 @@ GENERIC: close-handle ( handle -- ) default-buffer-size get swap ; : ( handle -- stream ) - input-port ; + input-port ; : ( handle -- stream ) - output-port ; + output-port ; : handle>duplex-stream ( in-handle out-handle -- stream ) diff --git a/extra/io/unix/files/files.factor b/extra/io/unix/files/files.factor index 3bf0e3f897..7a7128d5b6 100755 --- a/extra/io/unix/files/files.factor +++ b/extra/io/unix/files/files.factor @@ -17,7 +17,7 @@ M: unix-io cd : open-read ( path -- fd ) O_RDONLY file-mode open dup io-error ; -M: unix-io ( path -- stream ) +M: unix-io file-reader* ( path -- stream ) open-read ; : write-flags { O_WRONLY O_CREAT O_TRUNC } flags ; inline @@ -25,7 +25,7 @@ M: unix-io ( path -- stream ) : open-write ( path -- fd ) write-flags file-mode open dup io-error ; -M: unix-io ( path -- stream ) +M: unix-io file-writer* ( path -- stream ) open-write ; : append-flags { O_WRONLY O_APPEND O_CREAT } flags ; inline @@ -34,7 +34,7 @@ M: unix-io ( path -- stream ) append-flags file-mode open dup io-error [ dup 0 SEEK_END lseek io-error ] [ ] [ close ] cleanup ; -M: unix-io ( path -- stream ) +M: unix-io file-appender* ( path -- stream ) open-append ; M: unix-io rename-file ( from to -- ) diff --git a/extra/io/windows/windows.factor b/extra/io/windows/windows.factor index ee3f744bb0..dc0b14f627 100755 --- a/extra/io/windows/windows.factor +++ b/extra/io/windows/windows.factor @@ -112,13 +112,13 @@ C: FileArgs [ FileArgs-lpNumberOfBytesRet ] keep FileArgs-lpOverlapped ; -M: windows-io ( path -- stream ) +M: windows-io file-reader* ( path -- stream ) open-read ; -M: windows-io ( path -- stream ) +M: windows-io file-writer* ( path -- stream ) open-write ; -M: windows-io ( path -- stream ) +M: windows-io file-appender* ( path -- stream ) open-append ; M: windows-io rename-file ( from to -- ) From 8d5f4714fad2086f5a1e3e8089a560e824c34713 Mon Sep 17 00:00:00 2001 From: Daniel Ehrenberg Date: Sat, 16 Feb 2008 16:25:45 -0600 Subject: [PATCH 02/38] Core I/O changes for encodings --- core/io/encodings/ascii/ascii.factor | 13 ++++++++ core/io/encodings/binary/binary.factor | 5 ++-- core/io/encodings/encodings.factor | 7 +++-- core/io/encodings/latin1/latin1.factor | 10 +++---- core/io/files/files-docs.factor | 38 +++++++++++++++++------- core/io/files/files.factor | 22 +++++++------- core/io/io-tests.factor | 4 +-- core/io/streams/lines/lines-tests.factor | 4 +-- 8 files changed, 67 insertions(+), 36 deletions(-) create mode 100644 core/io/encodings/ascii/ascii.factor diff --git a/core/io/encodings/ascii/ascii.factor b/core/io/encodings/ascii/ascii.factor new file mode 100644 index 0000000000..d767f26cdd --- /dev/null +++ b/core/io/encodings/ascii/ascii.factor @@ -0,0 +1,13 @@ +USING: io io.encodings strings kernel ; +IN: io.encodings.ascii + +: encode-check>= ( string max -- byte-array ) + dupd [ >= ] curry all? [ >byte-array ] [ encoding-error ] if ; + +TUPLE: ascii ; + +M: ascii encode-string + drop 127 encode-check>= ; + +M: ascii decode-step + 3drop over push f f ; diff --git a/core/io/encodings/binary/binary.factor b/core/io/encodings/binary/binary.factor index c4c6237715..17c734b9c8 100644 --- a/core/io/encodings/binary/binary.factor +++ b/core/io/encodings/binary/binary.factor @@ -1,3 +1,2 @@ -USING: kernel io.encodings ; - -TUPLE: binary ; +IN: io.encodings.binary +SYMBOL: binary diff --git a/core/io/encodings/encodings.factor b/core/io/encodings/encodings.factor index cab625ad73..4ceae70fae 100755 --- a/core/io/encodings/encodings.factor +++ b/core/io/encodings/encodings.factor @@ -2,7 +2,7 @@ ! See http://factorcode.org/license.txt for BSD license. USING: math kernel sequences sbufs vectors namespaces growable strings io classes io.streams.c continuations -io.styles io.streams.nested ; +io.styles io.streams.nested io.encodings.binary ; IN: io.encodings ! Decoding @@ -54,7 +54,10 @@ GENERIC: decode-step ( buf byte ch state encoding -- buf ch state ) TUPLE: decoded code cr ; : ( stream decoding-class -- decoded-stream ) - construct-empty { set-delegate set-decoded-code } decoded construct ; + dup binary eq? [ drop ] [ + construct-empty { set-delegate set-decoded-code } + decoded construct + ] if ; : cr+ t swap set-line-reader-cr ; inline diff --git a/core/io/encodings/latin1/latin1.factor b/core/io/encodings/latin1/latin1.factor index e6d6281eb6..d6e643fd96 100755 --- a/core/io/encodings/latin1/latin1.factor +++ b/core/io/encodings/latin1/latin1.factor @@ -1,10 +1,10 @@ -USING: io io.encodings strings kernel ; +USING: io io.encodings strings kernel io.encodings.ascii ; IN: io.encodings.latin1 TUPLE: latin1 ; -M: latin1 stream-read delegate stream-read >string ; +M: latin1 encode-string + drop 255 encode-check>= ; -M: latin1 stream-read-until delegate stream-read-until >string ; - -M: latin1 stream-read-partial delegate stream-read-partial >string ; +M: latin1 decode-step + 3drop over push f f ; diff --git a/core/io/files/files-docs.factor b/core/io/files/files-docs.factor index 185fa1436b..839cd2fae0 100755 --- a/core/io/files/files-docs.factor +++ b/core/io/files/files-docs.factor @@ -6,6 +6,11 @@ ARTICLE: "file-streams" "Reading and writing files" { $subsection } { $subsection } { $subsection } +{ $subsection with-file-reader } +{ $subsection with-file-writer } +{ $subsection with-file-appender } +{ $subsection file-contents } +{ $subsection file-lines } "Pathname manipulation:" { $subsection parent-directory } { $subsection file-name } @@ -38,33 +43,44 @@ ARTICLE: "file-streams" "Reading and writing files" ABOUT: "file-streams" HELP: -{ $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: -{ $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: -{ $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 diff --git a/core/io/files/files.factor b/core/io/files/files.factor index 5a9411aadb..daa5d6df7e 100755 --- a/core/io/files/files.factor +++ b/core/io/files/files.factor @@ -15,6 +15,15 @@ HOOK: file-writer* io-backend ( path -- stream ) HOOK: file-appender* io-backend ( path -- stream ) +: ( path encoding -- stream ) + swap file-reader* swap ; + +: ( path encoding -- stream ) + swap file-writer* swap ; + +: ( path encoding -- stream ) + swap file-appender* swap ; + HOOK: delete-file io-backend ( path -- ) HOOK: rename-file io-backend ( from to -- ) @@ -115,8 +124,8 @@ HOOK: copy-file io-backend ( from to -- ) M: object copy-file dup parent-directory make-directories - [ - swap [ + binary [ + swap binary [ swap stream-copy ] with-disposal ] with-disposal ; @@ -140,15 +149,6 @@ C: pathname M: pathname <=> [ pathname-string ] compare ; -: ( path encoding -- stream ) - swap file-reader* swap ; - -: ( path encoding -- stream ) - swap file-writer* swap ; - -: ( path encoding -- stream ) - swap file-appender* swap ; - : file-lines ( path encoding -- seq ) lines ; : file-contents ( path encoding -- str ) diff --git a/core/io/io-tests.factor b/core/io/io-tests.factor index 23686abab5..00a8078da8 100644 --- a/core/io/io-tests.factor +++ b/core/io/io-tests.factor @@ -1,5 +1,5 @@ USING: arrays io io.files kernel math parser strings system -tools.test words namespaces ; +tools.test words namespaces io.encodings.ascii ; IN: temporary [ f ] [ @@ -8,7 +8,7 @@ IN: temporary ] unit-test : ( resource -- stream ) - resource-path ; + resource-path binary ascii ; [ "This is a line.\rThis is another line.\r" diff --git a/core/io/streams/lines/lines-tests.factor b/core/io/streams/lines/lines-tests.factor index 64dc7bff3b..e3a4fe886a 100755 --- a/core/io/streams/lines/lines-tests.factor +++ b/core/io/streams/lines/lines-tests.factor @@ -1,9 +1,9 @@ USING: io.streams.lines io.files io.streams.string io -tools.test kernel ; +tools.test kernel io.encodings.ascii ; IN: temporary : ( resource -- stream ) - resource-path ; + resource-path ascii ; [ { } ] [ "/core/io/test/empty-file.txt" lines ] From 62f9ed5dbd213b731263a9652389e8309e580eb9 Mon Sep 17 00:00:00 2001 From: Daniel Ehrenberg Date: Sat, 16 Feb 2008 22:17:41 -0600 Subject: [PATCH 03/38] putting encodings on all file readers/writers --- core/alien/c-types/c-types.factor | 5 +++- core/bootstrap/image/image.factor | 4 +-- core/io/encodings/binary/binary.factor | 3 +-- core/io/encodings/encodings.factor | 26 ++++++++++++------- core/io/encodings/utf16/utf16.factor | 6 ++--- core/io/encodings/utf8/utf8.factor | 4 +-- core/io/files/files-tests.factor | 22 ++++++++-------- core/io/io-tests.factor | 6 ++--- core/io/streams/c/c-tests.factor | 2 +- core/io/streams/c/c.factor | 3 +-- core/io/streams/lines/lines.factor | 8 +++--- core/parser/parser.factor | 4 +-- core/source-files/source-files.factor | 6 ++--- extra/benchmark/fasta/fasta.factor | 4 +-- .../benchmark/knucleotide/knucleotide.factor | 4 +-- extra/benchmark/mandel/mandel.factor | 4 +-- extra/benchmark/raytracer/raytracer.factor | 4 +-- .../reverse-complement.factor | 4 +-- extra/benchmark/sum-file/sum-file.factor | 4 +-- extra/bootstrap/image/upload/upload.factor | 4 +-- extra/bunny/model/model.factor | 4 +-- extra/cpu/8080/emulator/emulator.factor | 6 ++--- extra/cryptlib/cryptlib-tests.factor | 7 ++--- extra/crypto/hmac/hmac.factor | 6 ++--- extra/crypto/md5/md5.factor | 5 ++-- extra/crypto/sha1/sha1.factor | 4 +-- extra/editors/jedit/jedit.factor | 4 +-- extra/furnace/furnace.factor | 4 +-- extra/graphics/bitmap/bitmap.factor | 6 ++--- extra/help/cookbook/cookbook.factor | 4 +-- extra/http/client/client.factor | 4 +-- .../server/templating/templating-tests.factor | 4 +-- .../http/server/templating/templating.factor | 6 ++--- extra/icfp/2006/2006.factor | 4 +-- extra/id3/id3.factor | 10 +++---- extra/io/mmap/mmap-tests.factor | 7 ++--- extra/io/unix/unix-tests.factor | 8 +++--- extra/log-viewer/log-viewer.factor | 4 +-- extra/logging/insomniac/insomniac.factor | 5 ++-- extra/logging/server/server.factor | 4 +-- extra/mad/api/api.factor | 6 ++--- extra/msxml-to-csv/msxml-to-csv.factor | 4 +-- extra/ogg/player/player.factor | 7 ++--- .../porter-stemmer-tests.factor | 4 +-- extra/project-euler/042/042.factor | 4 +-- extra/project-euler/067/067.factor | 5 ++-- extra/project-euler/079/079.factor | 5 ++-- extra/raptor/raptor.factor | 4 +-- extra/rss/rss-tests.factor | 4 +-- extra/tar/tar.factor | 6 ++--- extra/tools/browser/browser.factor | 6 ++--- extra/tools/deploy/macosx/macosx.factor | 4 +-- extra/tools/disassembler/disassembler.factor | 6 ++--- extra/ui/freetype/freetype.factor | 2 +- extra/unicode/breaks/breaks.factor | 4 +-- extra/unicode/data/data.factor | 4 +-- extra/webapps/file/file.factor | 4 +-- extra/webapps/source/source.factor | 4 +-- extra/xml/xml.factor | 5 ++-- extra/xmode/catalog/catalog.factor | 6 ++--- extra/xmode/code2html/code2html.factor | 6 ++--- extra/yahoo/yahoo-tests.factor | 2 +- 62 files changed, 174 insertions(+), 161 deletions(-) diff --git a/core/alien/c-types/c-types.factor b/core/alien/c-types/c-types.factor index 7d01fb2b00..983fea0159 100755 --- a/core/alien/c-types/c-types.factor +++ b/core/alien/c-types/c-types.factor @@ -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.encodings.binary ; IN: alien.c-types DEFER: @@ -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 ] diff --git a/core/bootstrap/image/image.factor b/core/bootstrap/image/image.factor index 17b56458ce..73085450a8 100755 --- a/core/bootstrap/image/image.factor +++ b/core/bootstrap/image/image.factor @@ -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 [ (write-image) ] with-file-writer ; PRIVATE> diff --git a/core/io/encodings/binary/binary.factor b/core/io/encodings/binary/binary.factor index 17c734b9c8..8a8d09464b 100644 --- a/core/io/encodings/binary/binary.factor +++ b/core/io/encodings/binary/binary.factor @@ -1,2 +1 @@ -IN: io.encodings.binary -SYMBOL: binary +IN: io.encodings.binary SYMBOL: binary diff --git a/core/io/encodings/encodings.factor b/core/io/encodings/encodings.factor index 4ceae70fae..cd9d4b585b 100755 --- a/core/io/encodings/encodings.factor +++ b/core/io/encodings/encodings.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2006, 2007 Daniel Ehrenberg. ! See http://factorcode.org/license.txt for BSD license. USING: math kernel sequences sbufs vectors namespaces -growable strings io classes io.streams.c continuations +growable strings io classes continuations io.styles io.streams.nested io.encodings.binary ; IN: io.encodings @@ -13,12 +13,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 ) ! This is the replacement character - HEX: fffd decoded ; + HEX: fffd push-decoded ; : finish-decoding ( buf ch state -- str ) begin eq? [ decode-error ] unless drop "" like ; @@ -59,16 +59,16 @@ TUPLE: decoded code cr ; decoded construct ] if ; -: cr+ t swap set-line-reader-cr ; inline +: cr+ t swap set-decoded-cr ; inline -: cr- f swap set-line-reader-cr ; inline +: cr- f swap set-decoded-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 + over decoded-cr over empty? and [ drop dup cr- stream-readln ] [ swap cr- ] if ; inline : handle-readln ( stream str ch -- str ) @@ -79,7 +79,7 @@ TUPLE: decoded code cr ; } case ; : fix-read ( stream string -- string ) - over line-reader-cr [ + over decoded-cr [ over cr- "\n" ?head [ swap stream-read1 [ add ] when* @@ -91,13 +91,21 @@ M: decoded stream-read M: decoded stream-read-partial tuck stream-read fix-read ; +: read-until-loop ( stream delim -- ch ) + ! Copied from { c-reader stream-read-until }!!! + over stream-read1 dup [ + dup pick memq? [ 2nip ] [ , read-until-loop ] if + ] [ + 2nip + ] if ; + M: decoded stream-read-until ! Copied from { c-reader stream-read-until }!!! [ swap read-until-loop ] "" make swap over empty? over not and [ 2drop f f ] when ; : fix-read1 ( stream char -- char ) - over line-reader-cr [ + over decoded-cr [ over cr- dup CHAR: \n = [ drop stream-read1 @@ -106,7 +114,7 @@ M: decoded stream-read-until M: decoded stream-read1 1 over stream-read ; -M: line-reader stream-readln ( stream -- str ) +M: decoded stream-readln ( stream -- str ) "\r\n" over stream-read-until handle-readln ; ! Encoding diff --git a/core/io/encodings/utf16/utf16.factor b/core/io/encodings/utf16/utf16.factor index 35b6282e21..1dd317d3c0 100755 --- a/core/io/encodings/utf16/utf16.factor +++ b/core/io/encodings/utf16/utf16.factor @@ -16,7 +16,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,7 +36,7 @@ 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 ; @@ -52,7 +52,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 ) diff --git a/core/io/encodings/utf8/utf8.factor b/core/io/encodings/utf8/utf8.factor index 6a3a8b8ec7..7f211f92de 100644 --- a/core/io/encodings/utf8/utf8.factor +++ b/core/io/encodings/utf8/utf8.factor @@ -23,7 +23,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 +31,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 ) { diff --git a/core/io/files/files-tests.factor b/core/io/files/files-tests.factor index d0f9737f19..a92a52a024 100755 --- a/core/io/files/files-tests.factor +++ b/core/io/files/files-tests.factor @@ -1,34 +1,34 @@ IN: temporary -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" resource-path [ + "test-foo.txt" resource-path ascii [ "Hello world." print ] with-file-writer ] unit-test [ ] [ - "test-foo.txt" resource-path [ + "test-foo.txt" resource-path ascii [ "Hello appender." print - ] with-stream + ] with-file-appender ] unit-test [ ] [ - "test-bar.txt" resource-path [ + "test-bar.txt" resource-path ascii [ "Hello appender." print - ] with-stream + ] with-file-appender ] unit-test [ "Hello world.\nHello appender.\n" ] [ - "test-foo.txt" resource-path file-contents + "test-foo.txt" resource-path ascii file-contents ] unit-test [ "Hello appender.\n" ] [ - "test-bar.txt" resource-path file-contents + "test-bar.txt" resource-path ascii file-contents ] unit-test [ ] [ "test-foo.txt" resource-path delete-file ] unit-test @@ -42,7 +42,7 @@ USING: tools.test io.files io threads kernel continuations ; [ ] [ "test-blah" resource-path make-directory ] unit-test [ ] [ - "test-blah/fooz" resource-path dispose + "test-blah/fooz" resource-path ascii dispose ] unit-test [ t ] [ @@ -55,11 +55,11 @@ USING: tools.test io.files io threads kernel continuations ; [ f ] [ "test-blah" resource-path exists? ] unit-test -[ ] [ "test-quux.txt" resource-path [ [ yield "Hi" write ] in-thread ] with-file-writer ] unit-test +[ ] [ "test-quux.txt" resource-path ascii [ [ yield "Hi" write ] in-thread ] with-file-writer ] unit-test [ ] [ "test-quux.txt" resource-path delete-file ] unit-test -[ ] [ "test-quux.txt" resource-path [ [ yield "Hi" write ] in-thread ] with-file-writer ] unit-test +[ ] [ "test-quux.txt" resource-path ascii [ [ yield "Hi" write ] in-thread ] with-file-writer ] unit-test [ ] [ "test-quux.txt" "quux-test.txt" [ resource-path ] 2apply rename-file ] unit-test [ t ] [ "quux-test.txt" resource-path exists? ] unit-test diff --git a/core/io/io-tests.factor b/core/io/io-tests.factor index 00a8078da8..74b6b5034f 100644 --- a/core/io/io-tests.factor +++ b/core/io/io-tests.factor @@ -1,5 +1,5 @@ USING: arrays io io.files kernel math parser strings system -tools.test words namespaces io.encodings.ascii ; +tools.test words namespaces io.encodings.ascii io.encodings.binary ; IN: temporary [ f ] [ @@ -8,7 +8,7 @@ IN: temporary ] unit-test : ( resource -- stream ) - resource-path binary ascii ; + resource-path ascii ; [ "This is a line.\rThis is another line.\r" @@ -53,7 +53,7 @@ IN: temporary ] unit-test [ ] [ - image [ + image binary [ 10 [ 65536 read drop ] times ] with-file-reader ] unit-test diff --git a/core/io/streams/c/c-tests.factor b/core/io/streams/c/c-tests.factor index 5ace929ceb..66ea460126 100755 --- a/core/io/streams/c/c-tests.factor +++ b/core/io/streams/c/c-tests.factor @@ -2,7 +2,7 @@ USING: tools.test io.files io io.streams.c ; IN: temporary [ "hello world" ] [ - "test.txt" resource-path [ + "test.txt" resource-path ascii [ "hello world" write ] with-file-writer diff --git a/core/io/streams/c/c.factor b/core/io/streams/c/c.factor index 9c1a099318..73b8bb32b9 100755 --- a/core/io/streams/c/c.factor +++ b/core/io/streams/c/c.factor @@ -2,8 +2,7 @@ ! 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 ; +io.backend io.streams.duplex io.files continuations ; IN: io.streams.c TUPLE: c-writer handle ; diff --git a/core/io/streams/lines/lines.factor b/core/io/streams/lines/lines.factor index a6a5721ad8..84ff272d69 100755 --- a/core/io/streams/lines/lines.factor +++ b/core/io/streams/lines/lines.factor @@ -1,9 +1,7 @@ ! Copyright (C) 2004, 2007 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. IN: io.streams.lines -USING: io.encodings.latin1 io.encodings ; +! USING: io.encodings.latin1 io.encodings ; -TUPLE: line-reader cr ; - -: ( stream -- new-stream ) - latin1 ; +! : ( stream -- new-stream ) +! latin1 ; diff --git a/core/parser/parser.factor b/core/parser/parser.factor index fc29445f88..2f7beb56d7 100755 --- a/core/parser/parser.factor +++ b/core/parser/parser.factor @@ -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 io.streams.lines vocabs io.encodings.utf8 source-files classes hashtables compiler.errors compiler.units ; IN: parser @@ -489,7 +489,7 @@ SYMBOL: interactive-vocabs [ [ [ parsing-file ] keep - [ ?resource-path ] keep + [ ?resource-path utf8 ] keep parse-stream ] with-compiler-errors ] [ diff --git a/core/source-files/source-files.factor b/core/source-files/source-files.factor index c7539ad3eb..d2566982f8 100755 --- a/core/source-files/source-files.factor +++ b/core/source-files/source-files.factor @@ -5,7 +5,7 @@ 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 ; +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 [ @@ -68,7 +68,7 @@ uses definitions ; : reset-checksums ( -- ) source-files get [ swap ?resource-path dup exists? - [ file-lines swap record-checksum ] [ 2drop ] if + [ utf8 file-lines swap record-checksum ] [ 2drop ] if ] assoc-each ; M: pathname where pathname-string 1 2array ; diff --git a/extra/benchmark/fasta/fasta.factor b/extra/benchmark/fasta/fasta.factor index 75321def2d..a68a84fc59 100644 --- a/extra/benchmark/fasta/fasta.factor +++ b/extra/benchmark/fasta/fasta.factor @@ -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 diff --git a/extra/benchmark/knucleotide/knucleotide.factor b/extra/benchmark/knucleotide/knucleotide.factor index b95e182bd1..e06b81f6de 100644 --- a/extra/benchmark/knucleotide/knucleotide.factor +++ b/extra/benchmark/knucleotide/knucleotide.factor @@ -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 diff --git a/extra/benchmark/mandel/mandel.factor b/extra/benchmark/mandel/mandel.factor index 230fb2f889..a60fdbf6c7 100755 --- a/extra/benchmark/mandel/mandel.factor +++ b/extra/benchmark/mandel/mandel.factor @@ -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" resource-path - [ mandel write ] with-file-writer ; + binary [ mandel write ] with-file-writer ; MAIN: mandel-main diff --git a/extra/benchmark/raytracer/raytracer.factor b/extra/benchmark/raytracer/raytracer.factor index 8f2badc95f..9783389e80 100644 --- a/extra/benchmark/raytracer/raytracer.factor +++ b/extra/benchmark/raytracer/raytracer.factor @@ -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" resource-path - [ run write ] with-file-writer ; + binary [ run write ] with-file-writer ; MAIN: raytracer-main diff --git a/extra/benchmark/reverse-complement/reverse-complement.factor b/extra/benchmark/reverse-complement/reverse-complement.factor index cc20b4b349..2ae92223d1 100644 --- a/extra/benchmark/reverse-complement/reverse-complement.factor +++ b/extra/benchmark/reverse-complement/reverse-complement.factor @@ -1,6 +1,6 @@ USING: io io.files io.streams.duplex kernel sequences sequences.private strings vectors words memoize splitting -hints unicode.case ; +hints unicode.case io.encodings.latin1 ; IN: benchmark.reverse-complement MEMO: trans-map ( -- str ) @@ -32,7 +32,7 @@ HINTS: do-line vector string ; readln [ do-line (reverse-complement) ] [ show-seq ] if* ; : reverse-complement ( infile outfile -- ) - >r r> [ + latin1 >r latin1 r> [ 500000 (reverse-complement) ] with-stream ; diff --git a/extra/benchmark/sum-file/sum-file.factor b/extra/benchmark/sum-file/sum-file.factor index e17765d542..3db31f8887 100644 --- a/extra/benchmark/sum-file/sum-file.factor +++ b/extra/benchmark/sum-file/sum-file.factor @@ -1,11 +1,11 @@ -USING: io io.files math math.parser kernel prettyprint ; +USING: io io.files math math.parser kernel prettyprint 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 ( -- ) home "sum-file-in.txt" path+ sum-file ; diff --git a/extra/bootstrap/image/upload/upload.factor b/extra/bootstrap/image/upload/upload.factor index 552e26ebf5..4b8ddb0c4b 100755 --- a/extra/bootstrap/image/upload/upload.factor +++ b/extra/bootstrap/image/upload/upload.factor @@ -2,14 +2,14 @@ ! 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 ; : destination "slava@factorcode.org:www/images/latest/" ; : boot-image-names images [ boot-image-name ] map ; : compute-checksums ( -- ) - "checksums.txt" [ + "checksums.txt" ascii [ boot-image-names [ dup write bl file>md5str print ] each ] with-file-writer ; diff --git a/extra/bunny/model/model.factor b/extra/bunny/model/model.factor index 7c77ed98af..8d2175846c 100644 --- a/extra/bunny/model/model.factor +++ b/extra/bunny/model/model.factor @@ -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 ; diff --git a/extra/cpu/8080/emulator/emulator.factor b/extra/cpu/8080/emulator/emulator.factor index 9499ff8dff..9189a41411 100755 --- a/extra/cpu/8080/emulator/emulator.factor +++ b/extra/cpu/8080/emulator/emulator.factor @@ -4,7 +4,7 @@ USING: kernel math sequences words arrays io io.files namespaces math.parser kernel.private assocs quotations parser parser-combinators tools.time - sequences.private compiler.units ; + sequences.private compiler.units io.encodings.binary ; IN: cpu.8080.emulator TUPLE: cpu b c d e f h l a pc sp halted? last-interrupt cycles ram ; @@ -461,7 +461,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 ; @@ -477,7 +477,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 diff --git a/extra/cryptlib/cryptlib-tests.factor b/extra/cryptlib/cryptlib-tests.factor index c404114716..aeac468ba3 100644 --- a/extra/cryptlib/cryptlib-tests.factor +++ b/extra/cryptlib/cryptlib-tests.factor @@ -1,5 +1,6 @@ USING: cryptlib.libcl cryptlib prettyprint kernel alien sequences libc math -tools.test io io.files continuations alien.c-types splitting generic.math ; +tools.test io io.files continuations alien.c-types splitting generic.math +io.encodings.binary ; "=========================================================" print "Envelope/de-envelop test..." print @@ -152,7 +153,7 @@ tools.test io io.files continuations alien.c-types splitting generic.math ; ! envelope CRYPT_FORMAT_CRYPTLIB [ "extra/cryptlib/test/large_data.txt" resource-path - file-contents set-pop-buffer + binary file-contents set-pop-buffer envelope-handle CRYPT_ATTRIBUTE_BUFFERSIZE get-pop-buffer alien>char-string length 10000 + set-attribute envelope-handle CRYPT_ENVINFO_DATASIZE @@ -192,7 +193,7 @@ tools.test io io.files continuations alien.c-types splitting generic.math ; CRYPT_FORMAT_CRYPTLIB [ envelope-handle CRYPT_ENVINFO_PASSWORD "password" set-attribute-string "extra/cryptlib/test/large_data.txt" resource-path - file-contents set-pop-buffer + binary file-contents set-pop-buffer envelope-handle CRYPT_ATTRIBUTE_BUFFERSIZE get-pop-buffer alien>char-string length 10000 + set-attribute envelope-handle CRYPT_ENVINFO_DATASIZE diff --git a/extra/crypto/hmac/hmac.factor b/extra/crypto/hmac/hmac.factor index 7c358a8c09..56d39e71dc 100644 --- a/extra/crypto/hmac/hmac.factor +++ b/extra/crypto/hmac/hmac.factor @@ -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 ; [ init-hmac sha1-hmac ] with-stream ; : file>sha1-hmac ( K path -- hmac ) - stream>sha1-hmac ; + binary stream>sha1-hmac ; : string>sha1-hmac ( K string -- hmac ) stream>sha1-hmac ; @@ -42,7 +42,7 @@ MEMO: opad ( -- seq ) 64 HEX: 5c ; [ init-hmac md5-hmac ] with-stream ; : file>md5-hmac ( K path -- hmac ) - stream>md5-hmac ; + binary stream>md5-hmac ; : string>md5-hmac ( K string -- hmac ) stream>md5-hmac ; diff --git a/extra/crypto/md5/md5.factor b/extra/crypto/md5/md5.factor index fe215e32db..9ca3561574 100644 --- a/extra/crypto/md5/md5.factor +++ b/extra/crypto/md5/md5.factor @@ -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 : string>md5 ( string -- byte-array ) stream>md5 ; : string>md5str ( string -- md5-string ) string>md5 hex-string ; -: file>md5 ( path -- byte-array ) stream>md5 ; +: file>md5 ( path -- byte-array ) binary stream>md5 ; : file>md5str ( path -- md5-string ) file>md5 hex-string ; diff --git a/extra/crypto/sha1/sha1.factor b/extra/crypto/sha1/sha1.factor index f6dfbcd031..8f8b3e0cdd 100644 --- a/extra/crypto/sha1/sha1.factor +++ b/extra/crypto/sha1/sha1.factor @@ -1,4 +1,4 @@ -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 hashtables ; @@ -123,7 +123,7 @@ SYMBOL: K : string>sha1 ( string -- sha1 ) stream>sha1 ; : string>sha1str ( string -- str ) string>sha1 hex-string ; : string>sha1-bignum ( string -- n ) string>sha1 be> ; -: file>sha1 ( file -- sha1 ) stream>sha1 ; +: file>sha1 ( file -- sha1 ) binary stream>sha1 ; : string>sha1-interleave ( string -- seq ) [ zero? ] left-trim diff --git a/extra/editors/jedit/jedit.factor b/extra/editors/jedit/jedit.factor index fd5b6c1b06..ed579dde42 100644 --- a/extra/editors/jedit/jedit.factor +++ b/extra/editors/jedit/jedit.factor @@ -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 diff --git a/extra/furnace/furnace.factor b/extra/furnace/furnace.factor index 9b7a8a8aa5..b8e8b6885f 100755 --- a/extra/furnace/furnace.factor +++ b/extra/furnace/furnace.factor @@ -5,7 +5,7 @@ furnace.validator hashtables heaps html.elements http http.server.responders http.server.templating io.files kernel math namespaces quotations sequences splitting words strings vectors webapps.callback continuations tuples classes vocabs -html io ; +html io io.encodings.binary ; IN: furnace : code>quotation ( word/quot -- quot ) @@ -194,7 +194,7 @@ SYMBOL: model ; : send-resource ( name -- ) - template-path get swap path+ resource-path + template-path get swap path+ resource-path binary stdio get stream-copy ; : render-link ( quot name -- ) diff --git a/extra/graphics/bitmap/bitmap.factor b/extra/graphics/bitmap/bitmap.factor index 8e61766de1..ec4d6b79e1 100644 --- a/extra/graphics/bitmap/bitmap.factor +++ b/extra/graphics/bitmap/bitmap.factor @@ -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 diff --git a/extra/help/cookbook/cookbook.factor b/extra/help/cookbook/cookbook.factor index 5be69663f8..0b22ea2d1e 100755 --- a/extra/help/cookbook/cookbook.factor +++ b/extra/help/cookbook/cookbook.factor @@ -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:" { $code diff --git a/extra/http/client/client.factor b/extra/http/client/client.factor index 679d603708..251015a30d 100755 --- a/extra/http/client/client.factor +++ b/extra/http/client/client.factor @@ -2,7 +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 assocs.lib ; +splitting continuations assocs.lib io.encodings.binary ; IN: http.client : parse-host ( url -- host port ) @@ -71,7 +71,7 @@ DEFER: http-get-stream : download-to ( url file -- ) #! Downloads the contents of a URL to a file. >r http-get-stream check-response - r> stream-copy ; + r> binary stream-copy ; : download ( url -- ) dup download-name download-to ; diff --git a/extra/http/server/templating/templating-tests.factor b/extra/http/server/templating/templating-tests.factor index d889cd848a..2c15120552 100644 --- a/extra/http/server/templating/templating-tests.factor +++ b/extra/http/server/templating/templating-tests.factor @@ -1,5 +1,5 @@ USING: io io.files io.streams.string http.server.templating kernel tools.test - sequences ; + sequences io.encodings.utf8 ; IN: temporary : test-template ( path -- ? ) @@ -8,7 +8,7 @@ IN: temporary ".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 diff --git a/extra/http/server/templating/templating.factor b/extra/http/server/templating/templating.factor index f364b86524..d15bec4fb2 100755 --- a/extra/http/server/templating/templating.factor +++ b/extra/http/server/templating/templating.factor @@ -4,7 +4,7 @@ USING: continuations sequences kernel parser namespaces io io.files io.streams.lines io.streams.string html html.elements source-files debugger combinators math quotations generic -strings splitting ; +strings splitting io.encodings.utf8 ; IN: http.server.templating @@ -82,7 +82,7 @@ DEFER: <% delimiter templating-vocab use+ dup source-file file set ! so that reload works properly [ - ?resource-path file-contents + ?resource-path utf8 file-contents [ eval-template ] [ html-error. drop ] recover ] keep ] with-file-vocabs @@ -93,4 +93,4 @@ DEFER: <% delimiter swap path+ run-template-file ; : template-convert ( infile outfile -- ) - [ run-template-file ] with-file-writer ; + utf8 [ run-template-file ] with-file-writer ; diff --git a/extra/icfp/2006/2006.factor b/extra/icfp/2006/2006.factor index ae0e058490..1740e8a523 100755 --- a/extra/icfp/2006/2006.factor +++ b/extra/icfp/2006/2006.factor @@ -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 -- ) diff --git a/extra/id3/id3.factor b/extra/id3/id3.factor index 4f633f5be1..02e9515451 100644 --- a/extra/id3/id3.factor +++ b/extra/id3/id3.factor @@ -3,7 +3,7 @@ USING: arrays combinators io io.binary io.files io.paths io.encodings.utf16 kernel math math.parser namespaces sequences -splitting strings assocs unicode.categories ; +splitting strings assocs unicode.categories io.encodings.binary ; IN: id3 @@ -107,20 +107,20 @@ C: extended-header read-header read-frames ; : supported-version? ( version -- ? ) - [ 3 4 ] member? ; + { 3 4 } member? ; : read-id3v2 ( -- tag/f ) read1 dup supported-version? [ (read-id3v2) ] [ drop f ] if ; : id3v2? ( -- ? ) - 3 read "ID3" = ; + 3 read "ID3" sequence= ; : read-tag ( stream -- tag/f ) id3v2? [ read-id3v2 ] [ f ] if ; : id3v2 ( filename -- tag/f ) - [ read-tag ] with-file-reader ; + binary [ read-tag ] with-file-reader ; : file? ( path -- ? ) stat 3drop not ; @@ -135,7 +135,7 @@ C: extended-header [ mp3? ] subset ; : id3? ( file -- ? ) - [ id3v2? ] with-file-reader ; + binary [ id3v2? ] with-file-reader ; : id3s ( files -- id3s ) [ id3? ] subset ; diff --git a/extra/io/mmap/mmap-tests.factor b/extra/io/mmap/mmap-tests.factor index 25caae036d..388deac0db 100644 --- a/extra/io/mmap/mmap-tests.factor +++ b/extra/io/mmap/mmap-tests.factor @@ -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: temporary [ "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 diff --git a/extra/io/unix/unix-tests.factor b/extra/io/unix/unix-tests.factor index e1c3108952..85d450dac9 100755 --- a/extra/io/unix/unix-tests.factor +++ b/extra/io/unix/unix-tests.factor @@ -1,6 +1,6 @@ USING: io.files io.sockets io kernel threads namespaces tools.test continuations strings byte-arrays sequences -prettyprint system ; +prettyprint system io.encodings.binary ; IN: temporary ! Unix domain stream sockets @@ -131,15 +131,15 @@ client-addr ! Invalid parameter tests [ - image [ stdio get accept ] with-file-reader + image binary [ stdio get accept ] with-file-reader ] must-fail [ - image [ stdio get receive ] with-file-reader + image binary [ stdio get receive ] with-file-reader ] must-fail [ - image [ + image binary [ B{ 1 2 } server-addr stdio get send ] with-file-reader diff --git a/extra/log-viewer/log-viewer.factor b/extra/log-viewer/log-viewer.factor index 0f139d184e..7bc63d3e34 100755 --- a/extra/log-viewer/log-viewer.factor +++ b/extra/log-viewer/log-viewer.factor @@ -1,4 +1,4 @@ -USING: kernel io io.files io.monitors ; +USING: kernel io io.files io.monitors io.encodings.utf8 ; IN: log-viewer : read-lines ( stream -- ) @@ -9,6 +9,6 @@ IN: log-viewer dup next-change 2drop over read-lines tail-file-loop ; : tail-file ( file -- ) - dup dup read-lines + dup utf8 dup read-lines swap parent-directory f tail-file-loop ; diff --git a/extra/logging/insomniac/insomniac.factor b/extra/logging/insomniac/insomniac.factor index bb143879bf..0294085eda 100755 --- a/extra/logging/insomniac/insomniac.factor +++ b/extra/logging/insomniac/insomniac.factor @@ -1,7 +1,8 @@ ! Copyright (C) 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: logging.analysis logging.server logging smtp io.sockets -kernel io.files io.streams.string namespaces raptor.cron assocs ; +kernel io.files io.streams.string namespaces raptor.cron assocs +io.encodings.utf8 ; IN: logging.insomniac SYMBOL: insomniac-smtp-host @@ -11,7 +12,7 @@ SYMBOL: insomniac-recipients : ?analyze-log ( service word-names -- string/f ) >r log-path 1 log# dup exists? [ - file-lines r> [ analyze-log ] with-string-writer + utf8 file-lines r> [ analyze-log ] with-string-writer ] [ r> 2drop f ] if ; diff --git a/extra/logging/server/server.factor b/extra/logging/server/server.factor index 05029df1d0..e2a57fbc54 100755 --- a/extra/logging/server/server.factor +++ b/extra/logging/server/server.factor @@ -3,7 +3,7 @@ USING: namespaces kernel io calendar sequences io.files io.sockets continuations prettyprint assocs math.parser words debugger math combinators concurrency arrays init -math.ranges strings ; +math.ranges strings io.encodings.utf8 ; IN: logging.server : log-root ( -- string ) @@ -20,7 +20,7 @@ SYMBOL: log-files : open-log-stream ( service -- stream ) log-path dup make-directories - 1 log# ; + 1 log# utf8 ; : log-stream ( service -- stream ) log-files get [ open-log-stream ] cache ; diff --git a/extra/mad/api/api.factor b/extra/mad/api/api.factor index d803fa64e0..fdc2903d46 100644 --- a/extra/mad/api/api.factor +++ b/extra/mad/api/api.factor @@ -1,7 +1,8 @@ ! Copyright (C) 2007 Adam Wendt. ! See http://factorcode.org/license.txt for BSD license. USING: alien alien.c-types byte-arrays io io.binary io.files kernel mad - namespaces prettyprint sbufs sequences tools.interpreter vars ; + namespaces prettyprint sbufs sequences tools.interpreter vars + io.encodings.binary ; IN: mad.api VARS: buffer-start buffer-length output-callback-var ; @@ -80,9 +81,6 @@ VARS: buffer-start buffer-length output-callback-var ; : make-decoder ( -- decoder ) "mad_decoder" malloc-object ; -: malloc-file-contents ( path -- alien ) - file-contents >byte-array malloc-byte-array ; - : mad-run ( -- int ) make-decoder [ mad-init ] keep MAD_DECODER_MODE_SYNC mad_decoder_run ; diff --git a/extra/msxml-to-csv/msxml-to-csv.factor b/extra/msxml-to-csv/msxml-to-csv.factor index 8a9ba9cf98..3004324511 100644 --- a/extra/msxml-to-csv/msxml-to-csv.factor +++ b/extra/msxml-to-csv/msxml-to-csv.factor @@ -1,4 +1,4 @@ -USING: io io.files sequences xml xml.utilities ; +USING: io io.files sequences xml xml.utilities io.encodings.utf8 ; IN: msxml-to-csv : print-csv ( table -- ) [ "," join print ] each ; @@ -13,6 +13,6 @@ IN: msxml-to-csv ] map ; : msxml>csv ( infile outfile -- ) - [ + utf8 [ file>xml (msxml>csv) print-csv ] with-file-writer ; diff --git a/extra/ogg/player/player.factor b/extra/ogg/player/player.factor index 518030ee4d..94a45c90e3 100644 --- a/extra/ogg/player/player.factor +++ b/extra/ogg/player/player.factor @@ -14,7 +14,8 @@ USING: kernel alien ogg ogg.vorbis ogg.theora io byte-arrays sequences libc shuffle alien.c-types system openal math namespaces threads shuffle opengl arrays ui.gadgets.worlds combinators math.parser ui.gadgets ui.render opengl.gl ui - continuations io.files hints combinators.lib sequences.lib ; + continuations io.files hints combinators.lib sequences.lib + io.encodings.binary ; IN: ogg.player @@ -612,7 +613,7 @@ M: theora-gadget draw-gadget* ( gadget -- ) play-ogg ; : play-vorbis-file ( filename -- ) - play-vorbis-stream ; + binary play-vorbis-stream ; : play-theora-stream ( stream -- ) @@ -620,5 +621,5 @@ M: theora-gadget draw-gadget* ( gadget -- ) play-ogg ; : play-theora-file ( filename -- ) - play-theora-stream ; + binary play-theora-stream ; diff --git a/extra/porter-stemmer/porter-stemmer-tests.factor b/extra/porter-stemmer/porter-stemmer-tests.factor index d3e031fdc6..1e46fcd871 100644 --- a/extra/porter-stemmer/porter-stemmer-tests.factor +++ b/extra/porter-stemmer/porter-stemmer-tests.factor @@ -1,6 +1,6 @@ IN: temporary USING: arrays io kernel porter-stemmer sequences tools.test -io.files ; +io.files io.encodings.utf8 ; [ 0 ] [ "xa" consonant-seq ] unit-test [ 0 ] [ "xxaa" consonant-seq ] unit-test @@ -56,7 +56,7 @@ io.files ; [ "hell" ] [ "hell" step5 "" like ] unit-test [ "mate" ] [ "mate" step5 "" like ] unit-test -: resource-lines resource-path file-lines ; +: resource-lines resource-path utf8 file-lines ; [ { } ] [ "extra/porter-stemmer/test/voc.txt" resource-lines diff --git a/extra/project-euler/042/042.factor b/extra/project-euler/042/042.factor index c66be27df7..a87722debc 100644 --- a/extra/project-euler/042/042.factor +++ b/extra/project-euler/042/042.factor @@ -1,7 +1,7 @@ ! Copyright (c) 2008 Aaron Schaefer. ! See http://factorcode.org/license.txt for BSD license. USING: ascii io.files kernel math math.functions namespaces - project-euler.common sequences sequences.lib splitting ; + project-euler.common sequences sequences.lib splitting io.encodings.ascii ; IN: project-euler.042 ! http://projecteuler.net/index.php?section=problems&id=42 @@ -31,7 +31,7 @@ IN: project-euler.042 : source-042 ( -- seq ) "extra/project-euler/042/words.txt" resource-path - file-contents [ quotable? ] subset "," split ; + ascii file-contents [ quotable? ] subset "," split ; : (triangle-upto) ( limit n -- ) 2dup nth-triangle > [ diff --git a/extra/project-euler/067/067.factor b/extra/project-euler/067/067.factor index f206f59472..436ccde776 100644 --- a/extra/project-euler/067/067.factor +++ b/extra/project-euler/067/067.factor @@ -1,6 +1,7 @@ ! Copyright (c) 2007 Samuel Tardieu, Aaron Schaefer. ! See http://factorcode.org/license.txt for BSD license. -USING: io.files math.parser namespaces project-euler.common sequences splitting ; +USING: io.files math.parser namespaces project-euler.common +io.encodings.ascii sequences splitting ; IN: project-euler.067 ! http://projecteuler.net/index.php?section=problems&id=67 @@ -38,7 +39,7 @@ IN: project-euler.067 : source-067 ( -- seq ) "extra/project-euler/067/triangle.txt" resource-path - file-lines [ " " split [ string>number ] map ] map ; + ascii file-lines [ " " split [ string>number ] map ] map ; PRIVATE> diff --git a/extra/project-euler/079/079.factor b/extra/project-euler/079/079.factor index f068db77ec..30c46de0a0 100644 --- a/extra/project-euler/079/079.factor +++ b/extra/project-euler/079/079.factor @@ -1,6 +1,7 @@ ! Copyright (c) 2008 Aaron Schaefer. ! See http://factorcode.org/license.txt for BSD license. -USING: assocs hashtables io.files kernel math math.parser namespaces sequences ; +USING: assocs hashtables io.files kernel math math.parser namespaces +io.encodings.ascii sequences ; IN: project-euler.079 ! http://projecteuler.net/index.php?section=problems&id=79 @@ -26,7 +27,7 @@ IN: project-euler.079 edges ( seq -- seq ) [ diff --git a/extra/raptor/raptor.factor b/extra/raptor/raptor.factor index d776739d89..36da6d9434 100644 --- a/extra/raptor/raptor.factor +++ b/extra/raptor/raptor.factor @@ -42,10 +42,10 @@ SYMBOL: networking-hook ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! USING: io io.files io.streams.lines io.streams.plain io.streams.duplex - listener ; + listener io.encodings.utf8 ; : tty-listener ( tty -- ) - [ ] [ ] bi + [ utf8 ] [ utf8 ] bi [ listener ] with-stream ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! diff --git a/extra/rss/rss-tests.factor b/extra/rss/rss-tests.factor index 68a40704b3..1d493d3c14 100644 --- a/extra/rss/rss-tests.factor +++ b/extra/rss/rss-tests.factor @@ -1,9 +1,9 @@ -USING: rss io kernel io.files tools.test ; +USING: rss io kernel io.files tools.test io.encodings.utf8 ; : load-news-file ( filename -- feed ) #! Load an news syndication file and process it, returning #! it as an feed tuple. - read-feed ; + utf8 read-feed ; [ T{ feed diff --git a/extra/tar/tar.factor b/extra/tar/tar.factor index d92b4bd48b..ed083386ed 100755 --- a/extra/tar/tar.factor +++ b/extra/tar/tar.factor @@ -1,7 +1,7 @@ USING: combinators io io.files io.streams.duplex io.streams.string kernel math math.parser continuations namespaces pack prettyprint sequences strings system -hexdump tools.interpreter ; +hexdump tools.interpreter io.encodings.binary ; IN: tar : zero-checksum 256 ; @@ -94,7 +94,7 @@ TUPLE: unimplemented-typeflag header ; ! Normal file : typeflag-0 - tar-header-name tar-path+ + tar-header-name tar-path+ binary [ read-data-blocks ] keep dispose ; ! Hard link @@ -236,7 +236,7 @@ TUPLE: unimplemented-typeflag header ; ] when* ; : parse-tar ( path -- obj ) - [ + binary [ "tar-test" resource-path base-dir set global [ nl nl nl "Starting to parse .tar..." print flush ] bind global [ "Expanding to: " write base-dir get . flush ] bind diff --git a/extra/tools/browser/browser.factor b/extra/tools/browser/browser.factor index 7c28983519..63f9a087f5 100755 --- a/extra/tools/browser/browser.factor +++ b/extra/tools/browser/browser.factor @@ -5,12 +5,12 @@ words vocabs vocabs.loader definitions parser continuations inspector debugger io io.styles io.streams.lines hashtables sorting prettyprint source-files arrays combinators strings system math.parser help.markup help.topics help.syntax -help.stylesheet memoize ; +help.stylesheet memoize io.encodings.utf8 ; IN: tools.browser MEMO: (vocab-file-contents) ( path -- lines ) ?resource-path dup exists? - [ file-lines ] [ drop f ] if ; + [ utf8 file-lines ] [ drop f ] if ; : vocab-file-contents ( vocab name -- seq ) vocab-path+ dup [ (vocab-file-contents) ] when ; @@ -18,7 +18,7 @@ MEMO: (vocab-file-contents) ( path -- lines ) : set-vocab-file-contents ( seq vocab name -- ) dupd vocab-path+ [ ?resource-path - [ [ print ] each ] with-file-writer + utf8 [ [ print ] each ] with-file-writer ] [ "The " swap vocab-name " vocabulary was not loaded from the file system" diff --git a/extra/tools/deploy/macosx/macosx.factor b/extra/tools/deploy/macosx/macosx.factor index eb1a4af4a7..e4a0d539d1 100755 --- a/extra/tools/deploy/macosx/macosx.factor +++ b/extra/tools/deploy/macosx/macosx.factor @@ -46,8 +46,8 @@ IN: tools.deploy.macosx ] H{ } make-assoc print-plist ; : create-app-plist ( vocab bundle-name -- ) - dup "Contents/Info.plist" path+ - [ print-app-plist ] with-stream ; + dup "Contents/Info.plist" path+ + utf8 [ print-app-plist ] with-file-writer ; : create-app-dir ( vocab bundle-name -- vm ) dup "Frameworks" copy-bundle-dir diff --git a/extra/tools/disassembler/disassembler.factor b/extra/tools/disassembler/disassembler.factor index 833a6e7548..57fe7b43e8 100755 --- a/extra/tools/disassembler/disassembler.factor +++ b/extra/tools/disassembler/disassembler.factor @@ -2,7 +2,7 @@ ! See http://factorcode.org/license.txt for BSD license. USING: io.files io words alien kernel math.parser alien.syntax io.launcher system assocs arrays sequences namespaces qualified -system math windows.kernel32 generator.fixup ; +system math windows.kernel32 generator.fixup io.encodings.ascii ; IN: tools.disassembler : in-file "gdb-in.txt" resource-path ; @@ -15,7 +15,7 @@ M: word make-disassemble-cmd word-xt code-format - 2array make-disassemble-cmd ; M: pair make-disassemble-cmd - in-file [ + in-file ascii [ "attach " write current-process-handle number>string print "disassemble " write @@ -28,7 +28,7 @@ M: pair make-disassemble-cmd out-file +stdout+ set [ "gdb" , "-x" , in-file , "-batch" , ] { } make +arguments+ set ] { } make-assoc run-process drop - out-file file-lines ; + out-file ascii file-lines ; : tabs>spaces ( str -- str' ) { { CHAR: \t CHAR: \s } } substitute ; diff --git a/extra/ui/freetype/freetype.factor b/extra/ui/freetype/freetype.factor index 2dade0f58e..8078ec4a33 100755 --- a/extra/ui/freetype/freetype.factor +++ b/extra/ui/freetype/freetype.factor @@ -73,7 +73,7 @@ M: freetype-renderer free-fonts ( world -- ) : open-face ( font style -- face ) ttf-name ttf-path - dup file-contents >byte-array malloc-byte-array + dup malloc-file-contents swap file-length (open-face) ; diff --git a/extra/unicode/breaks/breaks.factor b/extra/unicode/breaks/breaks.factor index 1014d3ad7e..dfc7bf2264 100644 --- a/extra/unicode/breaks/breaks.factor +++ b/extra/unicode/breaks/breaks.factor @@ -1,7 +1,7 @@ USING: unicode.categories kernel math combinators splitting sequences math.parser io.files io assocs arrays namespaces combinators.lib assocs.lib math.ranges unicode.normalize -unicode.syntax unicode.data compiler.units alien.syntax ; +unicode.syntax unicode.data compiler.units alien.syntax io.encodings.ascii ; IN: unicode.breaks C-ENUM: Any L V T Extend Control CR LF graphemes ; @@ -30,7 +30,7 @@ CATEGORY: grapheme-control Zl Zp Cc Cf ; concat >set ; : other-extend-lines ( -- lines ) - "extra/unicode/PropList.txt" resource-path file-lines ; + "extra/unicode/PropList.txt" resource-path ascii file-lines ; VALUE: other-extend diff --git a/extra/unicode/data/data.factor b/extra/unicode/data/data.factor index c3998a6132..11be803893 100755 --- a/extra/unicode/data/data.factor +++ b/extra/unicode/data/data.factor @@ -1,6 +1,6 @@ USING: assocs math kernel sequences io.files hashtables quotations splitting arrays math.parser combinators.lib hash2 -byte-arrays words namespaces words compiler.units parser ; +byte-arrays words namespaces words compiler.units parser io.encodings.ascii ; IN: unicode.data << @@ -21,7 +21,7 @@ IN: unicode.data ! Loading data from UnicodeData.txt : data ( filename -- data ) - file-lines [ ";" split ] map ; + ascii file-lines [ ";" split ] map ; : load-data ( -- data ) "extra/unicode/UnicodeData.txt" resource-path data ; diff --git a/extra/webapps/file/file.factor b/extra/webapps/file/file.factor index 552f5e0977..12627b985f 100755 --- a/extra/webapps/file/file.factor +++ b/extra/webapps/file/file.factor @@ -3,7 +3,7 @@ USING: calendar html io io.files kernel math math.parser http.server.responders http.server.templating namespaces parser sequences strings assocs hashtables debugger http.mime sorting -html.elements logging ; +html.elements logging io.encodings.binary ; IN: webapps.file @@ -37,7 +37,7 @@ SYMBOL: serve-file-hook [ dupd file-response - stdio get stream-copy + binary stdio get stream-copy ] serve-file-hook set-global : serve-static ( filename mime-type -- ) diff --git a/extra/webapps/source/source.factor b/extra/webapps/source/source.factor index 4c0701c687..dc97805b78 100755 --- a/extra/webapps/source/source.factor +++ b/extra/webapps/source/source.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2007 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: io.files namespaces webapps.file http.server.responders -xmode.code2html kernel html sequences ; +xmode.code2html kernel html sequences io.encodings.utf8 ; IN: webapps.source ! This responder is a potential security problem. Make sure you @@ -15,7 +15,7 @@ IN: webapps.source : source-responder ( path mime-type -- ) drop serving-html - [ dup htmlize-stream ] with-html-stream ; + [ dup utf8 htmlize-stream ] with-html-stream ; global [ ! Serve up our own source code diff --git a/extra/xml/xml.factor b/extra/xml/xml.factor index ec3e24b99d..970ff39cf1 100644 --- a/extra/xml/xml.factor +++ b/extra/xml/xml.factor @@ -3,7 +3,7 @@ USING: io io.streams.string io.files kernel math namespaces prettyprint sequences arrays generic strings vectors xml.char-classes xml.data xml.errors xml.tokenize xml.writer -xml.utilities state-parser assocs ascii ; +xml.utilities state-parser assocs ascii io.encodings.utf8 ; IN: xml ! -- Overall parser with data tree @@ -167,7 +167,8 @@ TUPLE: pull-xml scope ; read-xml ; : file>xml ( filename -- xml ) - read-xml ; + ! Autodetect encoding! + utf8 read-xml ; : xml-reprint ( string -- ) string>xml print-xml ; diff --git a/extra/xmode/catalog/catalog.factor b/extra/xmode/catalog/catalog.factor index d6402603fa..6bff786fff 100755 --- a/extra/xmode/catalog/catalog.factor +++ b/extra/xmode/catalog/catalog.factor @@ -1,6 +1,6 @@ USING: xmode.loader xmode.utilities xmode.rules namespaces strings splitting assocs sequences kernel io.files xml memoize -words globs combinators ; +words globs combinators io.encodings.utf8 ; IN: xmode.catalog TUPLE: mode file file-name-glob first-line-glob ; @@ -25,7 +25,7 @@ TAGS> : load-catalog ( -- modes ) "extra/xmode/modes/catalog" resource-path - read-xml parse-modes-tag ; + file>xml parse-modes-tag ; : modes ( -- assoc ) \ modes get-global [ @@ -38,7 +38,7 @@ TAGS> MEMO: (load-mode) ( name -- rule-sets ) modes at mode-file "extra/xmode/modes/" swap append - resource-path parse-mode ; + resource-path utf8 parse-mode ; SYMBOL: rule-sets diff --git a/extra/xmode/code2html/code2html.factor b/extra/xmode/code2html/code2html.factor index 3db70cf2e9..47e619cc00 100755 --- a/extra/xmode/code2html/code2html.factor +++ b/extra/xmode/code2html/code2html.factor @@ -1,5 +1,5 @@ USING: xmode.tokens xmode.marker xmode.catalog kernel html html.elements io - io.files sequences words ; + io.files sequences words io.encodings.utf8 ; IN: xmode.code2html : htmlize-tokens ( tokens -- ) @@ -20,7 +20,7 @@ IN: xmode.code2html : default-stylesheet ( -- ) ; : htmlize-stream ( path stream -- ) @@ -40,5 +40,5 @@ IN: xmode.code2html ; : htmlize-file ( path -- ) - dup over ".html" append + dup utf8 over ".html" append utf8 [ htmlize-stream ] with-stream ; diff --git a/extra/yahoo/yahoo-tests.factor b/extra/yahoo/yahoo-tests.factor index 22ea687a29..197fa4900b 100644 --- a/extra/yahoo/yahoo-tests.factor +++ b/extra/yahoo/yahoo-tests.factor @@ -6,6 +6,6 @@ USING: tools.test yahoo kernel io.files xml sequences ; "Official Foo Fighters" "http://www.foofighters.com/" "Official site with news, tour dates, discography, store, community, and more." -} ] [ "extra/yahoo/test-results.xml" resource-path read-xml parse-yahoo first ] unit-test +} ] [ "extra/yahoo/test-results.xml" resource-path file>xml parse-yahoo first ] unit-test [ "http://search.yahooapis.com/WebSearchService/V1/webSearch?appid=Factor-search&query=hi&results=1" ] [ "hi" 1 query ] unit-test From e918cf6de0c16d0880f34db0f53ce9b778b6b487 Mon Sep 17 00:00:00 2001 From: Daniel Ehrenberg Date: Thu, 21 Feb 2008 15:22:49 -0600 Subject: [PATCH 04/38] More changes wrt encodings --- core/bootstrap/image/image.factor | 3 +- core/io/encodings/ascii/ascii.factor | 8 ++-- core/io/encodings/ascii/authors.txt | 1 + core/io/encodings/binary/binary.factor | 2 + core/io/encodings/encodings.factor | 27 +++++++------ core/io/encodings/latin1/latin1.factor | 4 +- core/io/encodings/utf16/utf16.factor | 5 +-- core/io/encodings/utf8/utf8.factor | 5 +-- core/io/files/authors.txt | 1 + core/io/files/files.factor | 11 ++--- core/io/streams/c/c.factor | 14 +++---- core/io/streams/plain/plain.factor | 17 ++++++-- core/io/streams/string/string.factor | 47 +++++++++++----------- extra/db/sqlite/test.db | Bin 0 -> 2048 bytes extra/io/buffers/buffers-docs.factor | 2 +- extra/io/launcher/launcher-docs.factor | 3 +- extra/io/launcher/launcher.factor | 7 ++-- extra/io/nonblocking/nonblocking.factor | 8 ++-- extra/io/sockets/authors.txt | 1 + extra/io/sockets/sockets-docs.factor | 6 +-- extra/io/sockets/sockets.factor | 17 ++++---- extra/io/unix/backend/backend.factor | 4 +- extra/io/unix/launcher/launcher.factor | 4 +- extra/io/unix/sockets/sockets.factor | 4 +- extra/io/unix/unix-tests.factor | 4 +- extra/irc/irc.factor | 5 ++- extra/smtp/smtp.factor | 6 +-- extra/tools/deploy/backend/backend.factor | 4 +- extra/webapps/cgi/cgi.factor | 4 +- 29 files changed, 125 insertions(+), 99 deletions(-) create mode 100644 core/io/encodings/ascii/authors.txt create mode 100644 extra/db/sqlite/test.db diff --git a/core/bootstrap/image/image.factor b/core/bootstrap/image/image.factor index 73085450a8..610f57cb8d 100755 --- a/core/bootstrap/image/image.factor +++ b/core/bootstrap/image/image.factor @@ -416,7 +416,8 @@ M: curry ' "Writing image to " write architecture get boot-image-name resource-path dup write "..." print flush - binary [ (write-image) ] with-file-writer ; + ! binary + [ (write-image) ] with-stream ; PRIVATE> diff --git a/core/io/encodings/ascii/ascii.factor b/core/io/encodings/ascii/ascii.factor index d767f26cdd..410c07f1ca 100644 --- a/core/io/encodings/ascii/ascii.factor +++ b/core/io/encodings/ascii/ascii.factor @@ -1,8 +1,10 @@ -USING: io io.encodings strings kernel ; +! 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 max -- byte-array ) - dupd [ >= ] curry all? [ >byte-array ] [ encoding-error ] if ; + dupd [ >= ] curry all? [ >byte-array ] [ encode-error ] if ; TUPLE: ascii ; @@ -10,4 +12,4 @@ M: ascii encode-string drop 127 encode-check>= ; M: ascii decode-step - 3drop over push f f ; + 3drop dup 127 >= [ encode-error ] when over push f f ; diff --git a/core/io/encodings/ascii/authors.txt b/core/io/encodings/ascii/authors.txt new file mode 100644 index 0000000000..f990dd0ed2 --- /dev/null +++ b/core/io/encodings/ascii/authors.txt @@ -0,0 +1 @@ +Daniel Ehrenberg diff --git a/core/io/encodings/binary/binary.factor b/core/io/encodings/binary/binary.factor index 8a8d09464b..b8bcc0f87a 100644 --- a/core/io/encodings/binary/binary.factor +++ b/core/io/encodings/binary/binary.factor @@ -1 +1,3 @@ +! Copyright (C) 2008 Daniel Ehrenberg. +! See http://factorcode.org/license.txt for BSD license. IN: io.encodings.binary SYMBOL: binary diff --git a/core/io/encodings/encodings.factor b/core/io/encodings/encodings.factor index cd9d4b585b..c1fd2c018c 100755 --- a/core/io/encodings/encodings.factor +++ b/core/io/encodings/encodings.factor @@ -1,8 +1,9 @@ -! 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 namespaces -growable strings io classes continuations -io.styles io.streams.nested io.encodings.binary ; +growable strings io classes continuations combinators +io.styles io.streams.plain io.encodings.binary splitting +io.streams.string io.streams.duplex ; IN: io.encodings ! Decoding @@ -134,18 +135,20 @@ M: encoded stream-write1 >r 1string r> stream-write ; M: encoded stream-write - [ encoding-code encode-string ] keep delegate stream-write ; + [ encoded-code encode-string ] keep delegate stream-write ; M: encoded dispose delegate dispose ; -M: encoded stream-nl - CHAR: \n swap stream-write1 ; +INSTANCE: encoded plain-writer -M: encoded stream-format - nip stream-write ; +! Rebinding duplex streams which have not read anything yet -M: encoded make-span-stream - ; +: reencode ( stream encoding -- newstream ) + over encoded? [ >r delegate r> ] when ; -M: encoded make-block-stream - nip ; +: redecode ( stream encoding -- newstream ) + over decoded? [ >r delegate r> ] when ; + +: ( duplex-stream encoding -- duplex-stream ) + swap { duplex-stream-in duplex-stream-out } get-slots + pick reencode >r swap redecode r> ; diff --git a/core/io/encodings/latin1/latin1.factor b/core/io/encodings/latin1/latin1.factor index d6e643fd96..7e867b15af 100755 --- a/core/io/encodings/latin1/latin1.factor +++ b/core/io/encodings/latin1/latin1.factor @@ -1,4 +1,6 @@ -USING: io io.encodings strings kernel io.encodings.ascii ; +! Copyright (C) 2008 Daniel Ehrenberg. +! See http://factorcode.org/license.txt for BSD license. +USING: io io.encodings strings kernel io.encodings.ascii sequences ; IN: io.encodings.latin1 TUPLE: latin1 ; diff --git a/core/io/encodings/utf16/utf16.factor b/core/io/encodings/utf16/utf16.factor index 1dd317d3c0..a241913fb5 100755 --- a/core/io/encodings/utf16/utf16.factor +++ b/core/io/encodings/utf16/utf16.factor @@ -1,4 +1,4 @@ -! 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 ; @@ -116,19 +116,16 @@ SYMBOL: ignore } cond ; 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? diff --git a/core/io/encodings/utf8/utf8.factor b/core/io/encodings/utf8/utf8.factor index 7f211f92de..2e7585b8a9 100644 --- a/core/io/encodings/utf8/utf8.factor +++ b/core/io/encodings/utf8/utf8.factor @@ -1,7 +1,7 @@ -! 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 @@ -78,7 +78,6 @@ SYMBOL: quad3 ! Interface for streams TUPLE: utf8 ; -INSTANCE: utf8 encoding-stream M: utf8 encode-string drop encode-utf8 ; M: utf8 decode-step drop decode-utf8-step ; diff --git a/core/io/files/authors.txt b/core/io/files/authors.txt index 1901f27a24..a44f8d7f8d 100644 --- a/core/io/files/authors.txt +++ b/core/io/files/authors.txt @@ -1 +1,2 @@ Slava Pestov +Daniel Ehrenberg diff --git a/core/io/files/files.factor b/core/io/files/files.factor index daa5d6df7e..c96cb1578c 100755 --- a/core/io/files/files.factor +++ b/core/io/files/files.factor @@ -1,9 +1,10 @@ -! Copyright (C) 2004, 2008 Slava Pestov. +! Copyright (C) 2004, 2008 Slava Pestov, Daniel Ehrenberg. ! See http://factorcode.org/license.txt for BSD license. IN: io.files USING: io.backend io.files.private io hashtables kernel math memory namespaces sequences strings assocs arrays definitions -system combinators splitting sbufs continuations io.encodings ; +system combinators splitting sbufs continuations io.encodings +io.encodings.binary ; HOOK: cd io-backend ( path -- ) @@ -16,13 +17,13 @@ HOOK: file-writer* io-backend ( path -- stream ) HOOK: file-appender* io-backend ( path -- stream ) : ( path encoding -- stream ) - swap file-reader* swap ; + swap file-reader* swap ; : ( path encoding -- stream ) - swap file-writer* swap ; + swap file-writer* swap ; : ( path encoding -- stream ) - swap file-appender* swap ; + swap file-appender* swap ; HOOK: delete-file io-backend ( path -- ) diff --git a/core/io/streams/c/c.factor b/core/io/streams/c/c.factor index 73b8bb32b9..8a6430eb86 100755 --- a/core/io/streams/c/c.factor +++ b/core/io/streams/c/c.factor @@ -1,8 +1,9 @@ ! Copyright (C) 2004, 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: kernel kernel.private namespaces io +USING: kernel kernel.private namespaces io io.encodings strings sequences math generic threads.private classes -io.backend io.streams.duplex io.files continuations ; +io.backend io.streams.duplex io.files continuations +io.encodings.utf8 ; IN: io.streams.c TUPLE: c-writer handle ; @@ -49,9 +50,7 @@ M: c-reader dispose c-reader-handle fclose ; : ( in out -- stream ) - >r r> - - ; + >r r> ; M: object init-io ; @@ -60,8 +59,9 @@ M: object init-io ; : stderr-handle 38 getenv ; M: object init-stdio - stdin-handle stdout-handle stdio set-global - stderr-handle stderr set-global ; + stdin-handle stdout-handle + utf8 stdio set-global + stderr-handle utf8 stderr set-global ; M: object io-multiplex (sleep) ; diff --git a/core/io/streams/plain/plain.factor b/core/io/streams/plain/plain.factor index e6cf9c8afa..4898a58fb1 100644 --- a/core/io/streams/plain/plain.factor +++ b/core/io/streams/plain/plain.factor @@ -1,7 +1,18 @@ ! 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: io.encodings.latin1 io.encodings ; -: ( stream -- new-stream ) - latin1 ; +MIXIN: plain-writer + +M: plain-writer stream-nl + CHAR: \n swap stream-write1 ; + +M: plain-writer stream-format + nip stream-write ; + +M: plain-writer make-span-stream + ; + +M: plain-writer make-block-stream + nip ; diff --git a/core/io/streams/string/string.factor b/core/io/streams/string/string.factor index a45c616b9a..f74f91c5bd 100755 --- a/core/io/streams/string/string.factor +++ b/core/io/streams/string/string.factor @@ -2,8 +2,7 @@ ! 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 ; M: growable dispose drop ; @@ -12,31 +11,12 @@ M: growable stream-write push-all ; M: growable stream-flush drop ; : ( -- stream ) - 512 ; + 512 ; : with-string-writer ( quot -- str ) 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 - [ 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 ; - M: growable stream-read1 dup empty? [ drop f ] [ pop ] if ; : harden-as ( seq growble-exemplar -- newseq ) @@ -69,7 +49,28 @@ M: growable stream-read-partial stream-read ; : ( str -- stream ) - >sbuf dup reverse-here ; + >sbuf dup reverse-here ; : with-string-reader ( str quot -- ) >r 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 + [ 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 ; diff --git a/extra/db/sqlite/test.db b/extra/db/sqlite/test.db new file mode 100644 index 0000000000000000000000000000000000000000..e483c47cea528c95f10fcf66fcbb67ffa351ffd1 GIT binary patch literal 2048 zcmWFz^vNtqRY=P(%1ta$FlJz3U}R))P*7lCU|k literal 0 HcmV?d00001 diff --git a/extra/io/buffers/buffers-docs.factor b/extra/io/buffers/buffers-docs.factor index def3e475f7..cf069f17aa 100644 --- a/extra/io/buffers/buffers-docs.factor +++ b/extra/io/buffers/buffers-docs.factor @@ -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 diff --git a/extra/io/launcher/launcher-docs.factor b/extra/io/launcher/launcher-docs.factor index 3a557e9fd5..10e7f2414b 100755 --- a/extra/io/launcher/launcher-docs.factor +++ b/extra/io/launcher/launcher-docs.factor @@ -148,8 +148,9 @@ HELP: process-stream HELP: { $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 diff --git a/extra/io/launcher/launcher.factor b/extra/io/launcher/launcher.factor index dce893dcaf..11eb8466a1 100755 --- a/extra/io/launcher/launcher.factor +++ b/extra/io/launcher/launcher.factor @@ -117,12 +117,13 @@ M: process get-lapse process-lapse ; M: process timed-out kill-process ; HOOK: process-stream* io-backend ( desc -- stream process ) +! Process streams are always latin1 for now; will be updated TUPLE: process-stream process ; -: ( desc -- stream ) - >descriptor - [ process-stream* ] keep +: ( desc encoding -- stream ) + swap >descriptor + [ process-stream* >r swap r> ] keep +timeout+ swap at [ over set-timeout ] when* { set-delegate set-process-stream-process } process-stream construct ; diff --git a/extra/io/nonblocking/nonblocking.factor b/extra/io/nonblocking/nonblocking.factor index dfdd05af53..0ae41f08fc 100755 --- a/extra/io/nonblocking/nonblocking.factor +++ b/extra/io/nonblocking/nonblocking.factor @@ -45,10 +45,10 @@ GENERIC: close-handle ( handle -- ) : ( handle -- stream ) output-port ; -: handle>duplex-stream ( in-handle out-handle -- stream ) - - [ >r r> ] [ ] [ dispose ] - cleanup ; +: handle>duplex-stream ( in-handle out-handle encoding -- stream ) + [ swap swap ] keep + [ -rot >r swap r> ] + [ ] [ dispose ] cleanup ; : pending-error ( port -- ) dup port-error f rot set-port-error [ throw ] when* ; diff --git a/extra/io/sockets/authors.txt b/extra/io/sockets/authors.txt index 1901f27a24..a44f8d7f8d 100644 --- a/extra/io/sockets/authors.txt +++ b/extra/io/sockets/authors.txt @@ -1 +1,2 @@ Slava Pestov +Daniel Ehrenberg diff --git a/extra/io/sockets/sockets-docs.factor b/extra/io/sockets/sockets-docs.factor index 9136c3ca22..510d47ff2b 100755 --- a/extra/io/sockets/sockets-docs.factor +++ b/extra/io/sockets/sockets-docs.factor @@ -92,11 +92,11 @@ HELP: inet6 } ; HELP: -{ $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\" " } + { $code "\"www.apple.com\" \"http\" utf8 " } } ; HELP: diff --git a/extra/io/sockets/sockets.factor b/extra/io/sockets/sockets.factor index 1afffcc7b2..6cf75f2f60 100755 --- a/extra/io/sockets/sockets.factor +++ b/extra/io/sockets/sockets.factor @@ -1,8 +1,8 @@ -! Copyright (C) 2007 Slava Pestov. +! Copyright (C) 2007, 2008 Slava Pestov, Daniel Ehrenberg. ! See http://factorcode.org/license.txt for BSD license. IN: io.sockets USING: generic kernel io.backend namespaces continuations -sequences arrays ; +sequences arrays io.encodings ; TUPLE: local path ; @@ -28,11 +28,12 @@ TUPLE: client-stream addr ; HOOK: (client) io-backend ( addrspec -- stream ) -GENERIC: ( addrspec -- stream ) +GENERIC: client* ( addrspec -- stream ) +M: array client* [ (client) ] attempt-all ; +M: object client* (client) ; -M: array [ (client) ] attempt-all ; - -M: object (client) ; +: ( addrspec encoding -- stream ) + >r client* r> ; HOOK: io-backend ( addrspec -- server ) @@ -48,7 +49,7 @@ HOOK: resolve-host io-backend ( host serv passive? -- seq ) HOOK: host-name io-backend ( -- string ) -M: inet +M: inet client* dup inet-host swap inet-port f resolve-host dup empty? [ "Host name lookup failed" throw ] when - ; + client* ; diff --git a/extra/io/unix/backend/backend.factor b/extra/io/unix/backend/backend.factor index 7d9f76c686..d6e384f255 100755 --- a/extra/io/unix/backend/backend.factor +++ b/extra/io/unix/backend/backend.factor @@ -181,8 +181,8 @@ M: unix-io io-multiplex ( ms -- ) mx get-global wait-for-events ; M: unix-io init-stdio ( -- ) - 0 1 handle>duplex-stream io:stdio set-global - 2 io:stderr set-global ; + 0 1 utf8 handle>duplex-stream io:stdio set-global + 2 utf8 io:stderr set-global ; ! mx io-task for embedding an fd-based mx inside another mx TUPLE: mx-port mx ; diff --git a/extra/io/unix/launcher/launcher.factor b/extra/io/unix/launcher/launcher.factor index 5adf0d7453..4e5f9e0fdf 100755 --- a/extra/io/unix/launcher/launcher.factor +++ b/extra/io/unix/launcher/launcher.factor @@ -4,7 +4,7 @@ USING: io io.backend io.launcher io.unix.backend io.unix.files io.nonblocking sequences kernel namespaces math system alien.c-types debugger continuations arrays assocs combinators unix.process parser-combinators memoize -promises strings threads unix ; +promises strings threads unix io.encodings.latin1 ; IN: io.unix.launcher ! Search unix first @@ -99,7 +99,7 @@ M: unix-io kill-process* ( pid -- ) M: unix-io process-stream* [ - spawn-process-stream >r handle>duplex-stream r> + spawn-process-stream >r latin1 handle>duplex-stream r> ] with-descriptor ; : find-process ( handle -- process ) diff --git a/extra/io/unix/sockets/sockets.factor b/extra/io/unix/sockets/sockets.factor index 59a9a8ac2e..84d4cc33f8 100755 --- a/extra/io/unix/sockets/sockets.factor +++ b/extra/io/unix/sockets/sockets.factor @@ -1,4 +1,4 @@ -! Copyright (C) 2004, 2008 Slava Pestov, Ivan Tikhonov. +! Copyright (C) 2004, 2008 Slava Pestov, Ivan Tikhonov. ! See http://factorcode.org/license.txt for BSD license. ! We need to fiddle with the exact search order here, since @@ -92,7 +92,7 @@ USE: io.sockets dup rot make-sockaddr/size bind zero? [ dup close (io-error) ] unless ; -M: unix-io ( addrspec -- stream ) +M: unix-io ( addrspec -- server ) [ SOCK_STREAM server-fd dup 10 listen zero? [ dup close (io-error) ] unless diff --git a/extra/io/unix/unix-tests.factor b/extra/io/unix/unix-tests.factor index 85d450dac9..54d2573396 100755 --- a/extra/io/unix/unix-tests.factor +++ b/extra/io/unix/unix-tests.factor @@ -1,6 +1,6 @@ USING: io.files io.sockets io kernel threads namespaces tools.test continuations strings byte-arrays sequences -prettyprint system io.encodings.binary ; +prettyprint system io.encodings.binary io.encodings.ascii ; IN: temporary ! Unix domain stream sockets @@ -24,7 +24,7 @@ yield [ { "Hello world" "FOO" } ] [ [ - "unix-domain-socket-test" resource-path + "unix-domain-socket-test" resource-path ascii [ readln , "XYZ" print flush diff --git a/extra/irc/irc.factor b/extra/irc/irc.factor index 44c682e671..8a39846fc4 100755 --- a/extra/irc/irc.factor +++ b/extra/irc/irc.factor @@ -1,7 +1,8 @@ ! Copyright (C) 2007 Doug Coleman, Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: arrays calendar io io.sockets kernel match namespaces -sequences splitting strings continuations threads ascii ; +sequences splitting strings continuations threads ascii +io.encodings.utf8 ; IN: irc ! "setup" objects @@ -97,7 +98,7 @@ SYMBOL: irc-client " hostname servername :irc.factor" irc-print ; : connect* ( server port -- ) - irc-client get set-irc-client-stream ; + utf8 irc-client get set-irc-client-stream ; : connect ( server -- ) 6667 connect* ; diff --git a/extra/smtp/smtp.factor b/extra/smtp/smtp.factor index 47bc16e029..14230e2c7c 100755 --- a/extra/smtp/smtp.factor +++ b/extra/smtp/smtp.factor @@ -3,7 +3,7 @@ ! See http://factorcode.org/license.txt for BSD license. USING: namespaces io io.timeouts kernel logging io.sockets sequences combinators sequences.lib splitting assocs strings -math.parser random system calendar ; +math.parser random system calendar io.encodings.ascii ; IN: smtp @@ -20,7 +20,7 @@ SYMBOL: esmtp t esmtp set-global : with-smtp-connection ( quot -- ) smtp-host get smtp-port get 2dup log-smtp-connection - [ + ascii [ ! ASCII until encodings reconsidered smtp-domain [ host-name or ] change read-timeout get stdio get set-timeout call @@ -180,4 +180,4 @@ TUPLE: email from to subject body ; : send ( email -- ) { email-body email-subject email-to email-from } get-slots - send-simple-message ; \ No newline at end of file + send-simple-message ; diff --git a/extra/tools/deploy/backend/backend.factor b/extra/tools/deploy/backend/backend.factor index 2439ef8636..bcdc0f806f 100755 --- a/extra/tools/deploy/backend/backend.factor +++ b/extra/tools/deploy/backend/backend.factor @@ -6,7 +6,7 @@ continuations math definitions mirrors splitting parser classes inspector layouts vocabs.loader prettyprint.config prettyprint debugger io.streams.c io.streams.duplex io.files io.backend quotations io.launcher words.private tools.deploy.config -bootstrap.image ; +bootstrap.image io.encodings.utf8 ; IN: tools.deploy.backend : (copy-lines) ( stream -- ) @@ -20,7 +20,7 @@ IN: tools.deploy.backend [ +arguments+ set +stdout+ +stderr+ set - ] H{ } make-assoc + ] H{ } make-assoc utf8 dup duplex-stream-out dispose dup copy-lines process-stream-process wait-for-process zero? [ diff --git a/extra/webapps/cgi/cgi.factor b/extra/webapps/cgi/cgi.factor index 967036a797..255aee0fbd 100644 --- a/extra/webapps/cgi/cgi.factor +++ b/extra/webapps/cgi/cgi.factor @@ -2,7 +2,7 @@ ! See http://factorcode.org/license.txt for BSD license. USING: namespaces kernel assocs io.files combinators arrays io.launcher io http.server.responders webapps.file -sequences strings math.parser unicode.case ; +sequences strings math.parser unicode.case io.encodings.binary ; IN: webapps.cgi SYMBOL: cgi-root @@ -50,7 +50,7 @@ SYMBOL: cgi-root : (do-cgi) ( name -- ) "200 CGI output follows" response - stdio get swap cgi-descriptor [ + stdio get swap cgi-descriptor binary [ post? [ "raw-response" get write flush ] when From 11a71f235d36a32fa87df84ec0d68213be7c59c3 Mon Sep 17 00:00:00 2001 From: Daniel Ehrenberg Date: Thu, 21 Feb 2008 15:28:58 -0600 Subject: [PATCH 05/38] Moving inessential encodings to extra --- extra/db/sqlite/test.db | Bin 2048 -> 0 bytes {core => extra}/io/encodings/ascii/ascii.factor | 0 {core => extra}/io/encodings/ascii/authors.txt | 0 extra/io/encodings/ascii/summary.txt | 1 + .../latin1 => extra/io/encodings/ascii}/tags.txt | 0 {core => extra}/io/encodings/latin1/authors.txt | 0 .../io/encodings/latin1/latin1-docs.factor | 0 .../io/encodings/latin1/latin1.factor | 0 {core => extra}/io/encodings/latin1/summary.txt | 0 .../utf16 => extra/io/encodings/latin1}/tags.txt | 0 .../io/encodings/utf16/.utf16.factor.swo | Bin {core => extra}/io/encodings/utf16/authors.txt | 0 {core => extra}/io/encodings/utf16/summary.txt | 0 extra/io/encodings/utf16/tags.txt | 1 + .../io/encodings/utf16/utf16-docs.factor | 0 .../io/encodings/utf16/utf16-tests.factor | 0 {core => extra}/io/encodings/utf16/utf16.factor | 0 17 files changed, 2 insertions(+) delete mode 100644 extra/db/sqlite/test.db rename {core => extra}/io/encodings/ascii/ascii.factor (100%) rename {core => extra}/io/encodings/ascii/authors.txt (100%) create mode 100644 extra/io/encodings/ascii/summary.txt rename {core/io/encodings/latin1 => extra/io/encodings/ascii}/tags.txt (100%) rename {core => extra}/io/encodings/latin1/authors.txt (100%) rename {core => extra}/io/encodings/latin1/latin1-docs.factor (100%) rename {core => extra}/io/encodings/latin1/latin1.factor (100%) rename {core => extra}/io/encodings/latin1/summary.txt (100%) rename {core/io/encodings/utf16 => extra/io/encodings/latin1}/tags.txt (100%) rename {core => extra}/io/encodings/utf16/.utf16.factor.swo (100%) rename {core => extra}/io/encodings/utf16/authors.txt (100%) rename {core => extra}/io/encodings/utf16/summary.txt (100%) create mode 100644 extra/io/encodings/utf16/tags.txt rename {core => extra}/io/encodings/utf16/utf16-docs.factor (100%) rename {core => extra}/io/encodings/utf16/utf16-tests.factor (100%) rename {core => extra}/io/encodings/utf16/utf16.factor (100%) diff --git a/extra/db/sqlite/test.db b/extra/db/sqlite/test.db deleted file mode 100644 index e483c47cea528c95f10fcf66fcbb67ffa351ffd1..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 2048 zcmWFz^vNtqRY=P(%1ta$FlJz3U}R))P*7lCU|k diff --git a/core/io/encodings/ascii/ascii.factor b/extra/io/encodings/ascii/ascii.factor similarity index 100% rename from core/io/encodings/ascii/ascii.factor rename to extra/io/encodings/ascii/ascii.factor diff --git a/core/io/encodings/ascii/authors.txt b/extra/io/encodings/ascii/authors.txt similarity index 100% rename from core/io/encodings/ascii/authors.txt rename to extra/io/encodings/ascii/authors.txt diff --git a/extra/io/encodings/ascii/summary.txt b/extra/io/encodings/ascii/summary.txt new file mode 100644 index 0000000000..8c54de7680 --- /dev/null +++ b/extra/io/encodings/ascii/summary.txt @@ -0,0 +1 @@ +ASCII encoding for streams diff --git a/core/io/encodings/latin1/tags.txt b/extra/io/encodings/ascii/tags.txt similarity index 100% rename from core/io/encodings/latin1/tags.txt rename to extra/io/encodings/ascii/tags.txt diff --git a/core/io/encodings/latin1/authors.txt b/extra/io/encodings/latin1/authors.txt similarity index 100% rename from core/io/encodings/latin1/authors.txt rename to extra/io/encodings/latin1/authors.txt diff --git a/core/io/encodings/latin1/latin1-docs.factor b/extra/io/encodings/latin1/latin1-docs.factor similarity index 100% rename from core/io/encodings/latin1/latin1-docs.factor rename to extra/io/encodings/latin1/latin1-docs.factor diff --git a/core/io/encodings/latin1/latin1.factor b/extra/io/encodings/latin1/latin1.factor similarity index 100% rename from core/io/encodings/latin1/latin1.factor rename to extra/io/encodings/latin1/latin1.factor diff --git a/core/io/encodings/latin1/summary.txt b/extra/io/encodings/latin1/summary.txt similarity index 100% rename from core/io/encodings/latin1/summary.txt rename to extra/io/encodings/latin1/summary.txt diff --git a/core/io/encodings/utf16/tags.txt b/extra/io/encodings/latin1/tags.txt similarity index 100% rename from core/io/encodings/utf16/tags.txt rename to extra/io/encodings/latin1/tags.txt diff --git a/core/io/encodings/utf16/.utf16.factor.swo b/extra/io/encodings/utf16/.utf16.factor.swo similarity index 100% rename from core/io/encodings/utf16/.utf16.factor.swo rename to extra/io/encodings/utf16/.utf16.factor.swo diff --git a/core/io/encodings/utf16/authors.txt b/extra/io/encodings/utf16/authors.txt similarity index 100% rename from core/io/encodings/utf16/authors.txt rename to extra/io/encodings/utf16/authors.txt diff --git a/core/io/encodings/utf16/summary.txt b/extra/io/encodings/utf16/summary.txt similarity index 100% rename from core/io/encodings/utf16/summary.txt rename to extra/io/encodings/utf16/summary.txt diff --git a/extra/io/encodings/utf16/tags.txt b/extra/io/encodings/utf16/tags.txt new file mode 100644 index 0000000000..8e27be7d61 --- /dev/null +++ b/extra/io/encodings/utf16/tags.txt @@ -0,0 +1 @@ +text diff --git a/core/io/encodings/utf16/utf16-docs.factor b/extra/io/encodings/utf16/utf16-docs.factor similarity index 100% rename from core/io/encodings/utf16/utf16-docs.factor rename to extra/io/encodings/utf16/utf16-docs.factor diff --git a/core/io/encodings/utf16/utf16-tests.factor b/extra/io/encodings/utf16/utf16-tests.factor similarity index 100% rename from core/io/encodings/utf16/utf16-tests.factor rename to extra/io/encodings/utf16/utf16-tests.factor diff --git a/core/io/encodings/utf16/utf16.factor b/extra/io/encodings/utf16/utf16.factor similarity index 100% rename from core/io/encodings/utf16/utf16.factor rename to extra/io/encodings/utf16/utf16.factor From 641c61a966c5c7ea4c8cdc54ca0fa86fb9dcb319 Mon Sep 17 00:00:00 2001 From: Daniel Ehrenberg Date: Thu, 21 Feb 2008 16:11:35 -0600 Subject: [PATCH 06/38] change to decoded#stream-read1 --- core/io/encodings/encodings.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/core/io/encodings/encodings.factor b/core/io/encodings/encodings.factor index c1fd2c018c..5cb87da36f 100755 --- a/core/io/encodings/encodings.factor +++ b/core/io/encodings/encodings.factor @@ -113,7 +113,7 @@ M: decoded stream-read-until ] [ nip ] if ] [ nip ] if ; -M: decoded stream-read1 1 over stream-read ; +M: decoded stream-read1 1 swap stream-read ; M: decoded stream-readln ( stream -- str ) "\r\n" over stream-read-until handle-readln ; From fb9d7b05cd67cd69322af66ae6af4203f3e7c651 Mon Sep 17 00:00:00 2001 From: Daniel Ehrenberg Date: Thu, 21 Feb 2008 18:03:07 -0600 Subject: [PATCH 07/38] Making everything load --- core/io/streams/lines/authors.txt | 1 - core/io/streams/lines/lines-docs.factor | 17 ------ core/io/streams/lines/lines-tests.factor | 58 ------------------- core/io/streams/lines/lines.factor | 7 --- core/io/streams/lines/summary.txt | 1 - .../sniffer/channels}/backend/backend.factor | 0 .../sniffer/channels}/bsd/bsd.factor | 0 .../sniffer/channels}/sniffer.factor | 0 .../sniffer/io}/authors.txt | 0 .../sniffer/io}/backend/authors.txt | 0 .../sniffer/io}/backend/backend.factor | 0 .../sniffer/io}/bsd/authors.txt | 0 .../sniffer/io}/bsd/bsd.factor | 2 +- .../sniffer/io}/filter/authors.txt | 0 .../sniffer/io}/filter/backend/authors.txt | 0 .../sniffer/io}/filter/backend/backend.factor | 0 .../sniffer/io}/filter/bsd/authors.txt | 0 .../sniffer/io}/filter/bsd/bsd.factor | 0 .../sniffer/io}/filter/filter.factor | 0 .../sniffer/io}/sniffer.factor | 0 20 files changed, 1 insertion(+), 85 deletions(-) delete mode 100644 core/io/streams/lines/authors.txt delete mode 100644 core/io/streams/lines/lines-docs.factor delete mode 100755 core/io/streams/lines/lines-tests.factor delete mode 100755 core/io/streams/lines/lines.factor delete mode 100644 core/io/streams/lines/summary.txt rename {extra/channels/sniffer => unmaintained/sniffer/channels}/backend/backend.factor (100%) rename {extra/channels/sniffer => unmaintained/sniffer/channels}/bsd/bsd.factor (100%) rename {extra/channels/sniffer => unmaintained/sniffer/channels}/sniffer.factor (100%) rename {extra/io/sniffer => unmaintained/sniffer/io}/authors.txt (100%) rename {extra/io/sniffer => unmaintained/sniffer/io}/backend/authors.txt (100%) rename {extra/io/sniffer => unmaintained/sniffer/io}/backend/backend.factor (100%) rename {extra/io/sniffer => unmaintained/sniffer/io}/bsd/authors.txt (100%) rename {extra/io/sniffer => unmaintained/sniffer/io}/bsd/bsd.factor (97%) rename {extra/io/sniffer => unmaintained/sniffer/io}/filter/authors.txt (100%) rename {extra/io/sniffer => unmaintained/sniffer/io}/filter/backend/authors.txt (100%) rename {extra/io/sniffer => unmaintained/sniffer/io}/filter/backend/backend.factor (100%) rename {extra/io/sniffer => unmaintained/sniffer/io}/filter/bsd/authors.txt (100%) rename {extra/io/sniffer => unmaintained/sniffer/io}/filter/bsd/bsd.factor (100%) rename {extra/io/sniffer => unmaintained/sniffer/io}/filter/filter.factor (100%) rename {extra/io/sniffer => unmaintained/sniffer/io}/sniffer.factor (100%) diff --git a/core/io/streams/lines/authors.txt b/core/io/streams/lines/authors.txt deleted file mode 100644 index 1901f27a24..0000000000 --- a/core/io/streams/lines/authors.txt +++ /dev/null @@ -1 +0,0 @@ -Slava Pestov diff --git a/core/io/streams/lines/lines-docs.factor b/core/io/streams/lines/lines-docs.factor deleted file mode 100644 index 789a060ed5..0000000000 --- a/core/io/streams/lines/lines-docs.factor +++ /dev/null @@ -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 } ; - -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 } "." } ; - -HELP: -{ $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." } ; diff --git a/core/io/streams/lines/lines-tests.factor b/core/io/streams/lines/lines-tests.factor deleted file mode 100755 index e3a4fe886a..0000000000 --- a/core/io/streams/lines/lines-tests.factor +++ /dev/null @@ -1,58 +0,0 @@ -USING: io.streams.lines io.files io.streams.string io -tools.test kernel io.encodings.ascii ; -IN: temporary - -: ( resource -- stream ) - resource-path ascii ; - -[ { } ] -[ "/core/io/test/empty-file.txt" lines ] -unit-test - -: lines-test ( stream -- line1 line2 ) - [ readln readln ] with-stream ; - -[ - "This is a line." - "This is another line." -] [ - "/core/io/test/windows-eol.txt" lines-test -] unit-test - -[ - "This is a line." - "This is another line." -] [ - "/core/io/test/mac-os-eol.txt" lines-test -] unit-test - -[ - "This is a line." - "This is another line." -] [ - "/core/io/test/unix-eol.txt" lines-test -] unit-test - -[ - "1234" -] [ - "Hello world\r\n1234" - dup stream-readln drop - 4 swap stream-read -] unit-test - -[ - "1234" -] [ - "Hello world\r\n1234" - dup stream-readln drop - 4 swap stream-read-partial -] unit-test - -[ - CHAR: 1 -] [ - "Hello world\r\n1234" - dup stream-readln drop - stream-read1 -] unit-test diff --git a/core/io/streams/lines/lines.factor b/core/io/streams/lines/lines.factor deleted file mode 100755 index 84ff272d69..0000000000 --- a/core/io/streams/lines/lines.factor +++ /dev/null @@ -1,7 +0,0 @@ -! Copyright (C) 2004, 2007 Slava Pestov. -! See http://factorcode.org/license.txt for BSD license. -IN: io.streams.lines -! USING: io.encodings.latin1 io.encodings ; - -! : ( stream -- new-stream ) -! latin1 ; diff --git a/core/io/streams/lines/summary.txt b/core/io/streams/lines/summary.txt deleted file mode 100644 index 8c0c096f0b..0000000000 --- a/core/io/streams/lines/summary.txt +++ /dev/null @@ -1 +0,0 @@ -Read lines of text from a character-oriented stream diff --git a/extra/channels/sniffer/backend/backend.factor b/unmaintained/sniffer/channels/backend/backend.factor similarity index 100% rename from extra/channels/sniffer/backend/backend.factor rename to unmaintained/sniffer/channels/backend/backend.factor diff --git a/extra/channels/sniffer/bsd/bsd.factor b/unmaintained/sniffer/channels/bsd/bsd.factor similarity index 100% rename from extra/channels/sniffer/bsd/bsd.factor rename to unmaintained/sniffer/channels/bsd/bsd.factor diff --git a/extra/channels/sniffer/sniffer.factor b/unmaintained/sniffer/channels/sniffer.factor similarity index 100% rename from extra/channels/sniffer/sniffer.factor rename to unmaintained/sniffer/channels/sniffer.factor diff --git a/extra/io/sniffer/authors.txt b/unmaintained/sniffer/io/authors.txt similarity index 100% rename from extra/io/sniffer/authors.txt rename to unmaintained/sniffer/io/authors.txt diff --git a/extra/io/sniffer/backend/authors.txt b/unmaintained/sniffer/io/backend/authors.txt similarity index 100% rename from extra/io/sniffer/backend/authors.txt rename to unmaintained/sniffer/io/backend/authors.txt diff --git a/extra/io/sniffer/backend/backend.factor b/unmaintained/sniffer/io/backend/backend.factor similarity index 100% rename from extra/io/sniffer/backend/backend.factor rename to unmaintained/sniffer/io/backend/backend.factor diff --git a/extra/io/sniffer/bsd/authors.txt b/unmaintained/sniffer/io/bsd/authors.txt similarity index 100% rename from extra/io/sniffer/bsd/authors.txt rename to unmaintained/sniffer/io/bsd/authors.txt diff --git a/extra/io/sniffer/bsd/bsd.factor b/unmaintained/sniffer/io/bsd/bsd.factor similarity index 97% rename from extra/io/sniffer/bsd/bsd.factor rename to unmaintained/sniffer/io/bsd/bsd.factor index 66336425a1..2a8a8e20c0 100644 --- a/extra/io/sniffer/bsd/bsd.factor +++ b/unmaintained/sniffer/io/bsd/bsd.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2007 Elie Chaftari, Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. USING: alien.c-types alien.syntax destructors hexdump io -io.buffers io.nonblocking io.sockets io.streams.lines +io.buffers io.nonblocking io.sockets io.unix.backend io.unix.files kernel libc locals math qualified sequences io.sniffer.backend ; QUALIFIED: unix diff --git a/extra/io/sniffer/filter/authors.txt b/unmaintained/sniffer/io/filter/authors.txt similarity index 100% rename from extra/io/sniffer/filter/authors.txt rename to unmaintained/sniffer/io/filter/authors.txt diff --git a/extra/io/sniffer/filter/backend/authors.txt b/unmaintained/sniffer/io/filter/backend/authors.txt similarity index 100% rename from extra/io/sniffer/filter/backend/authors.txt rename to unmaintained/sniffer/io/filter/backend/authors.txt diff --git a/extra/io/sniffer/filter/backend/backend.factor b/unmaintained/sniffer/io/filter/backend/backend.factor similarity index 100% rename from extra/io/sniffer/filter/backend/backend.factor rename to unmaintained/sniffer/io/filter/backend/backend.factor diff --git a/extra/io/sniffer/filter/bsd/authors.txt b/unmaintained/sniffer/io/filter/bsd/authors.txt similarity index 100% rename from extra/io/sniffer/filter/bsd/authors.txt rename to unmaintained/sniffer/io/filter/bsd/authors.txt diff --git a/extra/io/sniffer/filter/bsd/bsd.factor b/unmaintained/sniffer/io/filter/bsd/bsd.factor similarity index 100% rename from extra/io/sniffer/filter/bsd/bsd.factor rename to unmaintained/sniffer/io/filter/bsd/bsd.factor diff --git a/extra/io/sniffer/filter/filter.factor b/unmaintained/sniffer/io/filter/filter.factor similarity index 100% rename from extra/io/sniffer/filter/filter.factor rename to unmaintained/sniffer/io/filter/filter.factor diff --git a/extra/io/sniffer/sniffer.factor b/unmaintained/sniffer/io/sniffer.factor similarity index 100% rename from extra/io/sniffer/sniffer.factor rename to unmaintained/sniffer/io/sniffer.factor From 8249ce21166dfc51618dbdbc3e0bc4e0dcd5a9a2 Mon Sep 17 00:00:00 2001 From: Daniel Ehrenberg Date: Thu, 21 Feb 2008 18:05:04 -0600 Subject: [PATCH 08/38] OK, now everything should load --- core/alien/c-types/c-types.factor | 2 +- core/io/encodings/encodings.factor | 5 +++-- core/io/streams/byte-array/byte-array.factor | 4 ++-- core/io/streams/c/c-docs.factor | 2 +- core/io/streams/c/c.factor | 2 +- core/io/streams/plain/plain-docs.factor | 11 ++--------- core/listener/listener.factor | 4 ++-- core/parser/parser.factor | 2 +- core/source-files/source-files.factor | 2 +- core/vocabs/loader/loader.factor | 2 +- extra/crypto/sha1/sha1.factor | 2 +- extra/db/sqlite/test.db | Bin 0 -> 2048 bytes extra/documents/documents.factor | 2 +- extra/http/server/templating/templating.factor | 2 +- extra/io/encodings/utf16/utf16.factor | 2 -- extra/io/launcher/launcher.factor | 2 +- extra/io/nonblocking/nonblocking.factor | 2 +- extra/io/unix/backend/backend.factor | 4 ++-- extra/tools/browser/browser.factor | 2 +- extra/tools/deploy/macosx/macosx.factor | 2 +- extra/ui/gadgets/labels/labels.factor | 2 +- 21 files changed, 25 insertions(+), 33 deletions(-) create mode 100644 extra/db/sqlite/test.db diff --git a/core/alien/c-types/c-types.factor b/core/alien/c-types/c-types.factor index 983fea0159..a67c7f4fb9 100755 --- a/core/alien/c-types/c-types.factor +++ b/core/alien/c-types/c-types.factor @@ -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 io.encodings.binary ; +system compiler.units io.files io.encodings.binary ; IN: alien.c-types DEFER: diff --git a/core/io/encodings/encodings.factor b/core/io/encodings/encodings.factor index 5cb87da36f..28cf36060b 100755 --- a/core/io/encodings/encodings.factor +++ b/core/io/encodings/encodings.factor @@ -90,7 +90,7 @@ TUPLE: decoded code cr ; M: decoded stream-read tuck { delegate decoded-code } get-slots decode-read fix-read ; -M: decoded stream-read-partial tuck stream-read fix-read ; +M: decoded stream-read-partial stream-read ; : read-until-loop ( stream delim -- ch ) ! Copied from { c-reader stream-read-until }!!! @@ -113,7 +113,8 @@ M: decoded stream-read-until ] [ nip ] if ] [ nip ] if ; -M: decoded stream-read1 1 swap stream-read ; +M: decoded stream-read1 + 1 swap stream-read [ first ] [ f ] if* ; M: decoded stream-readln ( stream -- str ) "\r\n" over stream-read-until handle-readln ; diff --git a/core/io/streams/byte-array/byte-array.factor b/core/io/streams/byte-array/byte-array.factor index eb224650f3..afbc94bf6a 100644 --- a/core/io/streams/byte-array/byte-array.factor +++ b/core/io/streams/byte-array/byte-array.factor @@ -3,14 +3,14 @@ sequences io namespaces ; IN: io.streams.byte-array : ( encoding -- stream ) - 512 swap ; + 512 swap ; : with-byte-writer ( encoding quot -- byte-array ) >r r> [ stdio get ] compose with-stream* >byte-array ; inline : ( byte-array encoding -- stream ) - >r >byte-vector dup reverse-here r> ; + >r >byte-vector dup reverse-here r> ; : with-byte-reader ( byte-array encoding quot -- ) >r r> with-stream ; inline diff --git a/core/io/streams/c/c-docs.factor b/core/io/streams/c/c-docs.factor index de8a756f92..d95e02321c 100644 --- a/core/io/streams/c/c-docs.factor +++ b/core/io/streams/c/c-docs.factor @@ -33,7 +33,7 @@ HELP: ( out -- stream ) HELP: { $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 } "." } ; +{ $description "Creates a duplex stream which reads and writes data by calling C standard library functions." } ; HELP: fopen ( path mode -- alien ) { $values { "path" "a pathname string" } { "mode" "an access mode specifier" } { "alien" "a C FILE* handle" } } diff --git a/core/io/streams/c/c.factor b/core/io/streams/c/c.factor index 8a6430eb86..7481c79cb5 100755 --- a/core/io/streams/c/c.factor +++ b/core/io/streams/c/c.factor @@ -14,7 +14,7 @@ M: c-writer stream-write1 >r 1string r> stream-write ; M: c-writer stream-write - c-writer-handle fwrite ; + >r >string r> c-writer-handle fwrite ; M: c-writer stream-flush c-writer-handle fflush ; diff --git a/core/io/streams/plain/plain-docs.factor b/core/io/streams/plain/plain-docs.factor index 4d7c5cc25e..a84e5be4f7 100644 --- a/core/io/streams/plain/plain-docs.factor +++ b/core/io/streams/plain/plain-docs.factor @@ -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 } ; +{ $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 } "." } -{ $see-also "stream-protocol" } ; - -HELP: -{ $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" } ; diff --git a/core/listener/listener.factor b/core/listener/listener.factor index 288cb53322..a29d7d5802 100755 --- a/core/listener/listener.factor +++ b/core/listener/listener.factor @@ -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 memory namespaces -parser sequences strings io.styles io.streams.lines +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 diff --git a/core/parser/parser.factor b/core/parser/parser.factor index fe9d2769c9..be527f11c7 100755 --- a/core/parser/parser.factor +++ b/core/parser/parser.factor @@ -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.encodings.utf8 +io.files io.streams.string vocabs io.encodings.utf8 source-files classes hashtables compiler.errors compiler.units ; IN: parser diff --git a/core/source-files/source-files.factor b/core/source-files/source-files.factor index d2566982f8..185e9a1715 100755 --- a/core/source-files/source-files.factor +++ b/core/source-files/source-files.factor @@ -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.crc32 io.streams.string io.streams.lines vocabs +io.files io.crc32 io.streams.string vocabs hashtables graphs compiler.units io.encodings.utf8 ; IN: source-files diff --git a/core/vocabs/loader/loader.factor b/core/vocabs/loader/loader.factor index 2d53ed82e2..9ea38c9cff 100755 --- a/core/vocabs/loader/loader.factor +++ b/core/vocabs/loader/loader.factor @@ -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 ; IN: vocabs.loader diff --git a/extra/crypto/sha1/sha1.factor b/extra/crypto/sha1/sha1.factor index 8f8b3e0cdd..eaad6df622 100644 --- a/extra/crypto/sha1/sha1.factor +++ b/extra/crypto/sha1/sha1.factor @@ -1,6 +1,6 @@ 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 diff --git a/extra/db/sqlite/test.db b/extra/db/sqlite/test.db new file mode 100644 index 0000000000000000000000000000000000000000..e483c47cea528c95f10fcf66fcbb67ffa351ffd1 GIT binary patch literal 2048 zcmWFz^vNtqRY=P(%1ta$FlJz3U}R))P*7lCU|k literal 0 HcmV?d00001 diff --git a/extra/documents/documents.factor b/extra/documents/documents.factor index 34ecce5f8e..993e69ec14 100755 --- a/extra/documents/documents.factor +++ b/extra/documents/documents.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2006, 2007 Slava Pestov ! See http://factorcode.org/license.txt for BSD license. USING: arrays io kernel math models namespaces sequences strings -splitting io.streams.lines combinators unicode.categories ; +splitting combinators unicode.categories ; IN: documents : +col ( loc n -- newloc ) >r first2 r> + 2array ; diff --git a/extra/http/server/templating/templating.factor b/extra/http/server/templating/templating.factor index d15bec4fb2..046541d94e 100755 --- a/extra/http/server/templating/templating.factor +++ b/extra/http/server/templating/templating.factor @@ -2,7 +2,7 @@ ! 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 io.encodings.utf8 ; diff --git a/extra/io/encodings/utf16/utf16.factor b/extra/io/encodings/utf16/utf16.factor index a241913fb5..3e10dcba35 100755 --- a/extra/io/encodings/utf16/utf16.factor +++ b/extra/io/encodings/utf16/utf16.factor @@ -126,8 +126,6 @@ M: utf16be encode-string drop encode-utf16be ; M: utf16be decode-step drop decode-utf16be-step ; TUPLE: utf16 encoding ; -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> diff --git a/extra/io/launcher/launcher.factor b/extra/io/launcher/launcher.factor index 13ae64f159..00cce32303 100755 --- a/extra/io/launcher/launcher.factor +++ b/extra/io/launcher/launcher.factor @@ -2,7 +2,7 @@ ! See http://factorcode.org/license.txt for BSD license. USING: io io.backend io.timeouts system kernel namespaces strings hashtables sequences assocs combinators vocabs.loader -init threads continuations math ; +init threads continuations math io.encodings ; IN: io.launcher ! Non-blocking process exit notification facility diff --git a/extra/io/nonblocking/nonblocking.factor b/extra/io/nonblocking/nonblocking.factor index 0ae41f08fc..a8828afff6 100755 --- a/extra/io/nonblocking/nonblocking.factor +++ b/extra/io/nonblocking/nonblocking.factor @@ -2,7 +2,7 @@ ! 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 +sbufs system io.streams.plain io.streams.duplex io.encodings io.backend continuations debugger classes byte-arrays namespaces splitting dlists assocs ; diff --git a/extra/io/unix/backend/backend.factor b/extra/io/unix/backend/backend.factor index b1f4ee949d..d3873c60fe 100755 --- a/extra/io/unix/backend/backend.factor +++ b/extra/io/unix/backend/backend.factor @@ -2,9 +2,9 @@ ! See http://factorcode.org/license.txt for BSD license. USING: alien generic assocs kernel kernel.private math io.nonblocking sequences strings structs sbufs -threads unix vectors io.buffers io.backend +threads unix vectors io.buffers io.backend io.encodings io.streams.duplex math.parser continuations system libc -qualified namespaces io.timeouts ; +qualified namespaces io.timeouts io.encodings.utf8 ; QUALIFIED: io IN: io.unix.backend diff --git a/extra/tools/browser/browser.factor b/extra/tools/browser/browser.factor index e56703a894..24836c1201 100755 --- a/extra/tools/browser/browser.factor +++ b/extra/tools/browser/browser.factor @@ -2,7 +2,7 @@ ! See http://factorcode.org/license.txt for BSD license. USING: namespaces splitting sequences io.files kernel assocs words vocabs vocabs.loader definitions parser continuations -inspector debugger io io.styles io.streams.lines hashtables +inspector debugger io io.styles hashtables sorting prettyprint source-files arrays combinators strings system math.parser help.markup help.topics help.syntax help.stylesheet memoize io.encodings.utf8 ; diff --git a/extra/tools/deploy/macosx/macosx.factor b/extra/tools/deploy/macosx/macosx.factor index e4a0d539d1..bdbb7f1aee 100755 --- a/extra/tools/deploy/macosx/macosx.factor +++ b/extra/tools/deploy/macosx/macosx.factor @@ -2,7 +2,7 @@ ! See http://factorcode.org/license.txt for BSD license. USING: io io.files io.launcher kernel namespaces sequences system tools.deploy.backend tools.deploy.config assocs -hashtables prettyprint io.unix.backend cocoa +hashtables prettyprint io.unix.backend cocoa io.encodings.utf8 cocoa.application cocoa.classes cocoa.plists qualified ; QUALIFIED: unix IN: tools.deploy.macosx diff --git a/extra/ui/gadgets/labels/labels.factor b/extra/ui/gadgets/labels/labels.factor index 5e5801dd02..167aa26084 100755 --- a/extra/ui/gadgets/labels/labels.factor +++ b/extra/ui/gadgets/labels/labels.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2005, 2007 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: arrays hashtables io kernel math namespaces -opengl sequences io.streams.lines strings splitting +opengl sequences strings splitting ui.gadgets ui.gadgets.tracks ui.gadgets.theme ui.render colors models ; IN: ui.gadgets.labels From 1b80c453fdb0acfc386b46c93ca572f0c99bc10b Mon Sep 17 00:00:00 2001 From: Daniel Ehrenberg Date: Thu, 21 Feb 2008 19:09:53 -0600 Subject: [PATCH 09/38] Little changes for encodings --- core/io/encodings/encodings.factor | 6 +++--- extra/io/unix/sockets/sockets.factor | 2 +- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/core/io/encodings/encodings.factor b/core/io/encodings/encodings.factor index 28cf36060b..dfd9f9a36f 100755 --- a/core/io/encodings/encodings.factor +++ b/core/io/encodings/encodings.factor @@ -92,17 +92,17 @@ M: decoded stream-read M: decoded stream-read-partial stream-read ; -: read-until-loop ( stream delim -- ch ) +: decoded-read-until ( stream delim -- ch ) ! Copied from { c-reader stream-read-until }!!! over stream-read1 dup [ - dup pick memq? [ 2nip ] [ , read-until-loop ] if + dup pick memq? [ 2nip ] [ , decoded-read-until ] if ] [ 2nip ] if ; M: decoded stream-read-until ! Copied from { c-reader stream-read-until }!!! - [ swap read-until-loop ] "" make + [ swap decoded-read-until ] "" make swap over empty? over not and [ 2drop f f ] when ; : fix-read1 ( stream char -- char ) diff --git a/extra/io/unix/sockets/sockets.factor b/extra/io/unix/sockets/sockets.factor index 60a49aadd2..b78abbe11b 100755 --- a/extra/io/unix/sockets/sockets.factor +++ b/extra/io/unix/sockets/sockets.factor @@ -48,7 +48,7 @@ M: unix-io (client) ( addrspec -- stream ) dup r> r> connect zero? err_no EINPROGRESS = or [ dup init-client-socket - dup handle>duplex-stream + dup f handle>duplex-stream dup duplex-stream-out dup wait-to-connect pending-init-error From 72e15848bf63c0efd4a909e0a2223e313b5526d3 Mon Sep 17 00:00:00 2001 From: Daniel Ehrenberg Date: Fri, 22 Feb 2008 20:21:23 -0600 Subject: [PATCH 10/38] More changes for encodings --- core/bootstrap/image/image.factor | 3 +-- core/io/encodings/encodings.factor | 19 +++++++++++++++---- core/io/encodings/utf8/utf8-tests.factor | 4 ++-- core/io/io-tests.factor | 4 ++-- core/io/streams/c/c-tests.factor | 2 +- core/io/streams/string/string.factor | 10 +++++++--- extra/io/encodings/ascii/ascii.factor | 6 +++--- extra/io/encodings/latin1/latin1.factor | 2 +- extra/io/encodings/utf16/utf16-tests.factor | 4 ++-- extra/io/nonblocking/nonblocking.factor | 9 ++++----- extra/io/unix/backend/backend.factor | 2 +- extra/io/unix/launcher/launcher.factor | 2 +- extra/io/unix/sockets/sockets.factor | 2 +- extra/xmode/utilities/utilities-tests.factor | 2 +- 14 files changed, 42 insertions(+), 29 deletions(-) diff --git a/core/bootstrap/image/image.factor b/core/bootstrap/image/image.factor index 36cfad828e..241511c00d 100755 --- a/core/bootstrap/image/image.factor +++ b/core/bootstrap/image/image.factor @@ -416,8 +416,7 @@ M: curry ' "Writing image to " write architecture get boot-image-name resource-path dup write "..." print flush - ! binary - [ (write-image) ] with-stream ; + binary [ (write-image) ] with-stream ; PRIVATE> diff --git a/core/io/encodings/encodings.factor b/core/io/encodings/encodings.factor index dfd9f9a36f..8267ad5217 100755 --- a/core/io/encodings/encodings.factor +++ b/core/io/encodings/encodings.factor @@ -3,7 +3,7 @@ USING: math kernel sequences sbufs vectors namespaces growable strings io classes continuations combinators io.styles io.streams.plain io.encodings.binary splitting -io.streams.string io.streams.duplex ; +io.streams.duplex ; IN: io.encodings ! Decoding @@ -50,7 +50,7 @@ GENERIC: decode-step ( buf byte ch state encoding -- buf ch state ) ] if ; : decode-read ( length stream encoding -- string ) - >r swap start-decoding r> + >r swap >fixnum start-decoding r> decode-read-loop ; TUPLE: decoded code cr ; @@ -114,7 +114,7 @@ M: decoded stream-read-until ] [ nip ] if ; M: decoded stream-read1 - 1 swap stream-read [ first ] [ f ] if* ; + 1 swap stream-read f like [ first ] [ f ] if* ; M: decoded stream-readln ( stream -- str ) "\r\n" over stream-read-until handle-readln ; @@ -127,7 +127,10 @@ TUPLE: encode-error ; TUPLE: encoded code ; : ( stream encoding-class -- encoded-stream ) - construct-empty { set-delegate set-encoded-code } encoded construct ; + dup binary eq? [ drop ] [ + construct-empty { set-delegate set-encoded-code } + encoded construct + ] if ; GENERIC: encode-string ( string encoding -- byte-array ) M: tuple-class encode-string construct-empty encode-string ; @@ -153,3 +156,11 @@ INSTANCE: encoded plain-writer : ( duplex-stream encoding -- duplex-stream ) swap { duplex-stream-in duplex-stream-out } get-slots pick reencode >r swap redecode r> ; + +! The null encoding does nothing +! (used to wrap things as line-reader/plain-writer) +! Later this will be replaced by inheritance + +TUPLE: null-encoding ; +M: null-encoding encode-string drop ; +M: null-encoding decode-step 3drop over push f f ; diff --git a/core/io/encodings/utf8/utf8-tests.factor b/core/io/encodings/utf8/utf8-tests.factor index 44d0870385..a6a32041be 100644 --- a/core/io/encodings/utf8/utf8-tests.factor +++ b/core/io/encodings/utf8/utf8-tests.factor @@ -2,10 +2,10 @@ USING: io.encodings.utf8 tools.test sbufs kernel io io.encodings sequences strings arrays unicode ; : decode-utf8-w/stream ( array -- newarray ) - >sbuf dup reverse-here utf8 contents ; + >sbuf dup reverse-here utf8 contents ; : encode-utf8-w/stream ( array -- newarray ) - SBUF" " clone tuck utf8 stream-write >array ; + SBUF" " clone tuck utf8 stream-write >array ; [ { CHAR: replacement-character } ] [ { BIN: 11110101 BIN: 10111111 BIN: 10000000 BIN: 11111111 } decode-utf8-w/stream >array ] unit-test diff --git a/core/io/io-tests.factor b/core/io/io-tests.factor index 74b6b5034f..394deb0e5c 100644 --- a/core/io/io-tests.factor +++ b/core/io/io-tests.factor @@ -1,5 +1,5 @@ USING: arrays io io.files kernel math parser strings system -tools.test words namespaces io.encodings.ascii io.encodings.binary ; +tools.test words namespaces io.encodings.latin1 io.encodings.binary ; IN: temporary [ f ] [ @@ -8,7 +8,7 @@ IN: temporary ] unit-test : ( resource -- stream ) - resource-path ascii ; + resource-path latin1 ; [ "This is a line.\rThis is another line.\r" diff --git a/core/io/streams/c/c-tests.factor b/core/io/streams/c/c-tests.factor index 66ea460126..cc2aa9dde0 100755 --- a/core/io/streams/c/c-tests.factor +++ b/core/io/streams/c/c-tests.factor @@ -1,4 +1,4 @@ -USING: tools.test io.files io io.streams.c ; +USING: tools.test io.files io io.streams.c io.encodings.ascii ; IN: temporary [ "hello world" ] [ diff --git a/core/io/streams/string/string.factor b/core/io/streams/string/string.factor index f74f91c5bd..e1c14e6ee3 100755 --- a/core/io/streams/string/string.factor +++ b/core/io/streams/string/string.factor @@ -2,7 +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 growable continuations io.streams.plain ; +generic splitting growable continuations io.streams.plain +io.encodings ; M: growable dispose drop ; @@ -23,7 +24,7 @@ M: growable stream-read1 dup empty? [ drop f ] [ pop ] if ; 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 ; @@ -49,7 +50,7 @@ M: growable stream-read-partial stream-read ; : ( str -- stream ) - >sbuf dup reverse-here ; + >sbuf dup reverse-here null-encoding ; : with-string-reader ( str quot -- ) >r r> with-stream ; inline @@ -74,3 +75,6 @@ M: plain-writer stream-write-table [ drop format-table [ print ] each ] with-stream* ; M: plain-writer make-cell-stream 2drop ; + +M: growable stream-readln ( stream -- str ) + "\r\n" over stream-read-until handle-readln ; diff --git a/extra/io/encodings/ascii/ascii.factor b/extra/io/encodings/ascii/ascii.factor index 410c07f1ca..0878a7a624 100644 --- a/extra/io/encodings/ascii/ascii.factor +++ b/extra/io/encodings/ascii/ascii.factor @@ -3,13 +3,13 @@ USING: io io.encodings strings kernel math sequences byte-arrays io.encodings ; IN: io.encodings.ascii -: encode-check>= ( string max -- byte-array ) - dupd [ >= ] curry all? [ >byte-array ] [ encode-error ] if ; +: encode-check<= ( string max -- byte-array ) + dupd [ <= ] curry all? [ >byte-array ] [ encode-error ] if ; TUPLE: ascii ; M: ascii encode-string - drop 127 encode-check>= ; + drop 127 encode-check<= ; M: ascii decode-step 3drop dup 127 >= [ encode-error ] when over push f f ; diff --git a/extra/io/encodings/latin1/latin1.factor b/extra/io/encodings/latin1/latin1.factor index 7e867b15af..b914589dc9 100755 --- a/extra/io/encodings/latin1/latin1.factor +++ b/extra/io/encodings/latin1/latin1.factor @@ -6,7 +6,7 @@ IN: io.encodings.latin1 TUPLE: latin1 ; M: latin1 encode-string - drop 255 encode-check>= ; + drop 255 encode-check<= ; M: latin1 decode-step 3drop over push f f ; diff --git a/extra/io/encodings/utf16/utf16-tests.factor b/extra/io/encodings/utf16/utf16-tests.factor index 041c486915..1677c2d38d 100755 --- a/extra/io/encodings/utf16/utf16-tests.factor +++ b/extra/io/encodings/utf16/utf16-tests.factor @@ -2,10 +2,10 @@ 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> contents >array ; + >r >sbuf dup reverse-here r> contents >array ; : encode-w/stream ( array encoding -- newarray ) - >r SBUF" " clone tuck r> stream-write >array ; + >r SBUF" " clone tuck r> 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 diff --git a/extra/io/nonblocking/nonblocking.factor b/extra/io/nonblocking/nonblocking.factor index a8828afff6..21bb284805 100755 --- a/extra/io/nonblocking/nonblocking.factor +++ b/extra/io/nonblocking/nonblocking.factor @@ -39,15 +39,14 @@ GENERIC: close-handle ( handle -- ) : ( handle type -- port ) default-buffer-size get swap ; -: ( handle -- stream ) +: ( handle -- input-port ) input-port ; -: ( handle -- stream ) +: ( handle -- output-port ) output-port ; -: handle>duplex-stream ( in-handle out-handle encoding -- stream ) - [ swap swap ] keep - [ -rot >r swap r> ] +: handle>duplex-stream ( in-handle out-handle -- stream ) + [ swap swap ] [ ] [ dispose ] cleanup ; : pending-error ( port -- ) diff --git a/extra/io/unix/backend/backend.factor b/extra/io/unix/backend/backend.factor index d3873c60fe..e0921f6f02 100755 --- a/extra/io/unix/backend/backend.factor +++ b/extra/io/unix/backend/backend.factor @@ -182,7 +182,7 @@ M: unix-io io-multiplex ( ms -- ) mx get-global wait-for-events ; M: unix-io init-stdio ( -- ) - 0 1 utf8 handle>duplex-stream io:stdio set-global + 0 1 handle>duplex-stream io:stdio utf8 set-global 2 utf8 io:stderr set-global ; ! mx io-task for embedding an fd-based mx inside another mx diff --git a/extra/io/unix/launcher/launcher.factor b/extra/io/unix/launcher/launcher.factor index 128adbc3dc..deff2d2642 100755 --- a/extra/io/unix/launcher/launcher.factor +++ b/extra/io/unix/launcher/launcher.factor @@ -99,7 +99,7 @@ M: unix-io kill-process* ( pid -- ) M: unix-io process-stream* [ - spawn-process-stream >r latin1 handle>duplex-stream r> + spawn-process-stream >r handle>duplex-stream r> ] with-descriptor ; : find-process ( handle -- process ) diff --git a/extra/io/unix/sockets/sockets.factor b/extra/io/unix/sockets/sockets.factor index b78abbe11b..60a49aadd2 100755 --- a/extra/io/unix/sockets/sockets.factor +++ b/extra/io/unix/sockets/sockets.factor @@ -48,7 +48,7 @@ M: unix-io (client) ( addrspec -- stream ) dup r> r> connect zero? err_no EINPROGRESS = or [ dup init-client-socket - dup f handle>duplex-stream + dup handle>duplex-stream dup duplex-stream-out dup wait-to-connect pending-init-error diff --git a/extra/xmode/utilities/utilities-tests.factor b/extra/xmode/utilities/utilities-tests.factor index 713700bf7a..820d1bcc9a 100755 --- a/extra/xmode/utilities/utilities-tests.factor +++ b/extra/xmode/utilities/utilities-tests.factor @@ -49,5 +49,5 @@ TAGS> } ] [ "extra/xmode/utilities/test.xml" - resource-path read-xml parse-company-tag + resource-path file>xml parse-company-tag ] unit-test From a4963a92171063bfacaa149510236ffc1072b793 Mon Sep 17 00:00:00 2001 From: Daniel Ehrenberg Date: Fri, 22 Feb 2008 20:41:14 -0600 Subject: [PATCH 11/38] Fixing Unix/Windows init-stdio --- extra/io/unix/backend/backend.factor | 2 +- extra/io/windows/ce/backend/backend.factor | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/extra/io/unix/backend/backend.factor b/extra/io/unix/backend/backend.factor index e0921f6f02..641b3ebd24 100755 --- a/extra/io/unix/backend/backend.factor +++ b/extra/io/unix/backend/backend.factor @@ -182,7 +182,7 @@ M: unix-io io-multiplex ( ms -- ) mx get-global wait-for-events ; M: unix-io init-stdio ( -- ) - 0 1 handle>duplex-stream io:stdio utf8 set-global + 0 1 handle>duplex-stream utf8 io:stdio set-global 2 utf8 io:stderr set-global ; ! mx io-task for embedding an fd-based mx inside another mx diff --git a/extra/io/windows/ce/backend/backend.factor b/extra/io/windows/ce/backend/backend.factor index e90a9f16e2..349276fe72 100755 --- a/extra/io/windows/ce/backend/backend.factor +++ b/extra/io/windows/ce/backend/backend.factor @@ -1,7 +1,7 @@ USING: io.nonblocking io.windows threads.private kernel io.backend windows.winsock windows.kernel32 windows io.streams.duplex io namespaces alien.syntax system combinators -io.buffers ; +io.buffers io.encodings io.encodings.utf8 ; IN: io.windows.ce.backend : port-errored ( port -- ) @@ -41,5 +41,5 @@ M: windows-ce-io init-stdio ( -- ) ] [ 0 _getstdfilex _fileno 1 _getstdfilex _fileno - ] if + ] if utf8 ] with-variable stdio set-global ; From 75f1fb5246a93183ba58b2ffd2c2099394a68b76 Mon Sep 17 00:00:00 2001 From: Daniel Ehrenberg Date: Sun, 24 Feb 2008 01:37:05 -0600 Subject: [PATCH 12/38] Various refactorings of streams with encodings --- core/io/backend/backend.factor | 8 +++++-- core/io/encodings/encodings.factor | 5 ++--- core/io/files/files.factor | 12 +++++------ core/io/streams/c/c-docs.factor | 5 ----- core/io/streams/c/c.factor | 17 +++++++-------- extra/io/launcher/launcher.factor | 5 ++--- extra/io/nonblocking/nonblocking.factor | 17 +++++++-------- extra/io/sockets/sockets.factor | 20 +++++++++++------- extra/io/unix/backend/backend.factor | 7 ++++--- extra/io/unix/files/files.factor | 6 +++--- extra/io/unix/launcher/launcher.factor | 4 ++-- extra/io/unix/sockets/sockets.factor | 22 +++++++++----------- extra/io/windows/ce/backend/backend.factor | 11 ++++++---- extra/io/windows/ce/sockets/sockets.factor | 18 +++++++--------- extra/io/windows/nt/launcher/launcher.factor | 8 ++++--- extra/io/windows/nt/sockets/sockets.factor | 22 +++++++++----------- extra/io/windows/windows.factor | 9 +++----- 17 files changed, 96 insertions(+), 100 deletions(-) diff --git a/core/io/backend/backend.factor b/core/io/backend/backend.factor index c38b7355b1..2824b6a299 100755 --- a/core/io/backend/backend.factor +++ b/core/io/backend/backend.factor @@ -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 stderr set-global + utf8 stdio set-global ; HOOK: io-multiplex io-backend ( ms -- ) diff --git a/core/io/encodings/encodings.factor b/core/io/encodings/encodings.factor index 8267ad5217..670a235615 100755 --- a/core/io/encodings/encodings.factor +++ b/core/io/encodings/encodings.factor @@ -153,9 +153,8 @@ INSTANCE: encoded plain-writer : redecode ( stream encoding -- newstream ) over decoded? [ >r delegate r> ] when ; -: ( duplex-stream encoding -- duplex-stream ) - swap { duplex-stream-in duplex-stream-out } get-slots - pick reencode >r swap redecode r> ; +: ( stream-in stream-out encoding -- duplex-stream ) + tuck reencode >r redecode r> ; ! The null encoding does nothing ! (used to wrap things as line-reader/plain-writer) diff --git a/core/io/files/files.factor b/core/io/files/files.factor index 491cc6e81a..4a04be3bfe 100755 --- a/core/io/files/files.factor +++ b/core/io/files/files.factor @@ -10,20 +10,20 @@ HOOK: cd io-backend ( path -- ) HOOK: cwd io-backend ( -- path ) -HOOK: file-reader* io-backend ( path -- stream ) +HOOK: (file-reader) io-backend ( path -- stream ) -HOOK: file-writer* io-backend ( path -- stream ) +HOOK: (file-writer) io-backend ( path -- stream ) -HOOK: file-appender* io-backend ( path -- stream ) +HOOK: (file-appender) io-backend ( path -- stream ) : ( path encoding -- stream ) - swap file-reader* swap ; + swap (file-reader) swap ; : ( path encoding -- stream ) - swap file-writer* swap ; + swap (file-writer) swap ; : ( path encoding -- stream ) - swap file-appender* swap ; + swap (file-appender) swap ; HOOK: delete-file io-backend ( path -- ) diff --git a/core/io/streams/c/c-docs.factor b/core/io/streams/c/c-docs.factor index d95e02321c..5d9c7b1a53 100644 --- a/core/io/streams/c/c-docs.factor +++ b/core/io/streams/c/c-docs.factor @@ -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 } { $subsection } -{ $subsection } "Underlying primitives used to implement the above:" { $subsection fopen } { $subsection fwrite } @@ -31,10 +30,6 @@ HELP: ( 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: -{ $values { "in" "a C FILE* handle" } { "out" "a C FILE* handle" } { "stream" "a new stream" } } -{ $description "Creates a duplex stream which reads and writes data by calling C standard library functions." } ; - 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." } diff --git a/core/io/streams/c/c.factor b/core/io/streams/c/c.factor index 7481c79cb5..164d0d5f58 100755 --- a/core/io/streams/c/c.factor +++ b/core/io/streams/c/c.factor @@ -49,29 +49,26 @@ M: c-reader stream-read-until M: c-reader dispose c-reader-handle fclose ; -: ( in out -- stream ) - >r r> ; - M: object init-io ; : stdin-handle 11 getenv ; : stdout-handle 12 getenv ; : stderr-handle 38 getenv ; -M: object init-stdio - stdin-handle stdout-handle - utf8 stdio set-global - stderr-handle utf8 stderr set-global ; +M: object (init-stdio) + stdin-handle + stdout-handle + stderr-handle ; M: object io-multiplex (sleep) ; -M: object file-reader* +M: object (file-reader) "rb" fopen ; -M: object file-writer* +M: object (file-writer) "wb" fopen ; -M: object file-appender* +M: object (file-appender) "ab" fopen ; : show ( msg -- ) diff --git a/extra/io/launcher/launcher.factor b/extra/io/launcher/launcher.factor index 00cce32303..fb162fb3c8 100755 --- a/extra/io/launcher/launcher.factor +++ b/extra/io/launcher/launcher.factor @@ -119,14 +119,13 @@ M: process get-lapse process-lapse ; M: process timed-out kill-process ; -HOOK: process-stream* io-backend ( desc -- stream process ) -! Process streams are always latin1 for now; will be updated +HOOK: (process-stream) io-backend ( desc -- in out process ) TUPLE: process-stream process ; : ( desc encoding -- stream ) swap >descriptor - [ process-stream* >r swap r> ] keep + [ (process-stream) >r rot r> ] keep +timeout+ swap at [ over set-timeout ] when* { set-delegate set-process-stream-process } process-stream construct ; diff --git a/extra/io/nonblocking/nonblocking.factor b/extra/io/nonblocking/nonblocking.factor index 21bb284805..b16005b4e5 100755 --- a/extra/io/nonblocking/nonblocking.factor +++ b/extra/io/nonblocking/nonblocking.factor @@ -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.plain io.streams.duplex io.encodings +sbufs 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 @@ -45,9 +45,8 @@ GENERIC: close-handle ( handle -- ) : ( handle -- output-port ) output-port ; -: handle>duplex-stream ( in-handle out-handle -- stream ) - [ swap swap ] - [ ] [ dispose ] cleanup ; +: ( read-handle write-handle -- input-port output-port ) + swap [ swap ] [ dispose ] cleanup ; : pending-error ( port -- ) dup port-error f rot set-port-error [ throw ] when* ; @@ -171,11 +170,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 encoding ; -: ( handle addr -- server ) - >r f server-port r> - { set-delegate set-server-port-addr } +: ( handle addr encoding -- server ) + rot f server-port + { set-server-port-addr set-server-port-encoding set-delegate } server-port construct ; : check-server-port ( port -- ) diff --git a/extra/io/sockets/sockets.factor b/extra/io/sockets/sockets.factor index 6cf75f2f60..07e4f0afca 100755 --- a/extra/io/sockets/sockets.factor +++ b/extra/io/sockets/sockets.factor @@ -1,8 +1,8 @@ ! Copyright (C) 2007, 2008 Slava Pestov, Daniel Ehrenberg. ! See http://factorcode.org/license.txt for BSD license. -IN: io.sockets USING: generic kernel io.backend namespaces continuations -sequences arrays io.encodings ; +sequences arrays io.encodings io.nonblocking ; +IN: io.sockets TUPLE: local path ; @@ -26,18 +26,24 @@ TUPLE: client-stream addr ; { set-client-stream-addr set-delegate } client-stream construct ; -HOOK: (client) io-backend ( addrspec -- stream ) +HOOK: (client) io-backend ( addrspec -- client-in client-out ) -GENERIC: client* ( addrspec -- stream ) +GENERIC: client* ( addrspec -- client-in client-out ) M: array client* [ (client) ] attempt-all ; M: object client* (client) ; : ( addrspec encoding -- stream ) - >r client* r> ; + [ >r client* r> ] keep ; -HOOK: io-backend ( addrspec -- server ) +HOOK: (server) io-backend ( addrspec -- handle ) -HOOK: accept io-backend ( server -- client ) +: ( addrspec encoding -- server ) + >r [ (server) ] keep r> ; + +HOOK: (accept) io-backend ( server -- stream-in stream-out ) + +: accept ( server -- client ) + [ (accept) ] keep server-port-encoding ; HOOK: io-backend ( addrspec -- datagram ) diff --git a/extra/io/unix/backend/backend.factor b/extra/io/unix/backend/backend.factor index 641b3ebd24..4d6e839989 100755 --- a/extra/io/unix/backend/backend.factor +++ b/extra/io/unix/backend/backend.factor @@ -181,9 +181,10 @@ M: port port-flush ( port -- ) M: unix-io io-multiplex ( ms -- ) mx get-global wait-for-events ; -M: unix-io init-stdio ( -- ) - 0 1 handle>duplex-stream utf8 io:stdio set-global - 2 utf8 io:stderr set-global ; +M: unix-io (init-stdio) ( -- ) + 0 + 1 + 2 ; ! mx io-task for embedding an fd-based mx inside another mx TUPLE: mx-port mx ; diff --git a/extra/io/unix/files/files.factor b/extra/io/unix/files/files.factor index 7a7128d5b6..a156d3b80c 100755 --- a/extra/io/unix/files/files.factor +++ b/extra/io/unix/files/files.factor @@ -17,7 +17,7 @@ M: unix-io cd : open-read ( path -- fd ) O_RDONLY file-mode open dup io-error ; -M: unix-io file-reader* ( path -- stream ) +M: unix-io (file-reader) ( path -- stream ) open-read ; : write-flags { O_WRONLY O_CREAT O_TRUNC } flags ; inline @@ -25,7 +25,7 @@ M: unix-io file-reader* ( path -- stream ) : open-write ( path -- fd ) write-flags file-mode open dup io-error ; -M: unix-io file-writer* ( path -- stream ) +M: unix-io (file-writer) ( path -- stream ) open-write ; : append-flags { O_WRONLY O_APPEND O_CREAT } flags ; inline @@ -34,7 +34,7 @@ M: unix-io file-writer* ( path -- stream ) append-flags file-mode open dup io-error [ dup 0 SEEK_END lseek io-error ] [ ] [ close ] cleanup ; -M: unix-io file-appender* ( path -- stream ) +M: unix-io (file-appender) ( path -- stream ) open-append ; M: unix-io rename-file ( from to -- ) diff --git a/extra/io/unix/launcher/launcher.factor b/extra/io/unix/launcher/launcher.factor index deff2d2642..8384c2fce6 100755 --- a/extra/io/unix/launcher/launcher.factor +++ b/extra/io/unix/launcher/launcher.factor @@ -97,9 +97,9 @@ M: unix-io kill-process* ( pid -- ) -rot 2dup second close first close ] with-fork first swap second rot ; -M: unix-io process-stream* +M: unix-io (process-stream) [ - spawn-process-stream >r handle>duplex-stream r> + spawn-process-stream >r r> ] with-descriptor ; : find-process ( handle -- process ) diff --git a/extra/io/unix/sockets/sockets.factor b/extra/io/unix/sockets/sockets.factor index 60a49aadd2..2af77e83c4 100755 --- a/extra/io/unix/sockets/sockets.factor +++ b/extra/io/unix/sockets/sockets.factor @@ -3,12 +3,12 @@ ! We need to fiddle with the exact search order here, since ! unix::accept shadows streams::accept. -IN: io.unix.sockets USING: alien alien.c-types generic io kernel math namespaces io.nonblocking parser threads unix sequences byte-arrays io.sockets io.binary io.unix.backend io.streams.duplex io.sockets.impl math.parser continuations libc combinators ; +IN: io.unix.sockets : pending-init-error ( port -- ) #! We close it here to avoid a resource leak; callers of @@ -48,10 +48,9 @@ M: unix-io (client) ( addrspec -- stream ) dup r> r> connect zero? err_no EINPROGRESS = or [ dup init-client-socket - dup handle>duplex-stream - dup duplex-stream-out + dup dup wait-to-connect - pending-init-error + dup pending-init-error ] [ dup close (io-error) ] if ; @@ -74,7 +73,7 @@ TUPLE: accept-task ; : do-accept ( port fd sockaddr -- ) rot [ server-port-addr parse-sockaddr - swap dup handle>duplex-stream + swap dup ] keep set-server-port-client ; M: accept-task do-io-task @@ -92,18 +91,17 @@ USE: io.sockets dup rot make-sockaddr/size bind zero? [ dup close (io-error) ] unless ; -M: unix-io ( addrspec -- server ) - [ - SOCK_STREAM server-fd - dup 10 listen zero? [ dup close (io-error) ] unless - ] keep ; +M: unix-io (server) ( addrspec -- handle ) + SOCK_STREAM server-fd + dup 10 listen zero? [ dup close (io-error) ] unless ; -M: unix-io accept ( server -- client ) +M: unix-io (accept) ( server -- client-in client-out ) #! Wait for a client connection. dup check-server-port dup wait-to-accept dup pending-error - server-port-client ; + server-port-client + { duplex-stream-in duplex-stream-out } get-slots ; ! Datagram sockets - UDP and Unix domain M: unix-io diff --git a/extra/io/windows/ce/backend/backend.factor b/extra/io/windows/ce/backend/backend.factor index 349276fe72..26135521ff 100755 --- a/extra/io/windows/ce/backend/backend.factor +++ b/extra/io/windows/ce/backend/backend.factor @@ -1,7 +1,7 @@ USING: io.nonblocking io.windows threads.private kernel io.backend windows.winsock windows.kernel32 windows io.streams.duplex io namespaces alien.syntax system combinators -io.buffers io.encodings io.encodings.utf8 ; +io.buffers io.encodings io.encodings.utf8 combinators.lib ; IN: io.windows.ce.backend : port-errored ( port -- ) @@ -31,15 +31,18 @@ LIBRARY: libc FUNCTION: void* _getstdfilex int fd ; FUNCTION: void* _fileno void* file ; -M: windows-ce-io init-stdio ( -- ) +M: windows-ce-io (init-stdio) ( -- ) #! We support Windows NT too, to make this I/O backend #! easier to debug. 512 default-buffer-size [ winnt? [ STD_INPUT_HANDLE GetStdHandle STD_OUTPUT_HANDLE GetStdHandle + STD_ERROR_HANDLE GetStdHandle ] [ 0 _getstdfilex _fileno 1 _getstdfilex _fileno - ] if utf8 - ] with-variable stdio set-global ; + 2 _getstdfilex _fileno + ] if [ f ] 3apply + rot -rot [ ] 2apply + ] with-variable ; diff --git a/extra/io/windows/ce/sockets/sockets.factor b/extra/io/windows/ce/sockets/sockets.factor index e9ca6220af..9bc583a3d8 100755 --- a/extra/io/windows/ce/sockets/sockets.factor +++ b/extra/io/windows/ce/sockets/sockets.factor @@ -31,17 +31,15 @@ M: win32-socket wince-write ( port port-handle -- ) windows.winsock:WSAConnect windows.winsock:winsock-error!=0/f ; -M: windows-ce-io (client) ( addrspec -- duplex-stream ) - do-connect dup handle>duplex-stream ; +M: windows-ce-io (client) ( addrspec -- reader writer ) + do-connect dup ; -M: windows-ce-io ( addrspec -- duplex-stream ) - [ - windows.winsock:SOCK_STREAM server-fd - dup listen-on-socket - - ] keep ; +M: windows-ce-io (server) ( addrspec -- handle ) + windows.winsock:SOCK_STREAM server-fd + dup listen-on-socket + ; -M: windows-ce-io accept ( server -- client ) +M: windows-ce-io (accept) ( server -- client ) [ dup check-server-port [ @@ -54,7 +52,7 @@ M: windows-ce-io accept ( server -- client ) [ windows.winsock:winsock-error ] when ] keep ] keep server-port-addr parse-sockaddr swap - dup handle>duplex-stream + ] with-timeout ; M: windows-ce-io ( addrspec -- datagram ) diff --git a/extra/io/windows/nt/launcher/launcher.factor b/extra/io/windows/nt/launcher/launcher.factor index cd9bb9baef..f84dcc154c 100755 --- a/extra/io/windows/nt/launcher/launcher.factor +++ b/extra/io/windows/nt/launcher/launcher.factor @@ -87,7 +87,7 @@ M: windows-nt-io fill-redirection over redirect-stdin over set-STARTUPINFO-hStdInput drop ; -M: windows-nt-io process-stream* +M: windows-nt-io (process-stream) [ [ make-CreateProcess-args @@ -103,8 +103,10 @@ M: windows-nt-io process-stream* dup CreateProcess-args-stdout-pipe pipe-out CloseHandle drop dup CreateProcess-args-stdout-pipe pipe-in - over CreateProcess-args-stdin-pipe pipe-out + over CreateProcess-args-stdin-pipe pipe-out - swap CreateProcess-args-lpProcessInformation + [ f ] 2apply + + rot CreateProcess-args-lpProcessInformation ] with-destructors ] with-descriptor ; diff --git a/extra/io/windows/nt/sockets/sockets.factor b/extra/io/windows/nt/sockets/sockets.factor index eef7476dd5..7af7df9bef 100755 --- a/extra/io/windows/nt/sockets/sockets.factor +++ b/extra/io/windows/nt/sockets/sockets.factor @@ -61,7 +61,8 @@ M: windows-nt-io (client) ( addrspec -- duplex-stream ) dup ConnectEx-args-s* INADDR_ANY roll bind-socket dup (ConnectEx) - dup ConnectEx-args-s* dup handle>duplex-stream + dup ConnectEx-args-s* + dup over set-ConnectEx-args-port dup connect-continuation @@ -91,7 +92,7 @@ TUPLE: AcceptEx-args port f over set-AcceptEx-args-lpdwBytesReceived* (make-overlapped) swap set-AcceptEx-args-lpOverlapped* ; -: (accept) ( AcceptEx -- ) +: ((accept)) ( AcceptEx -- ) \ AcceptEx-args >tuple*< AcceptEx drop winsock-error-string [ throw ] when* ; @@ -125,16 +126,15 @@ TUPLE: AcceptEx-args port [ AcceptEx-args-sAcceptSocket* add-completion ] keep - AcceptEx-args-sAcceptSocket* dup handle>duplex-stream - ; + AcceptEx-args-sAcceptSocket* ; -M: windows-nt-io accept ( server -- client ) +M: windows-nt-io (accept) ( server -- client-in client-out ) [ [ dup check-server-port \ AcceptEx-args construct-empty [ init-accept ] keep - [ (accept) ] keep + [ ((accept)) ] keep [ accept-continuation ] keep AcceptEx-args-port pending-error dup duplex-stream-in pending-error @@ -142,13 +142,11 @@ M: windows-nt-io accept ( server -- client ) ] with-timeout ] with-destructors ; -M: windows-nt-io ( addrspec -- server ) +M: windows-nt-io (server) ( addrspec -- handle ) [ - [ - SOCK_STREAM server-fd dup listen-on-socket - dup add-completion - - ] keep + SOCK_STREAM server-fd dup listen-on-socket + dup add-completion + ] with-destructors ; M: windows-nt-io ( addrspec -- datagram ) diff --git a/extra/io/windows/windows.factor b/extra/io/windows/windows.factor index dc0b14f627..b5da867c56 100755 --- a/extra/io/windows/windows.factor +++ b/extra/io/windows/windows.factor @@ -20,9 +20,6 @@ TUPLE: win32-file handle ptr ; C: win32-file -: ( in out -- stream ) - >r f r> f handle>duplex-stream ; - HOOK: CreateFile-flags io-backend ( DWORD -- DWORD ) HOOK: FileArgs-overlapped io-backend ( port -- overlapped/f ) HOOK: add-completion io-backend ( port -- ) @@ -112,13 +109,13 @@ C: FileArgs [ FileArgs-lpNumberOfBytesRet ] keep FileArgs-lpOverlapped ; -M: windows-io file-reader* ( path -- stream ) +M: windows-io (file-reader) ( path -- stream ) open-read ; -M: windows-io file-writer* ( path -- stream ) +M: windows-io (file-writer) ( path -- stream ) open-write ; -M: windows-io file-appender* ( path -- stream ) +M: windows-io (file-appender) ( path -- stream ) open-append ; M: windows-io rename-file ( from to -- ) From 44f4aa4c69e44199a5bcad9c5ab3b5b9e8678061 Mon Sep 17 00:00:00 2001 From: Daniel Ehrenberg Date: Sun, 24 Feb 2008 19:58:34 -0600 Subject: [PATCH 13/38] More updates for encodings --- core/io/backend/backend.factor | 8 ++++---- core/io/encodings/binary/binary-docs.factor | 2 +- core/io/encodings/encodings.factor | 10 +++++----- core/io/encodings/utf8/utf8-docs.factor | 19 ++++++------------- core/io/encodings/utf8/utf8-tests.factor | 6 +++--- core/io/files/files.factor | 8 ++++---- core/io/io-tests.factor | 4 ++-- core/io/streams/byte-array/byte-array.factor | 4 ++-- core/io/streams/string/string.factor | 2 +- extra/io/encodings/utf16/utf16-tests.factor | 8 ++++---- extra/io/launcher/launcher.factor | 2 +- extra/io/nonblocking/nonblocking.factor | 2 +- extra/io/sockets/sockets-docs.factor | 7 ++++--- extra/io/sockets/sockets.factor | 4 ++-- 14 files changed, 40 insertions(+), 46 deletions(-) diff --git a/core/io/backend/backend.factor b/core/io/backend/backend.factor index 2824b6a299..6f41814ce9 100755 --- a/core/io/backend/backend.factor +++ b/core/io/backend/backend.factor @@ -10,8 +10,8 @@ HOOK: init-io io-backend ( -- ) HOOK: (init-stdio) io-backend ( -- stdin stdout stderr ) : init-stdio ( -- ) - (init-stdio) utf8 stderr set-global - utf8 stdio set-global ; + (init-stdio) utf8 stderr set-global + utf8 stdio set-global ; HOOK: io-multiplex io-backend ( ms -- ) @@ -23,8 +23,8 @@ HOOK: normalize-pathname io-backend ( str -- newstr ) M: object normalize-pathname ; -: set-io-backend ( backend -- ) - io-backend set-global init-io init-stdio ; +: set-io-backend ( io-backend -- ) + io-backend set-global init-io init-stdio die ; [ init-io embedded? [ init-stdio ] unless ] "io.backend" add-init-hook diff --git a/core/io/encodings/binary/binary-docs.factor b/core/io/encodings/binary/binary-docs.factor index f8be5054df..823eea67be 100644 --- a/core/io/encodings/binary/binary-docs.factor +++ b/core/io/encodings/binary/binary-docs.factor @@ -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." } ; diff --git a/core/io/encodings/encodings.factor b/core/io/encodings/encodings.factor index 670a235615..79079929bb 100755 --- a/core/io/encodings/encodings.factor +++ b/core/io/encodings/encodings.factor @@ -54,7 +54,7 @@ GENERIC: decode-step ( buf byte ch state encoding -- buf ch state ) decode-read-loop ; TUPLE: decoded code cr ; -: ( stream decoding-class -- decoded-stream ) +: ( stream decoding-class -- decoded-stream ) dup binary eq? [ drop ] [ construct-empty { set-delegate set-decoded-code } decoded construct @@ -126,7 +126,7 @@ TUPLE: encode-error ; : encode-error ( -- * ) \ encode-error construct-empty throw ; TUPLE: encoded code ; -: ( stream encoding-class -- encoded-stream ) +: ( stream encoding-class -- encoded-stream ) dup binary eq? [ drop ] [ construct-empty { set-delegate set-encoded-code } encoded construct @@ -148,12 +148,12 @@ INSTANCE: encoded plain-writer ! Rebinding duplex streams which have not read anything yet : reencode ( stream encoding -- newstream ) - over encoded? [ >r delegate r> ] when ; + over encoded? [ >r delegate r> ] when ; : redecode ( stream encoding -- newstream ) - over decoded? [ >r delegate r> ] when ; + over decoded? [ >r delegate r> ] when ; -: ( stream-in stream-out encoding -- duplex-stream ) +: ( stream-in stream-out encoding -- duplex-stream ) tuck reencode >r redecode r> ; ! The null encoding does nothing diff --git a/core/io/encodings/utf8/utf8-docs.factor b/core/io/encodings/utf8/utf8-docs.factor index 6e1923824f..734a7f7236 100755 --- a/core/io/encodings/utf8/utf8-docs.factor +++ b/core/io/encodings/utf8/utf8-docs.factor @@ -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. You can pass this class symbol as an encoding descriptor to words like " { $link } " and " { $link encode-string } "." } ; 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." } ; diff --git a/core/io/encodings/utf8/utf8-tests.factor b/core/io/encodings/utf8/utf8-tests.factor index a6a32041be..0671fe2129 100644 --- a/core/io/encodings/utf8/utf8-tests.factor +++ b/core/io/encodings/utf8/utf8-tests.factor @@ -1,11 +1,11 @@ USING: io.encodings.utf8 tools.test sbufs kernel io io.encodings -sequences strings arrays unicode ; +sequences strings arrays unicode io.streams.byte-array ; : decode-utf8-w/stream ( array -- newarray ) - >sbuf dup reverse-here utf8 contents ; + utf8 contents >array ; : encode-utf8-w/stream ( array -- newarray ) - SBUF" " clone tuck utf8 stream-write >array ; + utf8 [ write ] with-byte-writer >array ; [ { CHAR: replacement-character } ] [ { BIN: 11110101 BIN: 10111111 BIN: 10000000 BIN: 11111111 } decode-utf8-w/stream >array ] unit-test diff --git a/core/io/files/files.factor b/core/io/files/files.factor index f41e04d72d..bff9d69129 100755 --- a/core/io/files/files.factor +++ b/core/io/files/files.factor @@ -17,13 +17,13 @@ HOOK: (file-writer) io-backend ( path -- stream ) HOOK: (file-appender) io-backend ( path -- stream ) : ( path encoding -- stream ) - swap (file-reader) swap ; + swap (file-reader) swap ; : ( path encoding -- stream ) - swap (file-writer) swap ; + swap (file-writer) swap ; : ( path encoding -- stream ) - swap (file-appender) swap ; + swap (file-appender) swap ; HOOK: delete-file io-backend ( path -- ) @@ -171,4 +171,4 @@ M: pathname <=> [ pathname-string ] compare ; [ dup make-directory ] when ; -: temp-file ( name -- path ) temp-directory swap path+ ; \ No newline at end of file +: temp-file ( name -- path ) temp-directory swap path+ ; diff --git a/core/io/io-tests.factor b/core/io/io-tests.factor index 394deb0e5c..74b6b5034f 100644 --- a/core/io/io-tests.factor +++ b/core/io/io-tests.factor @@ -1,5 +1,5 @@ USING: arrays io io.files kernel math parser strings system -tools.test words namespaces io.encodings.latin1 io.encodings.binary ; +tools.test words namespaces io.encodings.ascii io.encodings.binary ; IN: temporary [ f ] [ @@ -8,7 +8,7 @@ IN: temporary ] unit-test : ( resource -- stream ) - resource-path latin1 ; + resource-path ascii ; [ "This is a line.\rThis is another line.\r" diff --git a/core/io/streams/byte-array/byte-array.factor b/core/io/streams/byte-array/byte-array.factor index afbc94bf6a..d5ca8eac68 100644 --- a/core/io/streams/byte-array/byte-array.factor +++ b/core/io/streams/byte-array/byte-array.factor @@ -3,14 +3,14 @@ sequences io namespaces ; IN: io.streams.byte-array : ( encoding -- stream ) - 512 swap ; + 512 swap ; : with-byte-writer ( encoding quot -- byte-array ) >r r> [ stdio get ] compose with-stream* >byte-array ; inline : ( byte-array encoding -- stream ) - >r >byte-vector dup reverse-here r> ; + >r >byte-vector dup reverse-here r> ; : with-byte-reader ( byte-array encoding quot -- ) >r r> with-stream ; inline diff --git a/core/io/streams/string/string.factor b/core/io/streams/string/string.factor index e1c14e6ee3..15fc2b704e 100755 --- a/core/io/streams/string/string.factor +++ b/core/io/streams/string/string.factor @@ -50,7 +50,7 @@ M: growable stream-read-partial stream-read ; : ( str -- stream ) - >sbuf dup reverse-here null-encoding ; + >sbuf dup reverse-here null-encoding ; : with-string-reader ( str quot -- ) >r r> with-stream ; inline diff --git a/extra/io/encodings/utf16/utf16-tests.factor b/extra/io/encodings/utf16/utf16-tests.factor index 1677c2d38d..7ee5c9574e 100755 --- a/extra/io/encodings/utf16/utf16-tests.factor +++ b/extra/io/encodings/utf16/utf16-tests.factor @@ -1,11 +1,11 @@ -USING: kernel tools.test io.encodings.utf16 arrays sbufs sequences io.encodings -io unicode ; +USING: kernel tools.test io.encodings.utf16 arrays sbufs +sequences io.encodings io unicode io.streams.byte-array ; : decode-w/stream ( array encoding -- newarray ) - >r >sbuf dup reverse-here r> contents >array ; + contents >array ; : encode-w/stream ( array encoding -- newarray ) - >r SBUF" " clone tuck r> stream-write >array ; + [ write ] with-byte-writer >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 diff --git a/extra/io/launcher/launcher.factor b/extra/io/launcher/launcher.factor index 9236ec2ce9..b1990df654 100755 --- a/extra/io/launcher/launcher.factor +++ b/extra/io/launcher/launcher.factor @@ -127,7 +127,7 @@ TUPLE: process-stream process ; : ( desc encoding -- stream ) swap >descriptor - [ (process-stream) >r rot r> ] keep + [ (process-stream) >r rot r> ] keep +timeout+ swap at [ over set-timeout ] when* { set-delegate set-process-stream-process } process-stream construct ; diff --git a/extra/io/nonblocking/nonblocking.factor b/extra/io/nonblocking/nonblocking.factor index b8007192fe..b0ce1fcc12 100755 --- a/extra/io/nonblocking/nonblocking.factor +++ b/extra/io/nonblocking/nonblocking.factor @@ -45,7 +45,7 @@ GENERIC: close-handle ( handle -- ) output-port ; : ( read-handle write-handle -- input-port output-port ) - swap [ swap ] [ dispose ] cleanup ; + swap [ swap ] [ ] [ dispose drop ] cleanup ; : pending-error ( port -- ) dup port-error f rot set-port-error [ throw ] when* ; diff --git a/extra/io/sockets/sockets-docs.factor b/extra/io/sockets/sockets-docs.factor index 510d47ff2b..fa38ec90ee 100755 --- a/extra/io/sockets/sockets-docs.factor +++ b/extra/io/sockets/sockets-docs.factor @@ -100,12 +100,12 @@ HELP: } ; HELP: -{ $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: HELP: accept { $values { "server" "a handle" } { "client" "a bidirectional stream" } } -{ $description "Waits for a connection to a server socket created by " { $link } ", and outputs a bidirectional stream when the connection has been established." +{ $description "Waits for a connection to a server socket created by " { $link } ", 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: "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." } ; diff --git a/extra/io/sockets/sockets.factor b/extra/io/sockets/sockets.factor index 07e4f0afca..8de43bfd20 100755 --- a/extra/io/sockets/sockets.factor +++ b/extra/io/sockets/sockets.factor @@ -33,7 +33,7 @@ M: array client* [ (client) ] attempt-all ; M: object client* (client) ; : ( addrspec encoding -- stream ) - [ >r client* r> ] keep ; + [ >r client* r> ] keep ; HOOK: (server) io-backend ( addrspec -- handle ) @@ -43,7 +43,7 @@ HOOK: (server) io-backend ( addrspec -- handle ) HOOK: (accept) io-backend ( server -- stream-in stream-out ) : accept ( server -- client ) - [ (accept) ] keep server-port-encoding ; + [ (accept) ] keep server-port-encoding ; HOOK: io-backend ( addrspec -- datagram ) From 08a3d0ba12b44b136d56291bf6b07195daf8a03e Mon Sep 17 00:00:00 2001 From: Daniel Ehrenberg Date: Mon, 25 Feb 2008 13:54:35 -0600 Subject: [PATCH 14/38] Making things bootstrap, partial fix for client --- core/io/backend/backend.factor | 2 +- core/io/encodings/encodings-docs.factor | 13 +++++++++++++ core/io/io-tests.factor | 2 +- extra/io/server/server.factor | 2 +- extra/io/sockets/sockets.factor | 4 ++-- extra/io/unix/unix-tests.factor | 10 +++++----- 6 files changed, 23 insertions(+), 10 deletions(-) create mode 100644 core/io/encodings/encodings-docs.factor diff --git a/core/io/backend/backend.factor b/core/io/backend/backend.factor index 6f41814ce9..1595ecd576 100755 --- a/core/io/backend/backend.factor +++ b/core/io/backend/backend.factor @@ -24,7 +24,7 @@ HOOK: normalize-pathname io-backend ( str -- newstr ) M: object normalize-pathname ; : set-io-backend ( io-backend -- ) - io-backend set-global init-io init-stdio die ; + io-backend set-global init-io init-stdio ; [ init-io embedded? [ init-stdio ] unless ] "io.backend" add-init-hook diff --git a/core/io/encodings/encodings-docs.factor b/core/io/encodings/encodings-docs.factor new file mode 100644 index 0000000000..bb1a991903 --- /dev/null +++ b/core/io/encodings/encodings-docs.factor @@ -0,0 +1,13 @@ +USING: help.markup help.syntax ; +IN: io.encodings + +ARTICLE: "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." +"To make an encoded stream directly (something which is normally handled by the appropriate stream constructor), use the following words:" +{ $subsection } +{ $subsection } +{ $subsection } +"To encode or decode a string, use" +{ $subsection encode-string } +! { $subsection decode-string } +; diff --git a/core/io/io-tests.factor b/core/io/io-tests.factor index 74b6b5034f..2ac55a33fa 100644 --- a/core/io/io-tests.factor +++ b/core/io/io-tests.factor @@ -8,7 +8,7 @@ IN: temporary ] unit-test : ( resource -- stream ) - resource-path ascii ; + resource-path binary ; [ "This is a line.\rThis is another line.\r" diff --git a/extra/io/server/server.factor b/extra/io/server/server.factor index 6cc11ea6b6..2c1cac1467 100755 --- a/extra/io/server/server.factor +++ b/extra/io/server/server.factor @@ -30,7 +30,7 @@ LOG: accepted-connection NOTICE { log-service servers } "Client" spawn-vars ] 2keep accept-loop ; inline -: server-loop ( addrspec quot -- ) +: server-loop ( addrspec encoding quot -- ) >r dup servers get push r> [ accept-loop ] curry with-disposal ; inline diff --git a/extra/io/sockets/sockets.factor b/extra/io/sockets/sockets.factor index 8de43bfd20..c10d7e963c 100755 --- a/extra/io/sockets/sockets.factor +++ b/extra/io/sockets/sockets.factor @@ -29,11 +29,11 @@ TUPLE: client-stream addr ; HOOK: (client) io-backend ( addrspec -- client-in client-out ) GENERIC: client* ( addrspec -- client-in client-out ) -M: array client* [ (client) ] attempt-all ; +M: array client* [ (client) 2array ] attempt-all first2 ; M: object client* (client) ; : ( addrspec encoding -- stream ) - [ >r client* r> ] keep ; + over client* rot ; HOOK: (server) io-backend ( addrspec -- handle ) diff --git a/extra/io/unix/unix-tests.factor b/extra/io/unix/unix-tests.factor index 6e61786d9b..ede8e745c5 100755 --- a/extra/io/unix/unix-tests.factor +++ b/extra/io/unix/unix-tests.factor @@ -10,12 +10,12 @@ IN: temporary ] ignore-errors "unix-domain-socket-test" resource-path - [ - stdio get accept [ + ascii [ + accept [ "Hello world" print flush readln "XYZ" = "FOO" "BAR" ? print flush ] with-stream - ] with-stream + ] with-disposal "unix-domain-socket-test" resource-path delete-file ] "Test" spawn drop @@ -24,8 +24,8 @@ yield [ { "Hello world" "FOO" } ] [ [ - "unix-domain-socket-test" resource-path ascii - [ + "unix-domain-socket-test" resource-path + ascii [ readln , "XYZ" print flush readln , From 63e04a9b1767aabca8755cbdba24bda85d7514f7 Mon Sep 17 00:00:00 2001 From: Daniel Ehrenberg Date: Mon, 25 Feb 2008 14:24:44 -0600 Subject: [PATCH 15/38] Fixing Unix I/O tests --- extra/io/unix/unix-tests.factor | 17 +++++++++-------- 1 file changed, 9 insertions(+), 8 deletions(-) diff --git a/extra/io/unix/unix-tests.factor b/extra/io/unix/unix-tests.factor index ede8e745c5..7fa210d5da 100755 --- a/extra/io/unix/unix-tests.factor +++ b/extra/io/unix/unix-tests.factor @@ -6,10 +6,10 @@ IN: temporary ! Unix domain stream sockets [ [ - "unix-domain-socket-test" resource-path delete-file + "unix-domain-socket-test" temp-file delete-file ] ignore-errors - "unix-domain-socket-test" resource-path + "unix-domain-socket-test" temp-file ascii [ accept [ "Hello world" print flush @@ -17,14 +17,14 @@ IN: temporary ] with-stream ] with-disposal - "unix-domain-socket-test" resource-path delete-file + "unix-domain-socket-test" temp-file delete-file ] "Test" spawn drop yield [ { "Hello world" "FOO" } ] [ [ - "unix-domain-socket-test" resource-path + "unix-domain-socket-test" temp-file ascii [ readln , "XYZ" print flush @@ -35,7 +35,7 @@ yield ! Unix domain datagram sockets [ - "unix-domain-datagram-test" resource-path delete-file + "unix-domain-datagram-test" temp-file delete-file ] ignore-errors : server-addr "unix-domain-datagram-test" temp-file ; @@ -67,17 +67,18 @@ yield "Done" print - "unix-domain-datagram-test" resource-path delete-file + "unix-domain-datagram-test" temp-file delete-file ] with-scope ] "Test" spawn drop yield [ - "unix-domain-datagram-test-2" resource-path delete-file + "unix-domain-datagram-test-2" temp-file delete-file ] ignore-errors client-addr +"Four" print "d" set [ ] [ @@ -109,7 +110,7 @@ client-addr ! Test error behavior [ - "unix-domain-datagram-test-3" resource-path delete-file + "unix-domain-datagram-test-3" temp-file delete-file ] ignore-errors "unix-domain-datagram-test-2" temp-file delete-file From 278509336d39dd9e2d0e73df70fa15b4e36b1e8a Mon Sep 17 00:00:00 2001 From: Daniel Ehrenberg Date: Mon, 25 Feb 2008 15:10:14 -0600 Subject: [PATCH 16/38] Making with-server take encodings properly --- extra/benchmark/sockets/sockets.factor | 4 ++-- extra/concurrency/distributed/distributed.factor | 4 ++-- extra/http/server/server.factor | 4 ++-- extra/io/server/server.factor | 8 ++++---- extra/tty-server/tty-server.factor | 6 +++--- 5 files changed, 13 insertions(+), 13 deletions(-) diff --git a/extra/benchmark/sockets/sockets.factor b/extra/benchmark/sockets/sockets.factor index 6b1908afb1..b6b20630a1 100755 --- a/extra/benchmark/sockets/sockets.factor +++ b/extra/benchmark/sockets/sockets.factor @@ -1,9 +1,9 @@ -USING: io.sockets io.server io kernel math threads +USING: io.sockets io.server io kernel math threads io.encodings.ascii debugger tools.time prettyprint concurrency.combinators ; IN: benchmark.sockets : simple-server ( -- ) - 7777 local-server "benchmark.sockets" [ + 7777 local-server "benchmark.sockets" ascii [ read1 CHAR: x = [ stop-server ] [ diff --git a/extra/concurrency/distributed/distributed.factor b/extra/concurrency/distributed/distributed.factor index 2c54a872f7..029be9772c 100755 --- a/extra/concurrency/distributed/distributed.factor +++ b/extra/concurrency/distributed/distributed.factor @@ -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 -- ) diff --git a/extra/http/server/server.factor b/extra/http/server/server.factor index a2f5c3474b..bd0abc4f9b 100755 --- a/extra/http/server/server.factor +++ b/extra/http/server/server.factor @@ -2,7 +2,7 @@ ! See http://factorcode.org/license.txt for BSD license. USING: assocs kernel namespaces io io.timeouts strings splitting threads http http.server.responders sequences prettyprint -io.server logging calendar ; +io.server logging calendar io.encodings.latin1 ; IN: http.server @@ -49,7 +49,7 @@ IN: http.server \ parse-request NOTICE add-input-logging : httpd ( port -- ) - internet-server "http.server" [ + internet-server "http.server" latin1 [ 1 minutes stdio get set-timeout readln [ parse-request ] when* ] with-server ; diff --git a/extra/io/server/server.factor b/extra/io/server/server.factor index 2c1cac1467..c2fa9bafae 100755 --- a/extra/io/server/server.factor +++ b/extra/io/server/server.factor @@ -44,12 +44,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 ; diff --git a/extra/tty-server/tty-server.factor b/extra/tty-server/tty-server.factor index f71265e6f0..2936c39070 100644 --- a/extra/tty-server/tty-server.factor +++ b/extra/tty-server/tty-server.factor @@ -1,11 +1,11 @@ -USING: listener io.server ; +USING: listener io.server io.encodings.utf8 ; IN: tty-server : tty-server ( port -- ) local-server "tty-server" - [ listener ] with-server ; + utf8 [ listener ] with-server ; : default-tty-server 9999 tty-server ; -MAIN: default-tty-server \ No newline at end of file +MAIN: default-tty-server From 500e0fbc9bd82f3d52552ef2a3912183e49cd4dc Mon Sep 17 00:00:00 2001 From: Daniel Ehrenberg Date: Tue, 26 Feb 2008 01:20:27 -0600 Subject: [PATCH 17/38] Fixing send --- extra/concurrency/distributed/distributed.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extra/concurrency/distributed/distributed.factor b/extra/concurrency/distributed/distributed.factor index 029be9772c..f09c441d26 100755 --- a/extra/concurrency/distributed/distributed.factor +++ b/extra/concurrency/distributed/distributed.factor @@ -28,7 +28,7 @@ C: remote-process M: remote-process send ( message thread -- ) { remote-process-id remote-process-node } get-slots - io.sockets: [ 2array serialize ] with-stream ; + binary io.sockets: [ 2array serialize ] with-stream ; M: thread (serialize) ( obj -- ) thread-id local-node get-global From 52f04dcfa462d2d4930cd32294349c6d4d153ef4 Mon Sep 17 00:00:00 2001 From: Daniel Ehrenberg Date: Tue, 26 Feb 2008 01:24:40 -0600 Subject: [PATCH 18/38] Fix unit tests --- core/words/words-docs.factor | 4 ++-- extra/io/server/server-tests.factor | 2 +- extra/io/unix/unix-tests.factor | 2 +- 3 files changed, 4 insertions(+), 4 deletions(-) diff --git a/core/words/words-docs.factor b/core/words/words-docs.factor index f1cc678d17..4903f8933b 100755 --- a/core/words/words-docs.factor +++ b/core/words/words-docs.factor @@ -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 diff --git a/extra/io/server/server-tests.factor b/extra/io/server/server-tests.factor index 24b4c231d1..6c3c177513 100755 --- a/extra/io/server/server-tests.factor +++ b/extra/io/server/server-tests.factor @@ -1,4 +1,4 @@ IN: temporary USING: tools.test io.server io.server.private ; -{ 1 0 } [ [ ] server-loop ] must-infer-as +{ 2 0 } [ [ ] server-loop ] must-infer-as diff --git a/extra/io/unix/unix-tests.factor b/extra/io/unix/unix-tests.factor index 998168ddaa..ca5d0f29fd 100755 --- a/extra/io/unix/unix-tests.factor +++ b/extra/io/unix/unix-tests.factor @@ -134,7 +134,7 @@ datagram-client delete-file [ image binary [ - B{ 1 2 } server-addr + B{ 1 2 } datagram-server stdio get send ] with-file-reader ] must-fail From d0e0a12cb08cfbe87de087c3814e613fffcbf091 Mon Sep 17 00:00:00 2001 From: Daniel Ehrenberg Date: Tue, 26 Feb 2008 01:30:05 -0600 Subject: [PATCH 19/38] fixing SMTP for encodings (is ASCII appropriate?) --- extra/smtp/server/server.factor | 9 ++++----- 1 file changed, 4 insertions(+), 5 deletions(-) diff --git a/extra/smtp/server/server.factor b/extra/smtp/server/server.factor index c28ec7745a..92b605e91c 100755 --- a/extra/smtp/server/server.factor +++ b/extra/smtp/server/server.factor @@ -1,5 +1,8 @@ ! Copyright (C) 2007 Elie CHAFTARI ! See http://factorcode.org/license.txt for BSD license. +USING: combinators kernel prettyprint io io.timeouts io.server +sequences namespaces io.sockets continuations calendar io.encodings.ascii ; +IN: smtp.server ! Mock SMTP server for testing purposes. @@ -27,10 +30,6 @@ ! bye ! Connection closed by foreign host. -USING: combinators kernel prettyprint io io.timeouts io.server -sequences namespaces io.sockets continuations calendar ; -IN: smtp.server - SYMBOL: data-mode : process ( -- ) @@ -64,7 +63,7 @@ SYMBOL: data-mode : smtp-server ( port -- ) "Starting SMTP server on port " write dup . flush - "127.0.0.1" swap [ + "127.0.0.1" swap ascii [ accept [ 1 minutes stdio get set-timeout "220 hello\r\n" write flush From 51ccd3417e389bc0a69fb6cff2a63eca7634b065 Mon Sep 17 00:00:00 2001 From: Daniel Ehrenberg Date: Tue, 26 Feb 2008 09:59:40 -0600 Subject: [PATCH 20/38] Yes, ascii is appropriate --- extra/smtp/smtp.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extra/smtp/smtp.factor b/extra/smtp/smtp.factor index 99a708d2de..33ced2f1c2 100755 --- a/extra/smtp/smtp.factor +++ b/extra/smtp/smtp.factor @@ -20,7 +20,7 @@ SYMBOL: esmtp t esmtp set-global : with-smtp-connection ( quot -- ) smtp-host get smtp-port get 2dup log-smtp-connection - ascii [ ! ASCII until encodings reconsidered + ascii [ smtp-domain [ host-name or ] change read-timeout get stdio get set-timeout call From a7ee1d2642a39929f79a8d54d27fc1a36e66f85b Mon Sep 17 00:00:00 2001 From: Daniel Ehrenberg Date: Tue, 26 Feb 2008 19:32:33 -0600 Subject: [PATCH 21/38] Assuring that \r\n is included as blank in unicode.categories --- extra/unicode/categories/categories.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extra/unicode/categories/categories.factor b/extra/unicode/categories/categories.factor index e5f157463d..4ba96fb9c4 100644 --- a/extra/unicode/categories/categories.factor +++ b/extra/unicode/categories/categories.factor @@ -1,7 +1,7 @@ USING: unicode.syntax ; IN: unicode.categories -CATEGORY: blank Zs Zl Zp ; +CATEGORY: blank Zs Zl Zp \r\n ; CATEGORY: letter Ll ; CATEGORY: LETTER Lu ; CATEGORY: Letter Lu Ll Lt Lm Lo ; From 1764f8671be5c72be57ae6f9853858f54abdd868 Mon Sep 17 00:00:00 2001 From: Daniel Ehrenberg Date: Tue, 4 Mar 2008 17:44:08 -0600 Subject: [PATCH 22/38] Deleting duplication in files --- core/io/files/files.factor | 18 ------------------ 1 file changed, 18 deletions(-) diff --git a/core/io/files/files.factor b/core/io/files/files.factor index 16d1c64eab..785de80f36 100755 --- a/core/io/files/files.factor +++ b/core/io/files/files.factor @@ -6,10 +6,6 @@ system combinators splitting sbufs continuations io.encodings io.encodings.binary ; IN: io.files -HOOK: cd io-backend ( path -- ) - -HOOK: cwd io-backend ( -- path ) - HOOK: (file-reader) io-backend ( path -- stream ) HOOK: (file-writer) io-backend ( path -- stream ) @@ -25,14 +21,8 @@ HOOK: (file-appender) io-backend ( path -- stream ) : ( path encoding -- stream ) swap (file-appender) swap ; -HOOK: delete-file io-backend ( path -- ) - HOOK: rename-file io-backend ( from to -- ) -HOOK: make-directory io-backend ( path -- ) - -HOOK: delete-directory io-backend ( path -- ) - ! Pathnames : path-separator? ( ch -- ? ) windows? "/\\" "/" ? member? ; @@ -215,14 +205,6 @@ DEFER: copy-tree-to : resource-exists? ( path -- ? ) ?resource-path exists? ; -: temp-directory ( -- path ) - "temp" resource-path - dup exists? not - [ dup make-directory ] - when ; - -: temp-file ( name -- path ) temp-directory swap path+ ; - ! Pathname presentations TUPLE: pathname string ; From ffc3b8078cf1df36e265bde4147c20ecf410a821 Mon Sep 17 00:00:00 2001 From: Daniel Ehrenberg Date: Tue, 4 Mar 2008 17:52:32 -0600 Subject: [PATCH 23/38] Fixing unresolved conflict --- extra/benchmark/sockets/sockets.factor | 12 +----------- 1 file changed, 1 insertion(+), 11 deletions(-) diff --git a/extra/benchmark/sockets/sockets.factor b/extra/benchmark/sockets/sockets.factor index c10a123af3..6af2dadb9f 100755 --- a/extra/benchmark/sockets/sockets.factor +++ b/extra/benchmark/sockets/sockets.factor @@ -23,21 +23,11 @@ SYMBOL: counter ] curry "Client handler" spawn drop server-loop ; : simple-server ( -- ) -<<<<<<< HEAD:extra/benchmark/sockets/sockets.factor - 7777 local-server "benchmark.sockets" ascii [ - read1 CHAR: x = [ - stop-server - ] [ - 20 [ read1 write1 flush ] times - ] if - ] with-server ; -======= [ - server-addr dup "server" set [ + server-addr ascii dup "server" set [ server-loop ] with-disposal ] ignore-errors ; ->>>>>>> b80434b2e394480fa317348955b1f7b89e284bde:extra/benchmark/sockets/sockets.factor : simple-client ( -- ) server-addr [ From a9c6ea1ce32a59596519ec79727563751d47b047 Mon Sep 17 00:00:00 2001 From: Daniel Ehrenberg Date: Tue, 4 Mar 2008 18:04:51 -0600 Subject: [PATCH 24/38] Resolving conflict --- extra/io/unix/launcher/launcher.factor | 10 +--------- 1 file changed, 1 insertion(+), 9 deletions(-) diff --git a/extra/io/unix/launcher/launcher.factor b/extra/io/unix/launcher/launcher.factor index 63002887ab..e79ca43e33 100755 --- a/extra/io/unix/launcher/launcher.factor +++ b/extra/io/unix/launcher/launcher.factor @@ -1,18 +1,10 @@ ! Copyright (C) 2007, 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -<<<<<<< HEAD:extra/io/unix/launcher/launcher.factor -USING: io io.backend io.launcher io.unix.backend io.unix.files -io.nonblocking sequences kernel namespaces math system - alien.c-types debugger continuations arrays assocs -combinators unix.process parser-combinators memoize -promises strings threads unix io.encodings.latin1 ; -======= USING: io io.backend io.launcher io.nonblocking io.unix.backend io.unix.files io.nonblocking sequences kernel namespaces math system alien.c-types debugger continuations arrays assocs combinators unix.process strings threads unix -io.unix.launcher.parser ; ->>>>>>> b80434b2e394480fa317348955b1f7b89e284bde:extra/io/unix/launcher/launcher.factor +io.unix.launcher.parser io.encodings.latin1 ; IN: io.unix.launcher ! Search unix first From 578d6202233f6fab41c13b82748e8ae8048f4aba Mon Sep 17 00:00:00 2001 From: Daniel Ehrenberg Date: Tue, 4 Mar 2008 18:12:01 -0600 Subject: [PATCH 25/38] Fixing unit tests and listener merge --- core/io/files/files-tests.factor | 10 +++++----- core/listener/listener.factor | 2 +- extra/io/unix/launcher/launcher-tests.factor | 12 ++++++------ 3 files changed, 12 insertions(+), 12 deletions(-) diff --git a/core/io/files/files-tests.factor b/core/io/files/files-tests.factor index 79ada7e4c2..e7f7f4f777 100755 --- a/core/io/files/files-tests.factor +++ b/core/io/files/files-tests.factor @@ -70,7 +70,7 @@ USING: tools.test io.files io threads kernel continuations io.encodings.ascii ; [ ] [ "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 io.encodings.ascii ; [ ] [ "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 io.encodings.ascii ; ] 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 io.encodings.ascii ; ] 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 io.encodings.ascii ; ] unit-test [ "Foobar" ] [ - "d" temp-file file-contents + "d" temp-file ascii file-contents ] unit-test [ ] [ "d" temp-file delete-file ] unit-test diff --git a/core/listener/listener.factor b/core/listener/listener.factor index fce4886112..61d3f9836d 100755 --- a/core/listener/listener.factor +++ b/core/listener/listener.factor @@ -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 diff --git a/extra/io/unix/launcher/launcher-tests.factor b/extra/io/unix/launcher/launcher-tests.factor index fd2fb53cc5..c24d5c7c9e 100644 --- a/extra/io/unix/launcher/launcher-tests.factor +++ b/extra/io/unix/launcher/launcher-tests.factor @@ -1,6 +1,6 @@ IN: io.unix.launcher.tests USING: io.files tools.test io.launcher arrays io namespaces -continuations math ; +continuations math io.encodings.ascii ; [ ] [ [ "launcher-test-1" temp-file delete-file ] ignore-errors @@ -30,7 +30,7 @@ continuations math ; "cat" "launcher-test-1" temp-file 2array - contents + ascii contents ] unit-test [ "" ] [ @@ -39,7 +39,7 @@ continuations math ; "launcher-test-1" temp-file 2array +arguments+ set +inherit+ +stdout+ set - ] { } make-assoc contents + ] { } make-assoc ascii contents ] unit-test [ ] [ @@ -58,12 +58,12 @@ continuations math ; "cat" "launcher-test-1" temp-file 2array - contents + ascii contents ] unit-test [ ] [ 2 [ - "launcher-test-1" temp-file [ + "launcher-test-1" temp-file ascii [ [ +stdout+ set "echo Hello" +command+ set @@ -76,5 +76,5 @@ continuations math ; "cat" "launcher-test-1" temp-file 2array - contents + ascii contents ] unit-test From 30eba0077435c84261c2099ecf9999febf9a188e Mon Sep 17 00:00:00 2001 From: Daniel Ehrenberg Date: Tue, 4 Mar 2008 21:05:58 -0600 Subject: [PATCH 26/38] Bug fixes; docs --- core/io/encodings/encodings-docs.factor | 43 +++++++-- core/io/encodings/encodings.factor | 6 +- extra/io/unix/files/files.factor | 9 +- extra/logging/server/server.factor | 113 +----------------------- 4 files changed, 48 insertions(+), 123 deletions(-) diff --git a/core/io/encodings/encodings-docs.factor b/core/io/encodings/encodings-docs.factor index bb1a991903..d1f6aef364 100644 --- a/core/io/encodings/encodings-docs.factor +++ b/core/io/encodings/encodings-docs.factor @@ -1,13 +1,44 @@ USING: help.markup help.syntax ; IN: io.encodings +ABOUT: "encodings" + ARTICLE: "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." -"To make an encoded stream directly (something which is normally handled by the appropriate stream constructor), use the following words:" +{ $subsection "encodings-constructors" } +{ $subsection "encodings-descriptors" } +{ $subsection "encodings-string" } +{ $subsection "encodings-protocol" } ; + +ARTICLE: "encodings-constructors" "Constructing an encoded stream" { $subsection } { $subsection } -{ $subsection } -"To encode or decode a string, use" -{ $subsection encode-string } -! { $subsection decode-string } -; +{ $subsection } ; + +HELP: ( 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: ( 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: ( 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" } "." } ; + +{ } 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 include:" +{ $vocab-link "io.encodings.utf8" } +{ $vocab-link "io.encodings.ascii" } +{ $vocab-link "io.encodings.binary" } +{ $vocab-link "io.encodings.utf16" } ; diff --git a/core/io/encodings/encodings.factor b/core/io/encodings/encodings.factor index 79079929bb..bc4f21e8e2 100755 --- a/core/io/encodings/encodings.factor +++ b/core/io/encodings/encodings.factor @@ -54,7 +54,7 @@ GENERIC: decode-step ( buf byte ch state encoding -- buf ch state ) decode-read-loop ; TUPLE: decoded code cr ; -: ( stream decoding-class -- decoded-stream ) +: ( stream encoding -- newstream ) dup binary eq? [ drop ] [ construct-empty { set-delegate set-decoded-code } decoded construct @@ -126,7 +126,7 @@ TUPLE: encode-error ; : encode-error ( -- * ) \ encode-error construct-empty throw ; TUPLE: encoded code ; -: ( stream encoding-class -- encoded-stream ) +: ( stream encoding -- newstream ) dup binary eq? [ drop ] [ construct-empty { set-delegate set-encoded-code } encoded construct @@ -153,7 +153,7 @@ INSTANCE: encoded plain-writer : redecode ( stream encoding -- newstream ) over decoded? [ >r delegate r> ] when ; -: ( stream-in stream-out encoding -- duplex-stream ) +: ( stream-in stream-out encoding -- duplex ) tuck reencode >r redecode r> ; ! The null encoding does nothing diff --git a/extra/io/unix/files/files.factor b/extra/io/unix/files/files.factor index 7946704e55..f6b0fe7ce6 100755 --- a/extra/io/unix/files/files.factor +++ b/extra/io/unix/files/files.factor @@ -1,8 +1,9 @@ ! Copyright (C) 2005, 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: io.backend io.nonblocking io.unix.backend io.files io - unix unix.stat unix.time kernel math continuations math.bitfields - byte-arrays alien combinators combinators.cleave calendar ; +unix unix.stat unix.time kernel math continuations math.bitfields +byte-arrays alien combinators combinators.cleave calendar +io.encodings.binary ; IN: io.unix.files @@ -60,8 +61,8 @@ M: unix-io delete-directory ( path -- ) : (copy-file) ( from to -- ) dup parent-directory make-directories - [ - swap [ + binary [ + swap binary [ swap stream-copy ] with-disposal ] with-disposal ; diff --git a/extra/logging/server/server.factor b/extra/logging/server/server.factor index b7e8d208e4..d181ab8a16 100755 --- a/extra/logging/server/server.factor +++ b/extra/logging/server/server.factor @@ -1,116 +1,10 @@ -<<<<<<< HEAD:extra/logging/server/server.factor -! Copyright (C) 2008 Slava Pestov. -! See http://factorcode.org/license.txt for BSD license. -USING: namespaces kernel io calendar sequences io.files -io.sockets continuations prettyprint assocs math.parser -words debugger math combinators concurrency.messaging -threads arrays init math.ranges strings io.encodings.utf8 ; -IN: logging.server - -: log-root ( -- string ) - \ log-root get "logs" resource-path or ; - -: log-path ( service -- path ) - log-root swap path+ ; - -: log# ( path n -- path' ) - number>string ".log" append path+ ; - -SYMBOL: log-files - -: open-log-stream ( service -- stream ) - log-path - dup make-directories - 1 log# utf8 ; - -: log-stream ( service -- stream ) - log-files get [ open-log-stream ] cache ; - -: multiline-header 20 CHAR: - ; foldable - -: (write-message) ( msg word-name level multi? -- ) - [ - "[" write multiline-header write "] " write - ] [ - "[" write now (timestamp>rfc3339) "] " write - ] if - write bl write ": " write print ; - -: write-message ( msg word-name level -- ) - rot [ empty? not ] subset { - { [ dup empty? ] [ 3drop ] } - { [ dup length 1 = ] [ first -rot f (write-message) ] } - { [ t ] [ - [ first -rot f (write-message) ] 3keep - 1 tail -rot [ t (write-message) ] 2curry each - ] } - } cond ; - -: (log-message) ( msg -- ) - #! msg: { msg word-name level service } - first4 log-stream [ write-message flush ] with-stream* ; - -: try-dispose ( stream -- ) - [ dispose ] curry [ error. ] recover ; - -: close-log ( service -- ) - log-files get delete-at* - [ try-dispose ] [ drop ] if ; - -: (close-logs) ( -- ) - log-files get - dup values [ try-dispose ] each - clear-assoc ; - -: keep-logs 10 ; - -: ?delete-file ( path -- ) - dup exists? [ delete-file ] [ drop ] if ; - -: delete-oldest keep-logs log# ?delete-file ; - -: ?rename-file ( old new -- ) - over exists? [ rename-file ] [ 2drop ] if ; - -: advance-log ( path n -- ) - [ 1- log# ] 2keep log# ?rename-file ; - -: rotate-log ( service -- ) - dup close-log - log-path - dup delete-oldest - keep-logs 1 [a,b] [ advance-log ] with each ; - -: (rotate-logs) ( -- ) - (close-logs) - log-root directory [ drop rotate-log ] assoc-each ; - -: log-server-loop ( -- ) - receive unclip { - { "log-message" [ (log-message) ] } - { "rotate-logs" [ drop (rotate-logs) ] } - { "close-logs" [ drop (close-logs) ] } - } case log-server-loop ; - -: log-server ( -- ) - [ [ log-server-loop ] [ error. (close-logs) ] recover t ] - "Log server" spawn-server - "log-server" set-global ; - -[ - H{ } clone log-files set-global - log-server -] "logging" add-init-hook - -USE: multiline -! Need to resolve this merge conflict -<" ! Copyright (C) 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: namespaces kernel io calendar sequences io.files io.sockets continuations prettyprint assocs math.parser words debugger math combinators concurrency.messaging -threads arrays init math.ranges strings calendar.format ; +threads arrays init math.ranges strings calendar.format +io.encodings.ascii ; IN: logging.server : log-root ( -- string ) @@ -127,7 +21,7 @@ SYMBOL: log-files : open-log-stream ( service -- stream ) log-path dup make-directories - 1 log# ; + 1 log# ascii ; : log-stream ( service -- stream ) log-files get [ open-log-stream ] cache ; @@ -207,4 +101,3 @@ SYMBOL: log-files H{ } clone log-files set-global log-server ] "logging" add-init-hook -"> drop From 84052ac5f328321d3b3e9d028441f928796f709a Mon Sep 17 00:00:00 2001 From: Daniel Ehrenberg Date: Tue, 4 Mar 2008 21:13:14 -0600 Subject: [PATCH 27/38] Update to encodings docs --- core/io/encodings/encodings-docs.factor | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/core/io/encodings/encodings-docs.factor b/core/io/encodings/encodings-docs.factor index d1f6aef364..132da2bb70 100644 --- a/core/io/encodings/encodings-docs.factor +++ b/core/io/encodings/encodings-docs.factor @@ -42,3 +42,12 @@ ARTICLE: "encodings-descriptors" "Encoding descriptors" { $vocab-link "io.encodings.ascii" } { $vocab-link "io.encodings.binary" } { $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 encode-string } ; + +ARTICLE: "encodings-string" "Encoding and decoding strings" +"Strings can be encoded and decoded with the following words:" +{ $subsection encode-string } ; From 93c4ac23a859347bb88f302e650c378d0588c76e Mon Sep 17 00:00:00 2001 From: Daniel Ehrenberg Date: Wed, 5 Mar 2008 14:51:01 -0600 Subject: [PATCH 28/38] Encodings updates; /* */ comments in multline --- core/io/encodings/encodings-docs.factor | 32 +++++- .../encodings-tests.factor} | 8 +- core/io/encodings/encodings.factor | 105 ++++++++---------- core/io/encodings/utf8/utf8-docs.factor | 2 +- core/io/encodings/utf8/utf8.factor | 20 ++-- core/io/io-docs.factor | 2 +- .../streams/byte-array/byte-array-docs.factor | 33 ++++++ core/io/streams/string/string-docs.factor | 2 +- core/io/streams/string/string.factor | 2 +- extra/help/handbook/handbook.factor | 5 +- extra/io/encodings/ascii/ascii.factor | 2 +- extra/io/encodings/latin1/latin1.factor | 4 +- extra/io/encodings/utf16/utf16-docs.factor | 51 +++------ extra/io/encodings/utf16/utf16.factor | 72 ++++++------ extra/multiline/multiline.factor | 2 + 15 files changed, 188 insertions(+), 154 deletions(-) rename core/io/{streams/lines/lines-tests.factor => encodings/encodings-tests.factor} (86%) create mode 100644 core/io/streams/byte-array/byte-array-docs.factor diff --git a/core/io/encodings/encodings-docs.factor b/core/io/encodings/encodings-docs.factor index 132da2bb70..6dfd94a2b9 100644 --- a/core/io/encodings/encodings-docs.factor +++ b/core/io/encodings/encodings-docs.factor @@ -3,7 +3,7 @@ IN: io.encodings ABOUT: "encodings" -ARTICLE: "encodings" "I/O 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" } @@ -37,17 +37,37 @@ HELP: ( stream-in stream-out encoding -- 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 include:" -{ $vocab-link "io.encodings.utf8" } -{ $vocab-link "io.encodings.ascii" } -{ $vocab-link "io.encodings.binary" } -{ $vocab-link "io.encodings.utf16" } ; +"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 encode-string } ; ARTICLE: "encodings-string" "Encoding and decoding strings" "Strings can be encoded and decoded with the following words:" { $subsection encode-string } ; + +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." } ; + +HELP: encode-string ( string encoding -- byte-array ) +{ $values { "string" "a string" } + { "encoding" "an encoding descriptor" } + { "byte-array" "an encoded byte-array" } } +{ $description "Encodes the string with the given encoding descriptor, outputting the result to a byte-array." } ; + +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." } ; + +{ init-decoder decode-step encode-string } related-words diff --git a/core/io/streams/lines/lines-tests.factor b/core/io/encodings/encodings-tests.factor similarity index 86% rename from core/io/streams/lines/lines-tests.factor rename to core/io/encodings/encodings-tests.factor index e8ecc65526..73d2efa7d4 100755 --- a/core/io/streams/lines/lines-tests.factor +++ b/core/io/encodings/encodings-tests.factor @@ -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 -- stream ) - resource-path ; + resource-path ascii ; [ { } ] [ "/core/io/test/empty-file.txt" lines ] diff --git a/core/io/encodings/encodings.factor b/core/io/encodings/encodings.factor index bc4f21e8e2..8489c46d2e 100755 --- a/core/io/encodings/encodings.factor +++ b/core/io/encodings/encodings.factor @@ -3,9 +3,22 @@ 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 ; +io.streams.duplex byte-arrays ; IN: io.encodings +! The encoding descriptor protocol + +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: encode-string ( string encoding -- byte-array ) +M: tuple-class encode-string construct-empty encode-string ; +M: object encode-string drop >byte-array ; + ! Decoding TUPLE: decode-error ; @@ -21,19 +34,6 @@ SYMBOL: begin ! This is the replacement character HEX: fffd push-decoded ; -: finish-decoding ( buf ch state -- str ) - begin eq? [ decode-error ] unless drop "" like ; - -: start-decoding ( seq length -- buf ch state seq ) - 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 - : space ( resizable -- room-left ) dup underlying swap [ length ] 2apply - ; @@ -42,34 +42,34 @@ 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 >fixnum start-decoding r> - decode-read-loop ; + rot -rot decode-read-loop ; -TUPLE: decoded code cr ; +TUPLE: decoder code cr ; : ( stream encoding -- newstream ) dup binary eq? [ drop ] [ - construct-empty { set-delegate set-decoded-code } - decoded construct + dupd init-decoder { set-delegate set-decoder-code } + decoder construct ] if ; -: cr+ t swap set-decoded-cr ; inline +: cr+ t swap set-decoder-cr ; inline -: cr- f swap set-decoded-cr ; inline +: cr- f swap set-decoder-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 decoded-cr over empty? and + over decoder-cr over empty? and [ drop dup cr- stream-readln ] [ swap cr- ] if ; inline : handle-readln ( stream str ch -- str ) @@ -80,43 +80,43 @@ TUPLE: decoded code cr ; } case ; : fix-read ( stream string -- string ) - over decoded-cr [ + over decoder-cr [ over cr- "\n" ?head [ swap stream-read1 [ add ] when* ] [ nip ] if ] [ nip ] if ; -M: decoded stream-read - tuck { delegate decoded-code } get-slots decode-read fix-read ; +M: decoder stream-read + tuck { delegate decoder-code } get-slots decode-read fix-read ; -M: decoded stream-read-partial stream-read ; +M: decoder stream-read-partial stream-read ; -: decoded-read-until ( stream delim -- ch ) +: decoder-read-until ( stream delim -- ch ) ! Copied from { c-reader stream-read-until }!!! over stream-read1 dup [ - dup pick memq? [ 2nip ] [ , decoded-read-until ] if + dup pick memq? [ 2nip ] [ , decoder-read-until ] if ] [ 2nip ] if ; -M: decoded stream-read-until +M: decoder stream-read-until ! Copied from { c-reader stream-read-until }!!! - [ swap decoded-read-until ] "" make + [ swap decoder-read-until ] "" make swap over empty? over not and [ 2drop f f ] when ; : fix-read1 ( stream char -- char ) - over decoded-cr [ + over decoder-cr [ over cr- dup CHAR: \n = [ drop stream-read1 ] [ nip ] if ] [ nip ] if ; -M: decoded stream-read1 +M: decoder stream-read1 1 swap stream-read f like [ first ] [ f ] if* ; -M: decoded stream-readln ( stream -- str ) +M: decoder stream-readln ( stream -- str ) "\r\n" over stream-read-until handle-readln ; ! Encoding @@ -125,41 +125,30 @@ TUPLE: encode-error ; : encode-error ( -- * ) \ encode-error construct-empty throw ; -TUPLE: encoded code ; +TUPLE: encoder code ; : ( stream encoding -- newstream ) dup binary eq? [ drop ] [ - construct-empty { set-delegate set-encoded-code } - encoded construct + construct-empty { set-delegate set-encoder-code } + encoder construct ] if ; -GENERIC: encode-string ( string encoding -- byte-array ) -M: tuple-class encode-string construct-empty encode-string ; - -M: encoded stream-write1 +M: encoder stream-write1 >r 1string r> stream-write ; -M: encoded stream-write - [ encoded-code encode-string ] keep delegate stream-write ; +M: encoder stream-write + [ encoder-code encode-string ] keep delegate stream-write ; -M: encoded dispose delegate dispose ; +M: encoder dispose delegate dispose ; -INSTANCE: encoded plain-writer +INSTANCE: encoder plain-writer ! Rebinding duplex streams which have not read anything yet : reencode ( stream encoding -- newstream ) - over encoded? [ >r delegate r> ] when ; + over encoder? [ >r delegate r> ] when ; : redecode ( stream encoding -- newstream ) - over decoded? [ >r delegate r> ] when ; + over decoder? [ >r delegate r> ] when ; : ( stream-in stream-out encoding -- duplex ) tuck reencode >r redecode r> ; - -! The null encoding does nothing -! (used to wrap things as line-reader/plain-writer) -! Later this will be replaced by inheritance - -TUPLE: null-encoding ; -M: null-encoding encode-string drop ; -M: null-encoding decode-step 3drop over push f f ; diff --git a/core/io/encodings/utf8/utf8-docs.factor b/core/io/encodings/utf8/utf8-docs.factor index 734a7f7236..3e901ec83b 100755 --- a/core/io/encodings/utf8/utf8-docs.factor +++ b/core/io/encodings/utf8/utf8-docs.factor @@ -6,6 +6,6 @@ ARTICLE: "io.encodings.utf8" "Working with UTF8-encoded data" { $subsection utf8 } ; HELP: utf8 -{ $class-description "This is the class of encoding tuples which denote a UTF-8 encoding. You can pass this class symbol as an encoding descriptor to words like " { $link } " and " { $link encode-string } "." } ; +{ $class-description "This is the class of encoding tuples which denote a UTF-8 encoding. You can pass this class symbol as an encoding descriptor to words like " { $link } " and " { $link encode-string } ". This conforms to the " { $link "encodings-protocol" } "." } ; ABOUT: "io.encodings.utf8" diff --git a/core/io/encodings/utf8/utf8.factor b/core/io/encodings/utf8/utf8.factor index 2e7585b8a9..edc4663214 100644 --- a/core/io/encodings/utf8/utf8.factor +++ b/core/io/encodings/utf8/utf8.factor @@ -6,6 +6,8 @@ IN: io.encodings.utf8 ! Decoding UTF-8 +TUPLE: utf8 ch state ; + SYMBOL: double SYMBOL: triple SYMBOL: triple2 @@ -44,8 +46,16 @@ 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 @@ -75,10 +85,4 @@ SYMBOL: quad3 : encode-utf8 ( str -- seq ) [ [ char>utf8 ] each ] B{ } make ; -! Interface for streams - -TUPLE: utf8 ; - 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 diff --git a/core/io/io-docs.factor b/core/io/io-docs.factor index 0986196e8d..fd40950e62 100755 --- a/core/io/io-docs.factor +++ b/core/io/io-docs.factor @@ -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" diff --git a/core/io/streams/byte-array/byte-array-docs.factor b/core/io/streams/byte-array/byte-array-docs.factor new file mode 100644 index 0000000000..8e0b97e06b --- /dev/null +++ b/core/io/streams/byte-array/byte-array-docs.factor @@ -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 } +{ $subsection } +"Utility combinators:" +{ $subsection with-byte-reader } +{ $subsection with-byte-writer } ; + +HELP: +{ $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: +{ $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." } ; diff --git a/core/io/streams/string/string-docs.factor b/core/io/streams/string/string-docs.factor index e948d2162a..91ac244608 100644 --- a/core/io/streams/string/string-docs.factor +++ b/core/io/streams/string/string-docs.factor @@ -26,4 +26,4 @@ HELP: 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." } ; diff --git a/core/io/streams/string/string.factor b/core/io/streams/string/string.factor index 15fc2b704e..7833e0aa47 100755 --- a/core/io/streams/string/string.factor +++ b/core/io/streams/string/string.factor @@ -50,7 +50,7 @@ M: growable stream-read-partial stream-read ; : ( str -- stream ) - >sbuf dup reverse-here null-encoding ; + >sbuf dup reverse-here f ; : with-string-reader ( str quot -- ) >r r> with-stream ; inline diff --git a/extra/help/handbook/handbook.factor b/extra/help/handbook/handbook.factor index 178b7a5d35..a078db8762 100755 --- a/extra/help/handbook/handbook.factor +++ b/extra/help/handbook/handbook.factor @@ -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 ; 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" } @@ -187,6 +187,7 @@ ARTICLE: "io" "Input and output" { $subsection "io.mmap" } { $subsection "io.monitors" } { $heading "Other features" } +{ $subsection "io.encodings" } { $subsection "network-streams" } { $subsection "io.launcher" } { $subsection "io.timeouts" } ; diff --git a/extra/io/encodings/ascii/ascii.factor b/extra/io/encodings/ascii/ascii.factor index 0878a7a624..6dd8d23155 100644 --- a/extra/io/encodings/ascii/ascii.factor +++ b/extra/io/encodings/ascii/ascii.factor @@ -12,4 +12,4 @@ M: ascii encode-string drop 127 encode-check<= ; M: ascii decode-step - 3drop dup 127 >= [ encode-error ] when over push f f ; + drop dup 128 >= [ encode-error ] [ swap push ] if ; diff --git a/extra/io/encodings/latin1/latin1.factor b/extra/io/encodings/latin1/latin1.factor index b914589dc9..36e38caa1c 100755 --- a/extra/io/encodings/latin1/latin1.factor +++ b/extra/io/encodings/latin1/latin1.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2008 Daniel Ehrenberg. ! See http://factorcode.org/license.txt for BSD license. -USING: io io.encodings strings kernel io.encodings.ascii sequences ; +USING: io io.encodings strings kernel io.encodings.ascii sequences math ; IN: io.encodings.latin1 TUPLE: latin1 ; @@ -9,4 +9,4 @@ M: latin1 encode-string drop 255 encode-check<= ; M: latin1 decode-step - 3drop over push f f ; + drop dup 256 >= [ encode-error ] [ swap push ] if ; diff --git a/extra/io/encodings/utf16/utf16-docs.factor b/extra/io/encodings/utf16/utf16-docs.factor index c49c030ef3..018a15a534 100644 --- a/extra/io/encodings/utf16/utf16-docs.factor +++ b/extra/io/encodings/utf16/utf16-docs.factor @@ -1,45 +1,22 @@ 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 } ; +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: "io.utf16" +ABOUT: "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: 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: 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: 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: 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." } ; +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." } ; -{ 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 +{ utf16 utf16le utf16be } related-words diff --git a/extra/io/encodings/utf16/utf16.factor b/extra/io/encodings/utf16/utf16.factor index 3e10dcba35..8815d588ad 100755 --- a/extra/io/encodings/utf16/utf16.factor +++ b/extra/io/encodings/utf16/utf16.factor @@ -4,6 +4,10 @@ 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 @@ -40,8 +44,20 @@ SYMBOL: ignore { 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 = [ @@ -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 @@ -97,6 +123,11 @@ SYMBOL: ignore : encode-utf16le ( str -- seq ) [ [ char>utf16le ] each ] B{ } make ; +M: utf16le encode-string drop encode-utf16le ; +M: utf16be encode-string drop encode-utf16be ; + +! UTF-16 + : bom-le B{ HEX: ff HEX: fe } ; inline : bom-be B{ HEX: fe HEX: ff } ; inline @@ -108,40 +139,17 @@ SYMBOL: ignore : start-utf16be? ( seq1 -- seq2 ? ) bom-be ?head ; -: decode-utf16 ( seq -- str ) - { - { [ start-utf16le? ] [ decode-utf16le ] } - { [ start-utf16be? ] [ decode-utf16be ] } - { [ t ] [ decode-error ] } - } cond ; - -TUPLE: utf16le ; - -M: utf16le encode-string drop encode-utf16le ; -M: utf16le decode-step drop decode-utf16le-step ; - -TUPLE: utf16be ; - -M: utf16be encode-string drop encode-utf16be ; -M: utf16be decode-step drop decode-utf16be-step ; - -TUPLE: utf16 encoding ; +TUPLE: utf16 started? ; M: utf16 encode-string >r encode-utf16le r> - dup utf16-encoding [ drop ] - [ t swap set-utf16-encoding bom-le swap append ] if ; + dup utf16-started? [ drop ] + [ t swap set-utf16-started? bom-le swap append ] if ; : 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 ; diff --git a/extra/multiline/multiline.factor b/extra/multiline/multiline.factor index d32c11dd06..5baa205d15 100755 --- a/extra/multiline/multiline.factor +++ b/extra/multiline/multiline.factor @@ -38,3 +38,5 @@ IN: multiline : <" "\">" parse-multiline-string parsed ; parsing + +: /* "*/" parse-multiline-string drop ; parsing From e06885550e277d783a3291517d22c89158e92cf8 Mon Sep 17 00:00:00 2001 From: Daniel Ehrenberg Date: Wed, 5 Mar 2008 17:41:25 -0600 Subject: [PATCH 29/38] Replacing encode/decode-utf8 with utf8 encode/decode-string --- core/io/encodings/string/string.factor | 5 +++++ extra/http/http.factor | 10 +++++----- extra/ui/x11/x11.factor | 6 +++--- extra/x11/clipboard/clipboard.factor | 5 +++-- 4 files changed, 16 insertions(+), 10 deletions(-) create mode 100644 core/io/encodings/string/string.factor diff --git a/core/io/encodings/string/string.factor b/core/io/encodings/string/string.factor new file mode 100644 index 0000000000..acfe2edd89 --- /dev/null +++ b/core/io/encodings/string/string.factor @@ -0,0 +1,5 @@ +USING: io.encodings io io.streams.byte-array ; +IN: io.encodings.string + +: decode-string ( byte-array encoding -- string ) + contents ; diff --git a/extra/http/http.factor b/extra/http/http.factor index 35fe3ce544..7ed921480c 100755 --- a/extra/http/http.factor +++ b/extra/http/http.factor @@ -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 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-string [ 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-string ; : crlf "\r\n" write ; diff --git a/extra/ui/x11/x11.factor b/extra/ui/x11/x11.factor index 1fec668717..ae56c6a43f 100755 --- a/extra/ui/x11/x11.factor +++ b/extra/ui/x11/x11.factor @@ -3,7 +3,7 @@ USING: alien alien.c-types arrays ui ui.gadgets ui.gestures ui.backend ui.clipboards ui.gadgets.worlds assocs kernel math namespaces opengl sequences strings x11.xlib x11.events x11.xim -x11.glx x11.clipboard x11.constants x11.windows +x11.glx x11.clipboard x11.constants x11.windows io.encodings io.encodings.utf8 combinators debugger system command-line ui.render math.vectors tuples opengl.gl threads ; IN: ui.x11 @@ -137,7 +137,7 @@ M: world selection-notify-event : encode-clipboard ( string type -- bytes ) XSelectionRequestEvent-target XA_UTF8_STRING = - [ encode-utf8 ] [ string>char-alien ] if ; + [ utf8 encode-string ] [ string>char-alien ] if ; : set-selection-prop ( evt -- ) dpy get swap @@ -212,7 +212,7 @@ M: x-clipboard paste-clipboard : set-title-new ( dpy window string -- ) >r XA_NET_WM_NAME XA_UTF8_STRING 8 PropModeReplace - r> encode-utf8 dup length XChangeProperty drop ; + r> utf8 encode-string dup length XChangeProperty drop ; M: x11-ui-backend set-title ( string world -- ) world-handle x11-handle-window swap dpy get -rot diff --git a/extra/x11/clipboard/clipboard.factor b/extra/x11/clipboard/clipboard.factor index eb4191ebb1..b839e262d9 100755 --- a/extra/x11/clipboard/clipboard.factor +++ b/extra/x11/clipboard/clipboard.factor @@ -1,7 +1,8 @@ ! Copyright (C) 2006, 2007 Slava Pestov ! See http://factorcode.org/license.txt for BSD license. USING: alien alien.c-types alien.syntax arrays kernel math -namespaces sequences io.encodings.utf8 x11.xlib x11.constants ; +namespaces sequences io.encodings.string io.encodings.utf8 x11.xlib +x11.constants ; IN: x11.clipboard ! This code was based on by McCLIM's Backends/CLX/port.lisp @@ -35,7 +36,7 @@ TUPLE: x-clipboard atom contents ; >r XSelectionEvent-property zero? [ r> drop f ] [ - r> selection-property 1 window-property decode-utf8 + r> selection-property 1 window-property utf8 decode-string ] if ; : own-selection ( prop win -- ) From 1abb7c643e6665940872503b4a0fc4c8e4fc7aab Mon Sep 17 00:00:00 2001 From: Daniel Ehrenberg Date: Wed, 5 Mar 2008 17:49:02 -0600 Subject: [PATCH 30/38] Tests for decode-string --- core/io/encodings/string/string-tests.factor | 5 +++++ extra/benchmark/sockets/sockets.factor | 2 +- 2 files changed, 6 insertions(+), 1 deletion(-) create mode 100644 core/io/encodings/string/string-tests.factor diff --git a/core/io/encodings/string/string-tests.factor b/core/io/encodings/string/string-tests.factor new file mode 100644 index 0000000000..50d246183b --- /dev/null +++ b/core/io/encodings/string/string-tests.factor @@ -0,0 +1,5 @@ +USING: io.encodings.utf8 io.encodings.utf16 io.encodings.string tools.test ; +IN: io.encodings.string.tests + +[ "hello" ] [ "hello" utf8 decode-string ] unit-test +[ "he" ] [ "\0h\0e" utf16be decode-string ] unit-test diff --git a/extra/benchmark/sockets/sockets.factor b/extra/benchmark/sockets/sockets.factor index 30d069b9e0..25212c7264 100755 --- a/extra/benchmark/sockets/sockets.factor +++ b/extra/benchmark/sockets/sockets.factor @@ -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 From 946d3e741499653ca6f0d41550198a8cf1575063 Mon Sep 17 00:00:00 2001 From: Daniel Ehrenberg Date: Wed, 5 Mar 2008 19:12:40 -0600 Subject: [PATCH 31/38] changes in io.encodings.string --- core/io/encodings/encodings-docs.factor | 5 ----- core/io/encodings/string/authors.txt | 1 + core/io/encodings/string/string-docs.factor | 16 ++++++++++++++++ core/io/encodings/string/string-tests.factor | 10 +++++++--- core/io/encodings/string/string.factor | 7 +++++-- core/io/encodings/string/summary.txt | 1 + core/io/encodings/string/tags.factor | 1 + extra/help/handbook/handbook.factor | 6 ++++-- extra/http/http.factor | 6 +++--- extra/ui/x11/x11.factor | 6 +++--- extra/x11/clipboard/clipboard.factor | 2 +- 11 files changed, 42 insertions(+), 19 deletions(-) create mode 100644 core/io/encodings/string/authors.txt create mode 100644 core/io/encodings/string/string-docs.factor create mode 100644 core/io/encodings/string/summary.txt create mode 100644 core/io/encodings/string/tags.factor diff --git a/core/io/encodings/encodings-docs.factor b/core/io/encodings/encodings-docs.factor index 6dfd94a2b9..562e7dcd9a 100644 --- a/core/io/encodings/encodings-docs.factor +++ b/core/io/encodings/encodings-docs.factor @@ -7,7 +7,6 @@ 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-string" } { $subsection "encodings-protocol" } ; ARTICLE: "encodings-constructors" "Constructing an encoded stream" @@ -49,10 +48,6 @@ ARTICLE: "encodings-protocol" "Encoding protocol" { $subsection init-decoder } { $subsection encode-string } ; -ARTICLE: "encodings-string" "Encoding and decoding strings" -"Strings can be encoded and decoded with the following words:" -{ $subsection encode-string } ; - 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" } diff --git a/core/io/encodings/string/authors.txt b/core/io/encodings/string/authors.txt new file mode 100644 index 0000000000..f990dd0ed2 --- /dev/null +++ b/core/io/encodings/string/authors.txt @@ -0,0 +1 @@ +Daniel Ehrenberg diff --git a/core/io/encodings/string/string-docs.factor b/core/io/encodings/string/string-docs.factor new file mode 100644 index 0000000000..a5f92db165 --- /dev/null +++ b/core/io/encodings/string/string-docs.factor @@ -0,0 +1,16 @@ +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." } ; diff --git a/core/io/encodings/string/string-tests.factor b/core/io/encodings/string/string-tests.factor index 50d246183b..8d8db84799 100644 --- a/core/io/encodings/string/string-tests.factor +++ b/core/io/encodings/string/string-tests.factor @@ -1,5 +1,9 @@ -USING: io.encodings.utf8 io.encodings.utf16 io.encodings.string tools.test ; +USING: strings io.encodings.utf8 io.encodings.utf16 +io.encodings.string tools.test ; IN: io.encodings.string.tests -[ "hello" ] [ "hello" utf8 decode-string ] unit-test -[ "he" ] [ "\0h\0e" utf16be decode-string ] unit-test +[ "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 diff --git a/core/io/encodings/string/string.factor b/core/io/encodings/string/string.factor index acfe2edd89..c6e01121dc 100644 --- a/core/io/encodings/string/string.factor +++ b/core/io/encodings/string/string.factor @@ -1,5 +1,8 @@ -USING: io.encodings io io.streams.byte-array ; +USING: io io.streams.byte-array ; IN: io.encodings.string -: decode-string ( byte-array encoding -- string ) +: decode ( byte-array encoding -- string ) contents ; + +: encode ( string encoding -- byte-array ) + [ write ] with-byte-writer ; diff --git a/core/io/encodings/string/summary.txt b/core/io/encodings/string/summary.txt new file mode 100644 index 0000000000..59b8927dea --- /dev/null +++ b/core/io/encodings/string/summary.txt @@ -0,0 +1 @@ +Encoding and decoding strings diff --git a/core/io/encodings/string/tags.factor b/core/io/encodings/string/tags.factor new file mode 100644 index 0000000000..8e27be7d61 --- /dev/null +++ b/core/io/encodings/string/tags.factor @@ -0,0 +1 @@ +text diff --git a/extra/help/handbook/handbook.factor b/extra/help/handbook/handbook.factor index a078db8762..84108a1db6 100755 --- a/extra/help/handbook/handbook.factor +++ b/extra/help/handbook/handbook.factor @@ -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 io.streams.byte-array ; +quotations io.streams.byte-array io.encodings.string ; IN: help.handbook ARTICLE: "conventions" "Conventions" @@ -186,8 +186,10 @@ ARTICLE: "io" "Input and output" { $subsection "io.files" } { $subsection "io.mmap" } { $subsection "io.monitors" } -{ $heading "Other features" } +{ $heading "Encodings" } { $subsection "io.encodings" } +{ $subsection "io.encodings.string" } +{ $heading "Other features" } { $subsection "network-streams" } { $subsection "io.launcher" } { $subsection "io.timeouts" } ; diff --git a/extra/http/http.factor b/extra/http/http.factor index 7ed921480c..849b9e2fc9 100755 --- a/extra/http/http.factor +++ b/extra/http/http.factor @@ -2,7 +2,7 @@ ! 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 io.encodings io.encodings.string namespaces +io.encodings.utf8 io.encodings.string namespaces unicode.case combinators vectors sorting new-slots accessors calendar calendar.format quotations arrays ; IN: http @@ -18,7 +18,7 @@ IN: http swap "/_-." member? or ; foldable : push-utf8 ( ch -- ) - 1string utf8 encode-string [ 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 utf8 decode-string ; + [ 0 swap url-decode-iter ] "" make utf8 decode ; : crlf "\r\n" write ; diff --git a/extra/ui/x11/x11.factor b/extra/ui/x11/x11.factor index ae56c6a43f..158a48a1c0 100755 --- a/extra/ui/x11/x11.factor +++ b/extra/ui/x11/x11.factor @@ -3,7 +3,7 @@ USING: alien alien.c-types arrays ui ui.gadgets ui.gestures ui.backend ui.clipboards ui.gadgets.worlds assocs kernel math namespaces opengl sequences strings x11.xlib x11.events x11.xim -x11.glx x11.clipboard x11.constants x11.windows io.encodings +x11.glx x11.clipboard x11.constants x11.windows io.encodings.string io.encodings.utf8 combinators debugger system command-line ui.render math.vectors tuples opengl.gl threads ; IN: ui.x11 @@ -137,7 +137,7 @@ M: world selection-notify-event : encode-clipboard ( string type -- bytes ) XSelectionRequestEvent-target XA_UTF8_STRING = - [ utf8 encode-string ] [ string>char-alien ] if ; + [ utf8 encode ] [ string>char-alien ] if ; : set-selection-prop ( evt -- ) dpy get swap @@ -212,7 +212,7 @@ M: x-clipboard paste-clipboard : set-title-new ( dpy window string -- ) >r XA_NET_WM_NAME XA_UTF8_STRING 8 PropModeReplace - r> utf8 encode-string dup length XChangeProperty drop ; + r> utf8 encode dup length XChangeProperty drop ; M: x11-ui-backend set-title ( string world -- ) world-handle x11-handle-window swap dpy get -rot diff --git a/extra/x11/clipboard/clipboard.factor b/extra/x11/clipboard/clipboard.factor index b839e262d9..0313776a20 100755 --- a/extra/x11/clipboard/clipboard.factor +++ b/extra/x11/clipboard/clipboard.factor @@ -36,7 +36,7 @@ TUPLE: x-clipboard atom contents ; >r XSelectionEvent-property zero? [ r> drop f ] [ - r> selection-property 1 window-property utf8 decode-string + r> selection-property 1 window-property utf8 decode ] if ; : own-selection ( prop win -- ) From d8858ef9249b6b8c0943d69660bbf8561a3ac205 Mon Sep 17 00:00:00 2001 From: Daniel Ehrenberg Date: Wed, 5 Mar 2008 19:14:58 -0600 Subject: [PATCH 32/38] Stack effect comment typo in io.files --- core/io/files/files.factor | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/core/io/files/files.factor b/core/io/files/files.factor index 5779aa6783..a2b640e267 100755 --- a/core/io/files/files.factor +++ b/core/io/files/files.factor @@ -218,10 +218,10 @@ M: pathname <=> [ pathname-string ] compare ; dupd swap file-length [ stream-copy ] keep >string ; -: with-file-reader ( path quot -- ) +: with-file-reader ( path encoding quot -- ) >r r> with-stream ; inline -: with-file-writer ( path quot -- ) +: with-file-writer ( path encoding quot -- ) >r r> with-stream ; inline : with-file-appender ( path encoding quot -- ) From ee9b940bc629bd100fa820b4fb013ba47ddc9108 Mon Sep 17 00:00:00 2001 From: Daniel Ehrenberg Date: Thu, 6 Mar 2008 00:23:38 -0600 Subject: [PATCH 33/38] Modifications to the encoding protocol for later optimization --- core/io/encodings/encodings-docs.factor | 16 ++++----- core/io/encodings/encodings.factor | 7 ++-- core/io/encodings/string/string-docs.factor | 2 ++ core/io/encodings/string/string-tests.factor | 2 ++ core/io/encodings/string/string.factor | 2 ++ core/io/encodings/utf8/utf8-tests.factor | 13 ++++--- core/io/encodings/utf8/utf8.factor | 17 +++++---- extra/io/encodings/ascii/ascii.factor | 8 ++--- extra/io/encodings/latin1/latin1.factor | 4 +-- extra/io/encodings/utf16/utf16-tests.factor | 36 ++++++++------------ extra/io/encodings/utf16/utf16.factor | 36 ++++++++++---------- 11 files changed, 70 insertions(+), 73 deletions(-) diff --git a/core/io/encodings/encodings-docs.factor b/core/io/encodings/encodings-docs.factor index 562e7dcd9a..e5e71b05f0 100644 --- a/core/io/encodings/encodings-docs.factor +++ b/core/io/encodings/encodings-docs.factor @@ -46,23 +46,23 @@ 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 encode-string } ; +{ $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." } ; +{ $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: encode-string ( string encoding -- byte-array ) +HELP: stream-write-encoded ( string stream encoding -- ) { $values { "string" "a string" } - { "encoding" "an encoding descriptor" } - { "byte-array" "an encoded byte-array" } } -{ $description "Encodes the string with the given encoding descriptor, outputting the result to a byte-array." } ; + { "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." } ; +{ $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 encode-string } related-words +{ init-decoder decode-step stream-write-encoded } related-words diff --git a/core/io/encodings/encodings.factor b/core/io/encodings/encodings.factor index 8489c46d2e..2f68334bde 100755 --- a/core/io/encodings/encodings.factor +++ b/core/io/encodings/encodings.factor @@ -15,9 +15,8 @@ GENERIC: init-decoder ( stream encoding -- encoding ) M: tuple-class init-decoder construct-empty init-decoder ; M: object init-decoder nip ; -GENERIC: encode-string ( string encoding -- byte-array ) -M: tuple-class encode-string construct-empty encode-string ; -M: object encode-string drop >byte-array ; +GENERIC: stream-write-encoded ( string stream encoding -- byte-array ) +M: object stream-write-encoded drop stream-write ; ! Decoding @@ -136,7 +135,7 @@ M: encoder stream-write1 >r 1string r> stream-write ; M: encoder stream-write - [ encoder-code encode-string ] keep delegate stream-write ; + { delegate encoder-code } get-slots stream-write-encoded ; M: encoder dispose delegate dispose ; diff --git a/core/io/encodings/string/string-docs.factor b/core/io/encodings/string/string-docs.factor index a5f92db165..0a35eee272 100644 --- a/core/io/encodings/string/string-docs.factor +++ b/core/io/encodings/string/string-docs.factor @@ -1,3 +1,5 @@ +! 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 diff --git a/core/io/encodings/string/string-tests.factor b/core/io/encodings/string/string-tests.factor index 8d8db84799..ddae9c8734 100644 --- a/core/io/encodings/string/string-tests.factor +++ b/core/io/encodings/string/string-tests.factor @@ -1,3 +1,5 @@ +! 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 diff --git a/core/io/encodings/string/string.factor b/core/io/encodings/string/string.factor index c6e01121dc..5e57a943a9 100644 --- a/core/io/encodings/string/string.factor +++ b/core/io/encodings/string/string.factor @@ -1,3 +1,5 @@ +! Copyright (C) 2008 Daniel Ehrenberg. +! See http://factorcode.org/license.txt for BSD license. USING: io io.streams.byte-array ; IN: io.encodings.string diff --git a/core/io/encodings/utf8/utf8-tests.factor b/core/io/encodings/utf8/utf8-tests.factor index 0671fe2129..8f1c998f3d 100644 --- a/core/io/encodings/utf8/utf8-tests.factor +++ b/core/io/encodings/utf8/utf8-tests.factor @@ -1,21 +1,20 @@ -USING: io.encodings.utf8 tools.test sbufs kernel io io.encodings -sequences strings arrays unicode io.streams.byte-array ; +USING: io.encodings.utf8 tools.test io.encodings.string strings arrays ; : decode-utf8-w/stream ( array -- newarray ) - utf8 contents >array ; + utf8 decode >array ; : encode-utf8-w/stream ( array -- newarray ) - utf8 [ write ] with-byte-writer >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 diff --git a/core/io/encodings/utf8/utf8.factor b/core/io/encodings/utf8/utf8.factor index edc4663214..5887a8375e 100644 --- a/core/io/encodings/utf8/utf8.factor +++ b/core/io/encodings/utf8/utf8.factor @@ -60,29 +60,28 @@ 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 ; - -M: utf8 encode-string drop encode-utf8 ; +M: utf8 stream-write-encoded + ! For efficiency, this should be modified to avoid variable reads + drop [ [ char>utf8 ] each ] with-stream* ; diff --git a/extra/io/encodings/ascii/ascii.factor b/extra/io/encodings/ascii/ascii.factor index 6dd8d23155..f310f53e29 100644 --- a/extra/io/encodings/ascii/ascii.factor +++ b/extra/io/encodings/ascii/ascii.factor @@ -3,13 +3,13 @@ USING: io io.encodings strings kernel math sequences byte-arrays io.encodings ; IN: io.encodings.ascii -: encode-check<= ( string max -- byte-array ) - dupd [ <= ] curry all? [ >byte-array ] [ encode-error ] if ; +: encode-check<= ( string stream max -- ) + [ pick > [ encode-error ] [ stream-write1 ] if ] 2curry each ; TUPLE: ascii ; -M: ascii encode-string +M: ascii stream-write-encoded ( string stream encoding -- ) drop 127 encode-check<= ; M: ascii decode-step - drop dup 128 >= [ encode-error ] [ swap push ] if ; + drop dup 128 >= [ decode-error ] [ swap push ] if ; diff --git a/extra/io/encodings/latin1/latin1.factor b/extra/io/encodings/latin1/latin1.factor index 36e38caa1c..989f45bc64 100755 --- a/extra/io/encodings/latin1/latin1.factor +++ b/extra/io/encodings/latin1/latin1.factor @@ -5,8 +5,8 @@ IN: io.encodings.latin1 TUPLE: latin1 ; -M: latin1 encode-string +M: latin1 stream-write-encoded drop 255 encode-check<= ; M: latin1 decode-step - drop dup 256 >= [ encode-error ] [ swap push ] if ; + drop dup 256 >= [ decode-error ] [ swap push ] if ; diff --git a/extra/io/encodings/utf16/utf16-tests.factor b/extra/io/encodings/utf16/utf16-tests.factor index 7ee5c9574e..89b61a3e37 100755 --- a/extra/io/encodings/utf16/utf16-tests.factor +++ b/extra/io/encodings/utf16/utf16-tests.factor @@ -1,28 +1,22 @@ USING: kernel tools.test io.encodings.utf16 arrays sbufs -sequences io.encodings io unicode io.streams.byte-array ; +sequences io.encodings io unicode io.encodings.string ; -: decode-w/stream ( array encoding -- newarray ) - contents >array ; +[ { 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 -: encode-w/stream ( array encoding -- newarray ) - [ write ] with-byte-writer >array ; +[ { 0 120 216 52 221 30 } ] [ { CHAR: x HEX: 1d11e } utf16be encode >array ] unit-test -[ { 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 +[ { 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 -[ { 0 120 216 52 221 30 } ] [ { CHAR: x HEX: 1d11e } utf16be encode-w/stream ] unit-test +[ { 120 0 52 216 30 221 } ] [ { CHAR: x HEX: 1d11e } utf16le encode >array ] 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 +[ { 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 -[ { 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 +[ { HEX: ff HEX: fe 120 0 52 216 30 221 } ] [ { CHAR: x HEX: 1d11e } utf16 encode >array ] unit-test diff --git a/extra/io/encodings/utf16/utf16.factor b/extra/io/encodings/utf16/utf16.factor index 8815d588ad..a501fad0bd 100755 --- a/extra/io/encodings/utf16/utf16.factor +++ b/extra/io/encodings/utf16/utf16.factor @@ -106,25 +106,28 @@ M: utf16le init-decoder nip begin over set-utf16le-state ; : 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 encode-string drop encode-utf16le ; -M: utf16be encode-string drop encode-utf16be ; +M: utf16le stream-write-encoded ( string stream encoding -- ) + drop stream-write-utf16le ; ! UTF-16 @@ -132,19 +135,16 @@ M: utf16be encode-string drop encode-utf16be ; : 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 ; TUPLE: utf16 started? ; -M: utf16 encode-string - >r encode-utf16le r> +M: utf16 stream-write-encoded dup utf16-started? [ drop ] - [ t swap set-utf16-started? bom-le swap append ] if ; + [ 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 ] [ From a336cb7570db38c343b863fca05df740b2f2b407 Mon Sep 17 00:00:00 2001 From: dharmatech Date: Thu, 6 Mar 2008 13:46:15 -0600 Subject: [PATCH 34/38] Unit test fixes --- core/words/words-tests.factor | 6 +- extra/db/tuples/tuples-tests.factor | 6 +- extra/html/parser/analyzer/analyzer.factor | 9 +- extra/io/sniffer/bsd/bsd.factor | 2 +- extra/io/unix/kqueue/kqueue.factor | 3 +- extra/ldap/ldap-tests.factor | 5 +- extra/ldap/libldap/libldap.factor | 4 +- extra/openssl/libssl/libssl.factor | 4 +- extra/pdf/libhpdf/libhpdf.factor | 4 +- extra/pdf/pdf-tests.factor | 2 +- extra/pdf/test/font_test.pdf | 300 ------------------ extra/peg/search/search-tests.factor | 3 +- .../safe-words/safe-words.factor | 1 - extra/smtp/smtp-tests.factor | 3 +- extra/unix/unix.factor | 1 + extra/webapps/callback/authors.txt | 2 - extra/webapps/callback/callback.factor | 126 -------- extra/webapps/continuation/authors.txt | 1 - .../webapps/continuation/continuation.factor | 151 --------- .../webapps/continuation/examples/authors.txt | 1 - .../continuation/examples/examples.factor | 115 ------- 21 files changed, 31 insertions(+), 718 deletions(-) delete mode 100644 extra/pdf/test/font_test.pdf delete mode 100755 extra/webapps/callback/authors.txt delete mode 100644 extra/webapps/callback/callback.factor delete mode 100755 extra/webapps/continuation/authors.txt delete mode 100644 extra/webapps/continuation/continuation.factor delete mode 100755 extra/webapps/continuation/examples/authors.txt delete mode 100644 extra/webapps/continuation/examples/examples.factor diff --git a/core/words/words-tests.factor b/core/words/words-tests.factor index 06f3c7a782..4d9933147b 100755 --- a/core/words/words-tests.factor +++ b/core/words/words-tests.factor @@ -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 [ ] [ diff --git a/extra/db/tuples/tuples-tests.factor b/extra/db/tuples/tuples-tests.factor index 7d72a644bf..5913f053da 100755 --- a/extra/db/tuples/tuples-tests.factor +++ b/extra/db/tuples/tuples-tests.factor @@ -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 diff --git a/extra/html/parser/analyzer/analyzer.factor b/extra/html/parser/analyzer/analyzer.factor index fca15d9b07..8fc45ec486 100755 --- a/extra/html/parser/analyzer/analyzer.factor +++ b/extra/html/parser/analyzer/analyzer.factor @@ -1,6 +1,5 @@ USING: assocs html.parser kernel math sequences strings ascii -arrays shuffle unicode.case namespaces splitting -http.server.responders ; +arrays shuffle unicode.case namespaces splitting http ; IN: html.parser.analyzer : remove-blank-text ( vector -- vector' ) @@ -82,8 +81,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 @@ -91,5 +90,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 diff --git a/extra/io/sniffer/bsd/bsd.factor b/extra/io/sniffer/bsd/bsd.factor index 1c72a4780c..1456965858 100644 --- a/extra/io/sniffer/bsd/bsd.factor +++ b/extra/io/sniffer/bsd/bsd.factor @@ -7,7 +7,7 @@ sequences io.sniffer.backend ; QUALIFIED: unix IN: io.sniffer.bsd -M: unix-io destruct-handle ( obj -- ) unix:close drop ; +M: unix-io destruct-handle ( obj -- ) unix:close ; C-UNION: ifreq_props "sockaddr-in" "short" "int" "caddr_t" ; C-STRUCT: ifreq { { "char" 16 } "name" } { "ifreq_props" "props" } ; diff --git a/extra/io/unix/kqueue/kqueue.factor b/extra/io/unix/kqueue/kqueue.factor index 60e3754ec6..c5dc964a7a 100755 --- a/extra/io/unix/kqueue/kqueue.factor +++ b/extra/io/unix/kqueue/kqueue.factor @@ -31,7 +31,8 @@ M: output-task io-task-filter drop EVFILT_WRITE ; swap io-task-filter over set-kevent-filter ; : register-kevent ( kevent mx -- ) - mx-fd swap 1 f 0 f kevent io-error ; + mx-fd swap 1 f 0 f kevent + 0 < [ err_no ESRCH = [ (io-error) ] unless ] when ; M: kqueue-mx register-io-task ( task mx -- ) over EV_ADD make-kevent over register-kevent diff --git a/extra/ldap/ldap-tests.factor b/extra/ldap/ldap-tests.factor index e4338615ce..42e51c782a 100644 --- a/extra/ldap/ldap-tests.factor +++ b/extra/ldap/ldap-tests.factor @@ -5,10 +5,12 @@ tools.test ; get-ldp LDAP_OPT_PROTOCOL_VERSION LDAP_VERSION3 set-option -[ B{ 0 0 0 3 } ] [ +[ 3 ] [ get-ldp LDAP_OPT_PROTOCOL_VERSION "int*" [ get-option ] keep + *int ] unit-test +[ get-ldp "cn=jimbob,dc=example,dc=com" "secret" [ ! get-ldp "dc=example,dc=com" LDAP_SCOPE_ONELEVEL "(objectclass=*)" f 0 @@ -52,3 +54,4 @@ get-ldp "cn=jimbob,dc=example,dc=com" "secret" [ get-ldp get-message next-message msgtype result-type ] with-bind +] drop diff --git a/extra/ldap/libldap/libldap.factor b/extra/ldap/libldap/libldap.factor index 492aed1a54..ae613bd461 100755 --- a/extra/ldap/libldap/libldap.factor +++ b/extra/ldap/libldap/libldap.factor @@ -9,11 +9,11 @@ USING: alien alien.syntax combinators kernel system ; IN: ldap.libldap -"libldap" { +<< "libldap" { { [ win32? ] [ "libldap.dll" "stdcall" ] } { [ macosx? ] [ "libldap.dylib" "cdecl" ] } { [ unix? ] [ "$LD_LIBRARY_PATH/libldap.so" "cdecl" ] } -} cond add-library +} cond add-library >> : LDAP_VERSION1 1 ; inline : LDAP_VERSION2 2 ; inline diff --git a/extra/openssl/libssl/libssl.factor b/extra/openssl/libssl/libssl.factor index 29016f6d57..8d1b3b5247 100644 --- a/extra/openssl/libssl/libssl.factor +++ b/extra/openssl/libssl/libssl.factor @@ -9,11 +9,11 @@ USING: alien alien.syntax combinators kernel system ; IN: openssl.libssl -"libssl" { +<< "libssl" { { [ win32? ] [ "ssleay32.dll" "stdcall" ] } { [ macosx? ] [ "libssl.dylib" "cdecl" ] } { [ unix? ] [ "$LD_LIBRARY_PATH/libssl.so" "cdecl" ] } -} cond add-library +} cond add-library >> : X509_FILETYPE_PEM 1 ; inline : X509_FILETYPE_ASN1 2 ; inline diff --git a/extra/pdf/libhpdf/libhpdf.factor b/extra/pdf/libhpdf/libhpdf.factor index 85ccc70c25..a40b7cddee 100644 --- a/extra/pdf/libhpdf/libhpdf.factor +++ b/extra/pdf/libhpdf/libhpdf.factor @@ -9,11 +9,11 @@ USING: alien alien.syntax combinators system ; IN: pdf.libhpdf -"libhpdf" { +<< "libhpdf" { { [ win32? ] [ "libhpdf.dll" "stdcall" ] } { [ macosx? ] [ "libhpdf.dylib" "cdecl" ] } { [ unix? ] [ "$LD_LIBRARY_PATH/libhpdf.so" "cdecl" ] } -} cond add-library +} cond add-library >> ! compression mode : HPDF_COMP_NONE HEX: 00 ; inline ! No contents are compressed diff --git a/extra/pdf/pdf-tests.factor b/extra/pdf/pdf-tests.factor index dc42874d2a..097f671d9a 100644 --- a/extra/pdf/pdf-tests.factor +++ b/extra/pdf/pdf-tests.factor @@ -92,6 +92,6 @@ SYMBOL: twidth ] with-text - "extra/pdf/test/font_test.pdf" resource-path save-to-file + "font_test.pdf" temp-file save-to-file ] with-pdf diff --git a/extra/pdf/test/font_test.pdf b/extra/pdf/test/font_test.pdf deleted file mode 100644 index 4360cf349f..0000000000 --- a/extra/pdf/test/font_test.pdf +++ /dev/null @@ -1,300 +0,0 @@ -%PDF-1.3 -%·¾­ª -1 0 obj -<< -/Type /Catalog -/Pages 2 0 R ->> -endobj -2 0 obj -<< -/Type /Pages -/Kids [ 4 0 R ] -/Count 1 ->> -endobj -3 0 obj -<< -/Producer (Haru\040Free\040PDF\040Library\0402.0.8) ->> -endobj -4 0 obj -<< -/Type /Page -/MediaBox [ 0 0 595 841 ] -/Contents 5 0 R -/Resources << -/ProcSet [ /PDF /Text /ImageB /ImageC /ImageI ] -/Font << -/F1 7 0 R -/F2 8 0 R -/F3 9 0 R -/F4 10 0 R -/F5 11 0 R -/F6 12 0 R -/F7 13 0 R -/F8 14 0 R -/F9 15 0 R -/F10 16 0 R -/F11 17 0 R -/F12 18 0 R -/F13 19 0 R -/F14 20 0 R ->> ->> -/Parent 2 0 R ->> -endobj -5 0 obj -<< -/Length 6 0 R ->> -stream -1 w -50 50 495 731 re -S -/F1 24 Tf -BT -238.148 791 Td -(Font\040Demo) Tj -ET -BT -/F1 16 Tf -60 761 Td -(\074Standard\040Type1\040font\040samples\076) Tj -ET -BT -60 736 Td -/F2 9 Tf -(Courier) Tj -0 -18 Td -/F2 20 Tf -(abcdefgABCDEFG12345!\043$\045&+-@?) Tj -0 -20 Td -/F3 9 Tf -(Courier-Bold) Tj -0 -18 Td -/F3 20 Tf -(abcdefgABCDEFG12345!\043$\045&+-@?) Tj -0 -20 Td -/F4 9 Tf -(Courier-Oblique) Tj -0 -18 Td -/F4 20 Tf -(abcdefgABCDEFG12345!\043$\045&+-@?) Tj -0 -20 Td -/F5 9 Tf -(Courier-BoldOblique) Tj -0 -18 Td -/F5 20 Tf -(abcdefgABCDEFG12345!\043$\045&+-@?) Tj -0 -20 Td -/F1 9 Tf -(Helvetica) Tj -0 -18 Td -/F1 20 Tf -(abcdefgABCDEFG12345!\043$\045&+-@?) Tj -0 -20 Td -/F6 9 Tf -(Helvetica-Bold) Tj -0 -18 Td -/F6 20 Tf -(abcdefgABCDEFG12345!\043$\045&+-@?) Tj -0 -20 Td -/F7 9 Tf -(Helvetica-Oblique) Tj -0 -18 Td -/F7 20 Tf -(abcdefgABCDEFG12345!\043$\045&+-@?) Tj -0 -20 Td -/F8 9 Tf -(Helvetica-BoldOblique) Tj -0 -18 Td -/F8 20 Tf -(abcdefgABCDEFG12345!\043$\045&+-@?) Tj -0 -20 Td -/F9 9 Tf -(Times-Roman) Tj -0 -18 Td -/F9 20 Tf -(abcdefgABCDEFG12345!\043$\045&+-@?) Tj -0 -20 Td -/F10 9 Tf -(Times-Bold) Tj -0 -18 Td -/F10 20 Tf -(abcdefgABCDEFG12345!\043$\045&+-@?) Tj -0 -20 Td -/F11 9 Tf -(Times-Italic) Tj -0 -18 Td -/F11 20 Tf -(abcdefgABCDEFG12345!\043$\045&+-@?) Tj -0 -20 Td -/F12 9 Tf -(Times-BoldItalic) Tj -0 -18 Td -/F12 20 Tf -(abcdefgABCDEFG12345!\043$\045&+-@?) Tj -0 -20 Td -/F13 9 Tf -(Symbol) Tj -0 -18 Td -/F13 20 Tf -(abcdefgABCDEFG12345!\043$\045&+-@?) Tj -0 -20 Td -/F14 9 Tf -(ZapfDingbats) Tj -0 -18 Td -/F14 20 Tf -(abcdefgABCDEFG12345!\043$\045&+-@?) Tj -0 -20 Td -ET - -endstream -endobj -6 0 obj -1517 -endobj -7 0 obj -<< -/Type /Font -/BaseFont /Helvetica -/Subtype /Type1 -/Encoding /StandardEncoding ->> -endobj -8 0 obj -<< -/Type /Font -/BaseFont /Courier -/Subtype /Type1 -/Encoding /StandardEncoding ->> -endobj -9 0 obj -<< -/Type /Font -/BaseFont /Courier-Bold -/Subtype /Type1 -/Encoding /StandardEncoding ->> -endobj -10 0 obj -<< -/Type /Font -/BaseFont /Courier-Oblique -/Subtype /Type1 -/Encoding /StandardEncoding ->> -endobj -11 0 obj -<< -/Type /Font -/BaseFont /Courier-BoldOblique -/Subtype /Type1 -/Encoding /StandardEncoding ->> -endobj -12 0 obj -<< -/Type /Font -/BaseFont /Helvetica-Bold -/Subtype /Type1 -/Encoding /StandardEncoding ->> -endobj -13 0 obj -<< -/Type /Font -/BaseFont /Helvetica-Oblique -/Subtype /Type1 -/Encoding /StandardEncoding ->> -endobj -14 0 obj -<< -/Type /Font -/BaseFont /Helvetica-BoldOblique -/Subtype /Type1 -/Encoding /StandardEncoding ->> -endobj -15 0 obj -<< -/Type /Font -/BaseFont /Times-Roman -/Subtype /Type1 -/Encoding /StandardEncoding ->> -endobj -16 0 obj -<< -/Type /Font -/BaseFont /Times-Bold -/Subtype /Type1 -/Encoding /StandardEncoding ->> -endobj -17 0 obj -<< -/Type /Font -/BaseFont /Times-Italic -/Subtype /Type1 -/Encoding /StandardEncoding ->> -endobj -18 0 obj -<< -/Type /Font -/BaseFont /Times-BoldItalic -/Subtype /Type1 -/Encoding /StandardEncoding ->> -endobj -19 0 obj -<< -/Type /Font -/BaseFont /Symbol -/Subtype /Type1 ->> -endobj -20 0 obj -<< -/Type /Font -/BaseFont /ZapfDingbats -/Subtype /Type1 ->> -endobj -xref -0 21 -0000000000 65535 f -0000000015 00000 n -0000000064 00000 n -0000000123 00000 n -0000000196 00000 n -0000000518 00000 n -0000002089 00000 n -0000002109 00000 n -0000002207 00000 n -0000002303 00000 n -0000002404 00000 n -0000002509 00000 n -0000002618 00000 n -0000002722 00000 n -0000002829 00000 n -0000002940 00000 n -0000003041 00000 n -0000003141 00000 n -0000003243 00000 n -0000003349 00000 n -0000003417 00000 n -trailer -<< -/Root 1 0 R -/Info 3 0 R -/Size 21 ->> -startxref -3491 -%%EOF diff --git a/extra/peg/search/search-tests.factor b/extra/peg/search/search-tests.factor index c65001be09..b22a5ef0d0 100755 --- a/extra/peg/search/search-tests.factor +++ b/extra/peg/search/search-tests.factor @@ -1,7 +1,8 @@ ! Copyright (C) 2007 Chris Double. ! See http://factorcode.org/license.txt for BSD license. ! -USING: kernel math math.parser arrays tools.test peg peg.search ; +USING: kernel math math.parser arrays tools.test peg peg.parsers +peg.search ; IN: peg.search.tests { V{ 123 456 } } [ diff --git a/extra/random-tester/safe-words/safe-words.factor b/extra/random-tester/safe-words/safe-words.factor index ab528786bb..f7eac4c32d 100755 --- a/extra/random-tester/safe-words/safe-words.factor +++ b/extra/random-tester/safe-words/safe-words.factor @@ -54,7 +54,6 @@ IN: random-tester.safe-words : method-words { - method-def forget-word } ; diff --git a/extra/smtp/smtp-tests.factor b/extra/smtp/smtp-tests.factor index c1afeced3d..32b2f3be14 100755 --- a/extra/smtp/smtp-tests.factor +++ b/extra/smtp/smtp-tests.factor @@ -84,6 +84,7 @@ IN: smtp.tests [ ] [ [ + "localhost" smtp-host set 4321 smtp-port set "Hi guys\nBye guys" @@ -96,4 +97,4 @@ IN: smtp.tests send-simple-message ] with-scope -] unit-test \ No newline at end of file +] unit-test diff --git a/extra/unix/unix.factor b/extra/unix/unix.factor index 9cc8552f98..e1d49b8c6c 100755 --- a/extra/unix/unix.factor +++ b/extra/unix/unix.factor @@ -21,6 +21,7 @@ TYPEDEF: ulong size_t : MAP_FAILED -1 ; inline +: ESRCH 3 ; inline : EEXIST 17 ; inline ! ! ! Unix functions diff --git a/extra/webapps/callback/authors.txt b/extra/webapps/callback/authors.txt deleted file mode 100755 index a8fb961d36..0000000000 --- a/extra/webapps/callback/authors.txt +++ /dev/null @@ -1,2 +0,0 @@ -Chris Double -Slava Pestov diff --git a/extra/webapps/callback/callback.factor b/extra/webapps/callback/callback.factor deleted file mode 100644 index 6bdc84bfa6..0000000000 --- a/extra/webapps/callback/callback.factor +++ /dev/null @@ -1,126 +0,0 @@ -! Copyright (C) 2004 Chris Double. -! Copyright (C) 2006 Slava Pestov. -! See http://factorcode.org/license.txt for BSD license. -USING: html http http.server.responders io kernel math -namespaces prettyprint continuations random system sequences -assocs ; -IN: webapps.callback - -#! Name of the variable holding the continuation used to exit -#! back to the httpd responder. -SYMBOL: exit-continuation - -#! Tuple to hold global request data. This gets passed to -#! the continuation when resumed so it can restore things -#! like 'stdio' so it writes to the correct socket. -TUPLE: request stream exitcc method url raw-query query header response ; - -: ( -- request ) - stdio get - exit-continuation get - "method" get - "request" get - "raw-query" get - "query" get - "header" get - "response" get - request construct-boa ; - -: restore-request ( -- ) - request get - dup request-stream stdio set - dup request-method "method" set - dup request-raw-query "raw-query" set - dup request-query "query" set - dup request-header "header" set - dup request-response "response" set - request-exitcc exit-continuation set ; - -: update-request ( request new-request -- ) - [ request-stream over set-request-stream ] keep - [ request-method over set-request-method ] keep - [ request-url over set-request-url ] keep - [ request-raw-query over set-request-raw-query ] keep - [ request-query over set-request-query ] keep - [ request-header over set-request-header ] keep - [ request-response over set-request-response ] keep - request-exitcc swap set-request-exitcc ; - -: with-exit-continuation ( quot -- ) - #! Call the quotation with the variable exit-continuation bound - #! such that when the exit continuation is called, computation - #! will resume from the end of this 'with-exit-continuation' call. - [ - exit-continuation set call exit-continuation get continue - ] callcc0 drop ; - -: expiry-timeout ( -- ms ) 900 1000 * ; - -: get-random-id ( -- id ) - #! Generate a random id to use for continuation URL's - 4 big-random unparse ; - -: callback-table ( -- ) - #! Return the global table of continuations - \ callback-table get-global ; - -: reset-callback-table ( -- ) - #! Create the initial global table - H{ } clone \ callback-table set-global ; - -reset-callback-table - -#! Tuple for holding data related to a callback. -TUPLE: item quot expire? request id time-added ; - -: ( quot expire? request id -- item ) - millis item construct-boa ; - -: expired? ( item -- ? ) - #! Return true if the callback item is expirable - #! and has expired (ie. was added to the table more than - #! timeout milliseconds ago). - [ item-time-added expiry-timeout + millis < ] keep - item-expire? and ; - -: expire-callbacks ( -- ) - #! Expire all continuations in the continuation table - #! if they are 'timeout-seconds' old (ie. were added - #! more than 'timeout-seconds' ago. - callback-table clone [ - expired? [ callback-table delete-at ] [ drop ] if - ] assoc-each ; - -: id>url ( id -- string ) - #! Convert the continuation id to an URL suitable for - #! embedding in an HREF or other HTML. - "/responder/callback/?id=" swap url-encode append ; - -: register-callback ( quot expire? -- url ) - #! Store a continuation in the table and associate it with - #! a random id. That continuation will be expired after - #! a certain period of time if 'expire?' is true. - request get get-random-id [ ] keep - [ callback-table set-at ] keep - id>url ; - -: register-html-callback ( quot expire? -- url ) - >r [ serving-html ] swap append r> register-callback ; - -: callback-responder ( -- ) - expire-callbacks - "id" query-param callback-table at [ - [ - dup item-request [ - update-request - ] when* - item-quot call - exit-continuation get continue - ] with-exit-continuation drop - ] [ - "404 Callback not available" httpd-error - ] if* ; - -global [ - "callback" [ callback-responder ] add-simple-responder -] bind diff --git a/extra/webapps/continuation/authors.txt b/extra/webapps/continuation/authors.txt deleted file mode 100755 index 44b06f94bc..0000000000 --- a/extra/webapps/continuation/authors.txt +++ /dev/null @@ -1 +0,0 @@ -Chris Double diff --git a/extra/webapps/continuation/continuation.factor b/extra/webapps/continuation/continuation.factor deleted file mode 100644 index 6b6838d89f..0000000000 --- a/extra/webapps/continuation/continuation.factor +++ /dev/null @@ -1,151 +0,0 @@ -! Copyright (C) 2004 Chris Double. -! See http://factorcode.org/license.txt for BSD license. - -USING: http math namespaces io strings kernel html html.elements -hashtables continuations quotations parser generic sequences -webapps.callback http.server.responders ; -IN: webapps.continuation - -#! Used inside the session state of responders to indicate whether the -#! next request should use the post-refresh-get pattern. It is set to -#! true after each request. -SYMBOL: post-refresh-get? - -: >callable ( quot|interp|f -- interp ) - dup continuation? [ - [ continue ] curry - ] when ; - -: forward-to-url ( url -- ) - #! When executed inside a 'show' call, this will force a - #! HTTP 302 to occur to instruct the browser to forward to - #! the request URL. - [ - "HTTP/1.1 302 Document Moved\nLocation: " % % - "\nContent-Length: 0\nContent-Type: text/plain\n\n" % - ] "" make write exit-continuation get continue ; - -: forward-to-id ( id -- ) - #! When executed inside a 'show' call, this will force a - #! HTTP 302 to occur to instruct the browser to forward to - #! the request URL. - >r "request" get r> id>url append forward-to-url ; - -SYMBOL: current-show - -: store-current-show ( -- ) - #! Store the current continuation in the variable 'current-show' - #! so it can be returned to later by href callbacks. Note that it - #! recalls itself when the continuation is called to ensure that - #! it resets its value back to the most recent show call. - [ ( 0 -- ) - [ ( 0 1 -- ) - current-show set ( 0 -- ) - continue - ] callcc1 - nip - restore-request - call - store-current-show - ] callcc0 restore-request ; - -: redirect-to-here ( -- ) - #! Force a redirect to the client browser so that the browser - #! goes to the current point in the code. This forces an URL - #! change on the browser so that refreshing that URL will - #! immediately run from this code point. This prevents the - #! "this request will issue a POST" warning from the browser - #! and prevents re-running the previous POST logic. This is - #! known as the 'post-refresh-get' pattern. - post-refresh-get? get [ - [ - >callable t register-callback forward-to-url - ] callcc0 restore-request - ] [ - t post-refresh-get? set - ] if ; - -: (show) ( quot -- hashtable ) - #! See comments for show. The difference is the - #! quotation MUST set the content-type using 'serving-html' - #! or similar. - store-current-show redirect-to-here - [ - >callable t register-callback swap with-scope - exit-continuation get continue - ] callcc0 drop restore-request "response" get ; - -: show ( quot -- namespace ) - #! Call the quotation with the URL associated with the current - #! continuation. All output from the quotation goes to the client - #! browser. When the URL is later referenced then - #! computation will resume from this 'show' call with a hashtable on - #! the stack containing any query or post parameters. - #! 'quot' has stack effect ( url -- ) - #! NOTE: On return from 'show' the stack is exactly the same as - #! initial entry with 'quot' popped off and the hashtable pushed on. Even - #! if the quotation consumes items on the stack. - [ serving-html ] swap append (show) ; - -: (show-final) ( quot -- namespace ) - #! See comments for show-final. The difference is the - #! quotation MUST set the content-type using 'serving-html' - #! or similar. - store-current-show redirect-to-here - with-scope exit-continuation get continue ; - -: show-final ( quot -- namespace ) - #! Similar to 'show', except the quotation does not receive the URL - #! to resume computation following 'show-final'. No continuation is - #! stored for this resumption. As a result, 'show-final' is for use - #! when a page is to be displayed with no further action to occur. Its - #! use is an optimisation to save having to generate and save a continuation - #! in that special case. - #! 'quot' has stack effect ( -- ). - [ serving-html ] swap compose (show-final) ; - -#! Name of variable for holding initial continuation id that starts -#! the responder. -SYMBOL: root-callback - -: cont-get/post-responder ( id-or-f -- ) - #! httpd responder that handles the root continuation request. - #! The requests for actual continuation are processed by the - #! 'callback-responder'. - [ - [ f post-refresh-get? set request set root-callback get call ] with-scope - exit-continuation get continue - ] with-exit-continuation drop ; - -: quot-url ( quot -- url ) - current-show get [ continue-with ] 2curry t register-callback ; - -: quot-href ( text quot -- ) - #! Write to standard output an HTML HREF where the href, - #! when referenced, will call the quotation and then return - #! back to the most recent 'show' call (via the callback-cc). - #! The text of the link will be the 'text' argument on the - #! stack. - write ; - -: install-cont-responder ( name quot -- ) - #! Install a cont-responder with the given name - #! that will initially run the given quotation. - #! - #! Convert the quotation so it is run within a session namespace - #! and that namespace is initialized first. - [ - [ cont-get/post-responder ] "get" set - [ cont-get/post-responder ] "post" set - swap "responder" set - root-callback set - ] make-responder ; - -: show-message-page ( message -- ) - #! Display the message in an HTML page with an OK button. - [ - "Press OK to Continue" [ - swap paragraph - "OK" write - ] simple-page - ] show 2drop ; diff --git a/extra/webapps/continuation/examples/authors.txt b/extra/webapps/continuation/examples/authors.txt deleted file mode 100755 index 44b06f94bc..0000000000 --- a/extra/webapps/continuation/examples/authors.txt +++ /dev/null @@ -1 +0,0 @@ -Chris Double diff --git a/extra/webapps/continuation/examples/examples.factor b/extra/webapps/continuation/examples/examples.factor deleted file mode 100644 index 2899562503..0000000000 --- a/extra/webapps/continuation/examples/examples.factor +++ /dev/null @@ -1,115 +0,0 @@ -! Copyright (C) 2004 Chris Double. -! -! Redistribution and use in source and binary forms, with or without -! modification, are permitted provided that the following conditions are met: -! -! 1. Redistributions of source code must retain the above copyright notice, -! this list of conditions and the following disclaimer. -! -! 2. Redistributions in binary form must reproduce the above copyright notice, -! this list of conditions and the following disclaimer in the documentation -! and/or other materials provided with the distribution. -! -! THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, -! INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND -! FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE -! DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, -! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, -! PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; -! OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, -! WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR -! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF -! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -! -! Simple test applications -USING: hashtables html kernel io html html.elements strings math -assocs quotations webapps.continuation namespaces prettyprint -sequences ; - -IN: webapps.continuation.examples - -: display-page ( title -- ) - #! Display a page with some text to test the cont-responder. - #! The page has a link to the 'next' continuation. - [ -

over write

- swap [ - "Next" write - ] simple-html-document - ] show 2drop ; - -: display-get-name-page ( -- name ) - #! Display a page prompting for input of a name and return that name. - [ - "Enter your name" [ -

swap write

-
- "Name: " write - - -
- ] simple-html-document - ] show "name" swap at ; - -: test-cont-responder ( -- ) - #! Test the cont-responder responder by displaying a few pages in a row. - "Page one" display-page - "Hello " display-get-name-page append display-page - "Page three" display-page ; - -: test-cont-responder2 ( -- ) - #! Test the cont-responder responder by displaying a few pages in a loop. - [ "one" "two" "three" "four" ] [ display-page ] each - "Done!" display-page ; - -: test-cont-responder3 ( -- ) - #! Test the quot-href word by displaying a menu of the current - #! test words. Note that we use show-final as we don't link to a 'next' page. - [ - "Menu" [ -

"Menu" write

-
    -
  1. "Test responder1" [ test-cont-responder ] quot-href
    2. -
  2. "Test responder2" [ test-cont-responder2 ] quot-href
    3. -
- ] simple-html-document - ] show-final ; - -: counter-example ( count -- ) - #! Display a counter which can be incremented or decremented - #! using anchors. - #! - #! Don't need the original alist - [ - #! And we don't need the 'url' argument - drop - "Counter: " over unparse append [ - dup

unparse write

- "++" over 1quotation [ f ] swap append [ 1 + counter-example ] append quot-href - "--" over 1quotation [ f ] swap append [ 1 - counter-example ] append quot-href - drop - ] simple-html-document - ] show drop ; - -: counter-example2 ( -- ) - #! Display a counter which can be incremented or decremented - #! using anchors. - #! - 0 "counter" set - [ - #! We don't need the 'url' argument - drop - "Counter: " "counter" get unparse append [ -

"counter" get unparse write

- "++" [ "counter" get 1 + "counter" set ] quot-href - "--" [ "counter" get 1 - "counter" set ] quot-href - ] simple-html-document - ] show - drop ; - -! Install the examples -"counter1" [ drop 0 counter-example ] install-cont-responder -"counter2" [ drop counter-example2 ] install-cont-responder -"test1" [ test-cont-responder ] install-cont-responder -"test2" [ drop test-cont-responder2 ] install-cont-responder -"test3" [ drop test-cont-responder3 ] install-cont-responder From b32276d1da218ac28a1354205a1b950a5961e0f8 Mon Sep 17 00:00:00 2001 From: Daniel Ehrenberg Date: Thu, 6 Mar 2008 14:46:11 -0600 Subject: [PATCH 35/38] Stupid bug fix --- core/io/encodings/utf8/utf8-docs.factor | 2 +- extra/io/encodings/ascii/ascii.factor | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/core/io/encodings/utf8/utf8-docs.factor b/core/io/encodings/utf8/utf8-docs.factor index 3e901ec83b..dbbc193a02 100755 --- a/core/io/encodings/utf8/utf8-docs.factor +++ b/core/io/encodings/utf8/utf8-docs.factor @@ -6,6 +6,6 @@ ARTICLE: "io.encodings.utf8" "Working with UTF8-encoded data" { $subsection utf8 } ; HELP: utf8 -{ $class-description "This is the class of encoding tuples which denote a UTF-8 encoding. You can pass this class symbol as an encoding descriptor to words like " { $link } " and " { $link encode-string } ". This conforms to the " { $link "encodings-protocol" } "." } ; +{ $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" diff --git a/extra/io/encodings/ascii/ascii.factor b/extra/io/encodings/ascii/ascii.factor index f310f53e29..fdefc35634 100644 --- a/extra/io/encodings/ascii/ascii.factor +++ b/extra/io/encodings/ascii/ascii.factor @@ -4,7 +4,7 @@ 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 ; + [ pick <= [ encode-error ] [ stream-write1 ] if ] 2curry each ; TUPLE: ascii ; From 549a7538c7d94349106c24b6ff083b5339512c62 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Thu, 6 Mar 2008 15:58:05 -0600 Subject: [PATCH 36/38] Clean up some of Dan's code after merge --- core/bootstrap/primitives.factor | 1 + core/inference/known-words/known-words.factor | 2 + core/io/io-tests.factor | 9 +++-- core/io/streams/c/c-tests.factor | 4 +- core/io/streams/c/c.factor | 17 ++++---- extra/http/server/server.factor | 4 +- extra/io/nonblocking/nonblocking.factor | 22 ++++++----- extra/io/sockets/sockets.factor | 8 ++-- extra/io/unix/sockets/sockets.factor | 16 ++++---- extra/io/windows/nt/sockets/sockets.factor | 29 +++++--------- vm/io.c | 39 +++++++++++++++---- vm/io.h | 5 ++- vm/primitives.c | 1 + 13 files changed, 92 insertions(+), 65 deletions(-) mode change 100644 => 100755 core/io/io-tests.factor diff --git a/core/bootstrap/primitives.factor b/core/bootstrap/primitives.factor index f3f233ea0b..ab0e1cebe0 100755 --- a/core/bootstrap/primitives.factor +++ b/core/bootstrap/primitives.factor @@ -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" } diff --git a/core/inference/known-words/known-words.factor b/core/inference/known-words/known-words.factor index 8e8251ff62..5e150e66b7 100755 --- a/core/inference/known-words/known-words.factor +++ b/core/inference/known-words/known-words.factor @@ -538,6 +538,8 @@ set-primitive-effect \ fwrite { string alien } { } set-primitive-effect +\ fputc { object alien } { } set-primitive-effect + \ fread { integer string } { object } set-primitive-effect \ fflush { alien } { } set-primitive-effect diff --git a/core/io/io-tests.factor b/core/io/io-tests.factor old mode 100644 new mode 100755 index 8b5e763e45..22c942d2d9 --- a/core/io/io-tests.factor +++ b/core/io/io-tests.factor @@ -1,5 +1,6 @@ USING: arrays io io.files kernel math parser strings system -tools.test words namespaces io.encodings.ascii io.encodings.binary ; +tools.test words namespaces io.encodings.latin1 +io.encodings.binary ; IN: io.tests [ f ] [ @@ -8,7 +9,7 @@ IN: io.tests ] unit-test : ( resource -- stream ) - resource-path binary ; + resource-path latin1 ; [ "This is a line.\rThis is another line.\r" @@ -31,10 +32,10 @@ IN: io.tests ! [ ] [ "123" write 9000 CHAR: x write flush ] unit-test -[ "" ] [ +[ "/core/io/test/binary.txt" [ 0.2 read ] with-stream -] unit-test +] must-fail [ { diff --git a/core/io/streams/c/c-tests.factor b/core/io/streams/c/c-tests.factor index 6c7e57cabb..321cad4d19 100755 --- a/core/io/streams/c/c-tests.factor +++ b/core/io/streams/c/c-tests.factor @@ -1,4 +1,5 @@ -USING: tools.test io.files io io.streams.c io.encodings.ascii ; +USING: tools.test io.files io io.streams.c +io.encodings.ascii strings ; IN: io.streams.c.tests [ "hello world" ] [ @@ -7,4 +8,5 @@ IN: io.streams.c.tests ] with-file-writer "test.txt" temp-file "rb" fopen contents + >string ] unit-test diff --git a/core/io/streams/c/c.factor b/core/io/streams/c/c.factor index de49e0dfe6..372acbe0c1 100755 --- a/core/io/streams/c/c.factor +++ b/core/io/streams/c/c.factor @@ -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 io.encodings -strings sequences math generic threads.private classes -io.backend io.streams.duplex io.files continuations -io.encodings.utf8 ; +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,10 +10,10 @@ TUPLE: c-writer handle ; C: c-writer M: c-writer stream-write1 - >r 1string r> stream-write ; + c-writer-handle fputc ; M: c-writer stream-write - >r >string r> c-writer-handle fwrite ; + c-writer-handle fwrite ; M: c-writer stream-flush c-writer-handle fflush ; @@ -27,7 +26,7 @@ TUPLE: c-reader handle ; C: 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,7 +42,7 @@ 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 @@ -76,4 +75,6 @@ M: object (file-appender) #! 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 ; diff --git a/extra/http/server/server.factor b/extra/http/server/server.factor index 858ccd1009..133783114d 100755 --- a/extra/http/server/server.factor +++ b/extra/http/server/server.factor @@ -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" - binary [ handle-client ] with-server ; + latin1 [ handle-client ] with-server ; : httpd-main ( -- ) 8888 httpd ; diff --git a/extra/io/nonblocking/nonblocking.factor b/extra/io/nonblocking/nonblocking.factor index b0ce1fcc12..6eee3739d9 100755 --- a/extra/io/nonblocking/nonblocking.factor +++ b/extra/io/nonblocking/nonblocking.factor @@ -2,7 +2,7 @@ ! 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.duplex io.encodings +byte-vectors system io.streams.duplex io.encodings io.backend continuations debugger classes byte-arrays namespaces splitting dlists assocs io.encodings.binary ; @@ -71,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 ; @@ -90,10 +90,10 @@ M: input-port stream-read >r 0 max >fixnum r> 2dup read-step dup [ pick over length > [ - pick + pick [ push-all ] keep [ read-loop ] keep - "" like + B{ } like ] [ 2nip ] if @@ -101,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 @@ -109,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> @@ -120,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 -- ? ) @@ -169,7 +171,7 @@ M: port dispose [ dup port-type >r closed over set-port-type r> close-port ] if ; -TUPLE: server-port addr client encoding ; +TUPLE: server-port addr client client-addr encoding ; : ( handle addr encoding -- server ) rot f server-port diff --git a/extra/io/sockets/sockets.factor b/extra/io/sockets/sockets.factor index c10d7e963c..1dc7f4883d 100755 --- a/extra/io/sockets/sockets.factor +++ b/extra/io/sockets/sockets.factor @@ -33,17 +33,19 @@ M: array client* [ (client) 2array ] attempt-all first2 ; M: object client* (client) ; : ( addrspec encoding -- stream ) - over client* rot ; + >r client* r> ; HOOK: (server) io-backend ( addrspec -- handle ) : ( addrspec encoding -- server ) >r [ (server) ] keep r> ; -HOOK: (accept) io-backend ( server -- stream-in stream-out ) +HOOK: (accept) io-backend ( server -- addrspec handle ) : accept ( server -- client ) - [ (accept) ] keep server-port-encoding ; + [ (accept) dup ] keep + server-port-encoding + ; HOOK: io-backend ( addrspec -- datagram ) diff --git a/extra/io/unix/sockets/sockets.factor b/extra/io/unix/sockets/sockets.factor index 2af77e83c4..bd7dfd9ce1 100755 --- a/extra/io/unix/sockets/sockets.factor +++ b/extra/io/unix/sockets/sockets.factor @@ -42,7 +42,7 @@ M: connect-task do-io-task : wait-to-connect ( port -- ) [ add-io-task ] with-port-continuation drop ; -M: unix-io (client) ( addrspec -- stream ) +M: unix-io (client) ( addrspec -- client-in client-out ) dup make-sockaddr/size >r >r protocol-family SOCK_STREAM socket-fd dup r> r> connect @@ -71,10 +71,10 @@ TUPLE: accept-task ; dup [ swap heap-size accept ] keep ; inline : do-accept ( port fd sockaddr -- ) - rot [ - server-port-addr parse-sockaddr - swap dup - ] keep set-server-port-client ; + rot + [ server-port-addr parse-sockaddr ] keep + [ set-server-port-client-addr ] keep + set-server-port-client ; M: accept-task do-io-task io-task-port dup accept-sockaddr @@ -95,13 +95,13 @@ M: unix-io (server) ( addrspec -- handle ) SOCK_STREAM server-fd dup 10 listen zero? [ dup close (io-error) ] unless ; -M: unix-io (accept) ( server -- client-in client-out ) +M: unix-io (accept) ( server -- addrspec handle ) #! Wait for a client connection. dup check-server-port dup wait-to-accept dup pending-error - server-port-client - { duplex-stream-in duplex-stream-out } get-slots ; + dup server-port-client-addr + swap server-port-client ; ! Datagram sockets - UDP and Unix domain M: unix-io diff --git a/extra/io/windows/nt/sockets/sockets.factor b/extra/io/windows/nt/sockets/sockets.factor index 7af7df9bef..a63a533ba1 100755 --- a/extra/io/windows/nt/sockets/sockets.factor +++ b/extra/io/windows/nt/sockets/sockets.factor @@ -45,13 +45,12 @@ TUPLE: ConnectEx-args port "stdcall" alien-indirect drop winsock-error-string [ throw ] when* ; -: connect-continuation ( ConnectEx -- ) - dup ConnectEx-args-lpOverlapped* - swap ConnectEx-args-port duplex-stream-in - [ save-callback ] 2keep +: connect-continuation ( ConnectEx port -- ) + >r ConnectEx-args-lpOverlapped* r> + 2dup save-callback get-overlapped-result drop ; -M: windows-nt-io (client) ( addrspec -- duplex-stream ) +M: windows-nt-io (client) ( addrspec -- client-in client-out ) [ \ ConnectEx-args construct-empty over make-sockaddr/size pick init-connect @@ -61,14 +60,8 @@ M: windows-nt-io (client) ( addrspec -- duplex-stream ) dup ConnectEx-args-s* INADDR_ANY roll bind-socket dup (ConnectEx) - dup ConnectEx-args-s* - dup - over set-ConnectEx-args-port - - dup connect-continuation - ConnectEx-args-port - [ duplex-stream-in pending-error ] keep - [ duplex-stream-out pending-error ] keep + dup ConnectEx-args-s* dup + >r [ connect-continuation ] keep [ pending-error ] keep r> ] with-destructors ; TUPLE: AcceptEx-args port @@ -118,17 +111,15 @@ TUPLE: AcceptEx-args port ] keep *void* ] keep AcceptEx-args-port server-port-addr parse-sockaddr ; -: accept-continuation ( AcceptEx -- client ) +: accept-continuation ( AcceptEx -- addrspec client ) [ make-accept-continuation ] keep [ check-accept-error ] keep [ extract-remote-host ] keep ! addrspec AcceptEx - [ - AcceptEx-args-sAcceptSocket* add-completion - ] keep + [ AcceptEx-args-sAcceptSocket* add-completion ] keep AcceptEx-args-sAcceptSocket* ; -M: windows-nt-io (accept) ( server -- client-in client-out ) +M: windows-nt-io (accept) ( server -- addrspec handle ) [ [ dup check-server-port @@ -137,8 +128,6 @@ M: windows-nt-io (accept) ( server -- client-in client-out ) [ ((accept)) ] keep [ accept-continuation ] keep AcceptEx-args-port pending-error - dup duplex-stream-in pending-error - dup duplex-stream-out pending-error ] with-timeout ] with-destructors ; diff --git a/vm/io.c b/vm/io.c index d3a29abe72..faf681bbef 100755 --- a/vm/io.c +++ b/vm/io.c @@ -102,21 +102,46 @@ DEFINE_PRIMITIVE(fread) } else { - dpush(tag_object(memory_to_char_string( - (char *)(buf + 1),c))); + if(c != size) + { + REGISTER_UNTAGGED(buf); + F_BYTE_ARRAY *new_buf = allot_byte_array(c); + UNREGISTER_UNTAGGED(buf); + memcpy(new_buf + 1, buf + 1,c); + buf = new_buf; + } + dpush(tag_object(buf)); break; } } } +DEFINE_PRIMITIVE(fputc) +{ + FILE *file = unbox_alien(); + F_FIXNUM ch = to_fixnum(dpop()); + + for(;;) + { + if(fputc(ch,file) == EOF) + { + io_error(); + + /* Still here? EINTR */ + } + else + break; + } +} + DEFINE_PRIMITIVE(fwrite) { - FILE* file = unbox_alien(); - F_STRING* text = untag_string(dpop()); - F_FIXNUM length = untag_fixnum_fast(text->length); - char* string = to_char_string(text,false); + FILE *file = unbox_alien(); + F_BYTE_ARRAY *text = untag_byte_array(dpop()); + F_FIXNUM length = array_capacity(text); + char *string = (char *)(text + 1); - if(string_capacity(text) == 0) + if(length == 0) return; for(;;) diff --git a/vm/io.h b/vm/io.h index 39e7390c3e..a19da3887c 100755 --- a/vm/io.h +++ b/vm/io.h @@ -3,11 +3,12 @@ void io_error(void); int err_no(void); DECLARE_PRIMITIVE(fopen); +DECLARE_PRIMITIVE(fgetc); +DECLARE_PRIMITIVE(fread); +DECLARE_PRIMITIVE(fputc); DECLARE_PRIMITIVE(fwrite); DECLARE_PRIMITIVE(fflush); DECLARE_PRIMITIVE(fclose); -DECLARE_PRIMITIVE(fgetc); -DECLARE_PRIMITIVE(fread); /* Platform specific primitives */ DECLARE_PRIMITIVE(open_file); diff --git a/vm/primitives.c b/vm/primitives.c index a5cdb4f1ef..1b29dc65b7 100755 --- a/vm/primitives.c +++ b/vm/primitives.c @@ -162,6 +162,7 @@ void *primitives[] = { primitive_fopen, primitive_fgetc, primitive_fread, + primitive_fputc, primitive_fwrite, primitive_fflush, primitive_fclose, From 62568770a9fad32a8b911f2ec19de0979f640b0b Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Thu, 6 Mar 2008 16:07:30 -0600 Subject: [PATCH 37/38] Fix --- core/io/binary/binary.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) mode change 100644 => 100755 core/io/binary/binary.factor diff --git a/core/io/binary/binary.factor b/core/io/binary/binary.factor old mode 100644 new mode 100755 index c4d3abefce..9f6231b643 --- a/core/io/binary/binary.factor +++ b/core/io/binary/binary.factor @@ -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 ) From e6d4afa1c1c7a71845b3f1516fe9cc74f21166cf Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Thu, 6 Mar 2008 17:03:44 -0600 Subject: [PATCH 38/38] remove unique from core/ docs --- core/io/files/files-docs.factor | 1 - 1 file changed, 1 deletion(-) diff --git a/core/io/files/files-docs.factor b/core/io/files/files-docs.factor index f68d5eafbd..9609cd123b 100755 --- a/core/io/files/files-docs.factor +++ b/core/io/files/files-docs.factor @@ -89,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"