diff --git a/basis/compiler/tree/cleanup/cleanup-tests.factor b/basis/compiler/tree/cleanup/cleanup-tests.factor index 54f8aaf20e..4a2e8671fb 100755 --- a/basis/compiler/tree/cleanup/cleanup-tests.factor +++ b/basis/compiler/tree/cleanup/cleanup-tests.factor @@ -510,3 +510,8 @@ cell-bits 32 = [ [ { array } declare 2 [ . . ] assoc-each ] \ nth-unsafe inlined? ] unit-test + +[ t ] [ + [ { fixnum fixnum } declare = ] + \ both-fixnums? inlined? +] unit-test \ No newline at end of file diff --git a/basis/compiler/tree/propagation/known-words/known-words.factor b/basis/compiler/tree/propagation/known-words/known-words.factor index d5aa5318a4..ecfd415579 100644 --- a/basis/compiler/tree/propagation/known-words/known-words.factor +++ b/basis/compiler/tree/propagation/known-words/known-words.factor @@ -199,8 +199,11 @@ generic-comparison-ops [ ] "outputs" set-word-prop \ both-fixnums? [ - [ class>> fixnum classes-intersect? not ] either? - f object-info ? + [ class>> ] bi@ { + { [ 2dup [ fixnum classes-intersect? not ] either? ] [ f ] } + { [ 2dup [ fixnum class<= ] both? ] [ t ] } + [ object-info ] + } cond 2nip ] "outputs" set-word-prop { diff --git a/basis/editors/editpadlite/editpadlite.factor b/basis/editors/editpadlite/editpadlite.factor index d487ca776f..043ef7ef27 100644 --- a/basis/editors/editpadlite/editpadlite.factor +++ b/basis/editors/editpadlite/editpadlite.factor @@ -5,7 +5,7 @@ IN: editors.editpadlite : editpadlite-path ( -- path ) \ editpadlite-path get-global [ - "JGsoft" t [ >lower "editpadlite.exe" tail? ] find-in-program-files + "JGsoft" [ >lower "editpadlite.exe" tail? ] find-in-program-files [ "editpadlite.exe" ] unless* ] unless* ; diff --git a/basis/editors/editpadpro/editpadpro.factor b/basis/editors/editpadpro/editpadpro.factor index 09bfd69de8..571c20fd6a 100644 --- a/basis/editors/editpadpro/editpadpro.factor +++ b/basis/editors/editpadpro/editpadpro.factor @@ -5,7 +5,7 @@ IN: editors.editpadpro : editpadpro-path ( -- path ) \ editpadpro-path get-global [ - "JGsoft" t [ >lower "editpadpro.exe" tail? ] find-in-program-files + "JGsoft" [ >lower "editpadpro.exe" tail? ] find-in-program-files [ "editpadpro.exe" ] unless* ] unless* ; diff --git a/basis/editors/editplus/editplus.factor b/basis/editors/editplus/editplus.factor index affbcd4eb6..a3150dc961 100644 --- a/basis/editors/editplus/editplus.factor +++ b/basis/editors/editplus/editplus.factor @@ -5,7 +5,7 @@ IN: editors.editplus : editplus-path ( -- path ) \ editplus-path get-global [ - "EditPlus 2" t [ "editplus.exe" tail? ] find-in-program-files + "EditPlus 2" [ "editplus.exe" tail? ] find-in-program-files [ "editplus.exe" ] unless* ] unless* ; diff --git a/basis/editors/emacs/emacs.factor b/basis/editors/emacs/emacs.factor index 05b879770e..366bc53104 100644 --- a/basis/editors/emacs/emacs.factor +++ b/basis/editors/emacs/emacs.factor @@ -11,7 +11,7 @@ M: object default-emacsclient ( -- path ) "emacsclient" ; : emacsclient ( file line -- ) [ - { [ \ emacsclient-path get ] [ default-emacsclient ] } 0|| , + { [ emacsclient-path get ] [ default-emacsclient ] } 0|| , "--no-wait" , number>string "+" prepend , , diff --git a/basis/editors/emacs/windows/windows.factor b/basis/editors/emacs/windows/windows.factor index e18c39ed60..91d6e878e4 100755 --- a/basis/editors/emacs/windows/windows.factor +++ b/basis/editors/emacs/windows/windows.factor @@ -6,7 +6,7 @@ IN: editors.emacs.windows M: windows default-emacsclient { - [ "Emacs" t [ "emacsclientw.exe" tail? ] find-in-program-files ] - [ "Emacs" t [ "emacsclient.exe" tail? ] find-in-program-files ] + [ "Emacs" [ "emacsclientw.exe" tail? ] find-in-program-files ] + [ "Emacs" [ "emacsclient.exe" tail? ] find-in-program-files ] [ "emacsclient.exe" ] } 0|| ; diff --git a/basis/editors/emeditor/emeditor.factor b/basis/editors/emeditor/emeditor.factor index 52c52bbb8b..3380f5c974 100644 --- a/basis/editors/emeditor/emeditor.factor +++ b/basis/editors/emeditor/emeditor.factor @@ -5,7 +5,7 @@ IN: editors.emeditor : emeditor-path ( -- path ) \ emeditor-path get-global [ - "EmEditor" t [ "EmEditor.exe" tail? ] find-in-program-files + "EmEditor" [ "EmEditor.exe" tail? ] find-in-program-files [ "EmEditor.exe" ] unless* ] unless* ; diff --git a/basis/editors/etexteditor/etexteditor.factor b/basis/editors/etexteditor/etexteditor.factor index 37c8d1b572..8b76b3b473 100755 --- a/basis/editors/etexteditor/etexteditor.factor +++ b/basis/editors/etexteditor/etexteditor.factor @@ -6,7 +6,7 @@ IN: editors.etexteditor : etexteditor-path ( -- str ) \ etexteditor-path get-global [ - "e" t [ "e.exe" tail? ] find-in-program-files + "e" [ "e.exe" tail? ] find-in-program-files [ "e" ] unless* ] unless* ; diff --git a/basis/editors/gvim/windows/windows.factor b/basis/editors/gvim/windows/windows.factor index 4edc13b90c..3fe228a403 100644 --- a/basis/editors/gvim/windows/windows.factor +++ b/basis/editors/gvim/windows/windows.factor @@ -5,6 +5,6 @@ IN: editors.gvim.windows M: windows gvim-path \ gvim-path get-global [ - "vim" t [ "gvim.exe" tail? ] find-in-program-files + "vim" [ "gvim.exe" tail? ] find-in-program-files [ "gvim.exe" ] unless* ] unless* ; diff --git a/basis/editors/notepadpp/notepadpp.factor b/basis/editors/notepadpp/notepadpp.factor index 1c856bd761..7b0f2bb72a 100644 --- a/basis/editors/notepadpp/notepadpp.factor +++ b/basis/editors/notepadpp/notepadpp.factor @@ -4,7 +4,7 @@ IN: editors.notepadpp : notepadpp-path ( -- path ) \ notepadpp-path get-global [ - "notepad++" t [ "notepad++.exe" tail? ] find-in-program-files + "notepad++" [ "notepad++.exe" tail? ] find-in-program-files [ "notepad++.exe" ] unless* ] unless* ; diff --git a/basis/editors/scite/scite.factor b/basis/editors/scite/scite.factor index fc7e9e319e..7e8a540b73 100644 --- a/basis/editors/scite/scite.factor +++ b/basis/editors/scite/scite.factor @@ -7,11 +7,11 @@ IN: editors.scite : scite-path ( -- path ) \ scite-path get-global [ - "Scintilla Text Editor" t + "Scintilla Text Editor" [ >lower "scite.exe" tail? ] find-in-program-files [ - "SciTE Source Code Editor" t + "SciTE Source Code Editor" [ >lower "scite.exe" tail? ] find-in-program-files ] unless* [ "scite.exe" ] unless* diff --git a/basis/editors/ted-notepad/ted-notepad.factor b/basis/editors/ted-notepad/ted-notepad.factor index 301e82225c..6f954febe8 100644 --- a/basis/editors/ted-notepad/ted-notepad.factor +++ b/basis/editors/ted-notepad/ted-notepad.factor @@ -4,7 +4,7 @@ IN: editors.ted-notepad : ted-notepad-path ( -- path ) \ ted-notepad-path get-global [ - "TED Notepad" t [ "TedNPad.exe" tail? ] find-in-program-files + "TED Notepad" [ "TedNPad.exe" tail? ] find-in-program-files [ "TedNPad.exe" ] unless* ] unless* ; diff --git a/basis/editors/textpad/textpad.factor b/basis/editors/textpad/textpad.factor index ca9d5c486a..925f75400f 100644 --- a/basis/editors/textpad/textpad.factor +++ b/basis/editors/textpad/textpad.factor @@ -5,7 +5,7 @@ IN: editors.textpad : textpad-path ( -- path ) \ textpad-path get-global [ - "TextPad 5" t [ "TextPad.exe" tail? ] find-in-program-files + "TextPad 5" [ "TextPad.exe" tail? ] find-in-program-files [ "TextPad.exe" ] unless* ] unless* ; diff --git a/basis/editors/ultraedit/ultraedit.factor b/basis/editors/ultraedit/ultraedit.factor index b5bc229743..3069d78925 100644 --- a/basis/editors/ultraedit/ultraedit.factor +++ b/basis/editors/ultraedit/ultraedit.factor @@ -4,7 +4,7 @@ IN: editors.ultraedit : ultraedit-path ( -- path ) \ ultraedit-path get-global [ - "IDM Computer Solutions" t [ "uedit32.exe" tail? ] find-in-program-files + "IDM Computer Solutions" [ "uedit32.exe" tail? ] find-in-program-files [ "uedit32.exe" ] unless* ] unless* ; diff --git a/basis/editors/wordpad/wordpad.factor b/basis/editors/wordpad/wordpad.factor index ef670d5d28..103b69ba4c 100644 --- a/basis/editors/wordpad/wordpad.factor +++ b/basis/editors/wordpad/wordpad.factor @@ -4,7 +4,7 @@ IN: editors.wordpad : wordpad-path ( -- path ) \ wordpad-path get [ - "Windows NT\\Accessories" t + "Windows NT\\Accessories" [ "wordpad.exe" tail? ] find-in-program-files ] unless* ; diff --git a/basis/hints/hints.factor b/basis/hints/hints.factor index b6af773ce5..4093666eb7 100644 --- a/basis/hints/hints.factor +++ b/basis/hints/hints.factor @@ -96,8 +96,6 @@ M: object specializer-declaration class ; { string string } "specializer" set-word-prop -\ find-last-sep { string sbuf } "specializer" set-word-prop - \ >string { sbuf } "specializer" set-word-prop \ >array { { vector } } "specializer" set-word-prop diff --git a/basis/io/directories/search/search-docs.factor b/basis/io/directories/search/search-docs.factor index 99135b7953..818899606d 100644 --- a/basis/io/directories/search/search-docs.factor +++ b/basis/io/directories/search/search-docs.factor @@ -38,7 +38,7 @@ HELP: find-in-directories HELP: find-all-files { $values - { "path" "a pathname string" } { "bfs?" "a boolean, breadth-first or depth-first" } { "quot" quotation } + { "path" "a pathname string" } { "quot" quotation } { "paths/f" "a sequence of pathname strings or f" } } { $description "Finds all files in the input directory matching the predicate quotation in a breadth-first or depth-first traversal." } ; diff --git a/basis/io/directories/search/search-tests.factor b/basis/io/directories/search/search-tests.factor index a8b8bf9215..ba1b9cdbe1 100644 --- a/basis/io/directories/search/search-tests.factor +++ b/basis/io/directories/search/search-tests.factor @@ -5,6 +5,6 @@ IN: io.directories.search.tests [ t ] [ [ 10 [ "io.paths.test" "gogogo" make-unique-file ] replicate - current-temporary-directory get t [ ] find-all-files + current-temporary-directory get [ ] find-all-files ] with-unique-directory drop [ natural-sort ] bi@ = ] unit-test diff --git a/basis/io/directories/search/search.factor b/basis/io/directories/search/search.factor index b56fb7b6a3..ee8fd129a7 100755 --- a/basis/io/directories/search/search.factor +++ b/basis/io/directories/search/search.factor @@ -51,7 +51,8 @@ PRIVATE> [ keep and ] curry iterate-directory ] [ drop f ] recover ; inline -: find-all-files ( path bfs? quot: ( obj -- ? ) -- paths/f ) +: find-all-files ( path quot: ( obj -- ? ) -- paths/f ) + f swap '[ _ _ _ [ ] dip pusher [ [ f ] compose iterate-directory drop ] dip diff --git a/basis/io/directories/search/windows/windows.factor b/basis/io/directories/search/windows/windows.factor index 755710befd..cda9403417 100644 --- a/basis/io/directories/search/windows/windows.factor +++ b/basis/io/directories/search/windows/windows.factor @@ -7,7 +7,7 @@ IN: io.directories.search.windows : program-files-directories ( -- array ) program-files program-files-x86 2array harvest ; inline -: find-in-program-files ( base-directory bfs? quot -- path ) - [ +: find-in-program-files ( base-directory quot -- path ) + t swap [ [ program-files-directories ] dip '[ _ append-path ] map ] 2dip find-in-directories ; inline diff --git a/basis/io/mmap/mmap-tests.factor b/basis/io/mmap/mmap-tests.factor index 166167a7e7..a4d55f3c1e 100644 --- a/basis/io/mmap/mmap-tests.factor +++ b/basis/io/mmap/mmap-tests.factor @@ -1,6 +1,6 @@ USING: io io.mmap io.mmap.char io.files io.files.temp io.directories kernel tools.test continuations sequences -io.encodings.ascii accessors ; +io.encodings.ascii accessors math ; IN: io.mmap.tests [ "mmap-test-file.txt" temp-file delete-file ] ignore-errors @@ -9,3 +9,13 @@ IN: io.mmap.tests [ 5 ] [ "mmap-test-file.txt" temp-file [ length ] with-mapped-char-file ] unit-test [ "22345" ] [ "mmap-test-file.txt" temp-file ascii file-contents ] unit-test [ "mmap-test-file.txt" temp-file delete-file ] ignore-errors + + +[ "mmap-empty-file.txt" temp-file delete-file ] ignore-errors +[ ] [ "mmap-empty-file.txt" temp-file touch-file ] unit-test + +[ + "mmap-empty-file.txt" temp-file [ + drop + ] with-mapped-file +] [ bad-mmap-size? ] must-fail-with diff --git a/basis/io/mmap/mmap.factor b/basis/io/mmap/mmap.factor index 6f2fabb709..1a58471514 100644 --- a/basis/io/mmap/mmap.factor +++ b/basis/io/mmap/mmap.factor @@ -2,15 +2,20 @@ ! See http://factorcode.org/license.txt for BSD license. USING: continuations destructors io.files io.files.info io.backend kernel quotations system alien alien.accessors -accessors system vocabs.loader combinators alien.c-types ; +accessors system vocabs.loader combinators alien.c-types +math ; IN: io.mmap TUPLE: mapped-file address handle length disposed ; HOOK: (mapped-file) os ( path length -- address handle ) +ERROR: bad-mmap-size path size ; + : ( path -- mmap ) - [ normalize-path ] [ file-info size>> ] bi [ (mapped-file) ] keep + [ normalize-path ] [ file-info size>> ] bi + dup 0 <= [ bad-mmap-size ] when + [ (mapped-file) ] keep f mapped-file boa ; HOOK: close-mapped-file io-backend ( mmap -- ) diff --git a/basis/io/mmap/unix/unix.factor b/basis/io/mmap/unix/unix.factor index 9325dcd632..0fa8e1151f 100644 --- a/basis/io/mmap/unix/unix.factor +++ b/basis/io/mmap/unix/unix.factor @@ -9,7 +9,7 @@ IN: io.mmap.unix :: mmap-open ( path length prot flags -- alien fd ) [ f length prot flags - path open-r/w |dispose + path open-r/w [ |dispose drop ] keep [ 0 mmap dup MAP_FAILED = [ (io-error) ] when ] keep ] with-destructors ; diff --git a/basis/io/streams/byte-array/byte-array.factor b/basis/io/streams/byte-array/byte-array.factor index 9d89c3d814..b877e97cf1 100644 --- a/basis/io/streams/byte-array/byte-array.factor +++ b/basis/io/streams/byte-array/byte-array.factor @@ -1,5 +1,8 @@ +! Copyright (C) 2008, 2009 Daniel Ehrenberg +! See http://factorcode.org/license.txt for BSD license. USING: byte-arrays byte-vectors kernel io.encodings io.streams.string -sequences io namespaces io.encodings.private accessors ; +sequences io namespaces io.encodings.private accessors sequences.private +io.streams.sequence destructors ; IN: io.streams.byte-array : ( encoding -- stream ) @@ -9,8 +12,16 @@ IN: io.streams.byte-array [ ] dip [ output-stream get ] compose with-output-stream* dup encoder? [ stream>> ] when >byte-array ; inline +TUPLE: byte-reader { underlying byte-array read-only } { i array-capacity } ; + +M: byte-reader stream-read-partial stream-read ; +M: byte-reader stream-read sequence-read ; +M: byte-reader stream-read1 sequence-read1 ; +M: byte-reader stream-read-until sequence-read-until ; +M: byte-reader dispose drop ; + : ( byte-array encoding -- stream ) - [ >byte-vector dup reverse-here ] dip ; + [ B{ } like 0 byte-reader boa ] dip ; : with-byte-reader ( byte-array encoding quot -- ) [ ] dip with-input-stream* ; inline diff --git a/basis/stack-checker/errors/errors.factor b/basis/stack-checker/errors/errors.factor index 6a9a7cb8af..7f35ece714 100644 --- a/basis/stack-checker/errors/errors.factor +++ b/basis/stack-checker/errors/errors.factor @@ -80,4 +80,4 @@ TUPLE: inconsistent-recursive-call-error word ; TUPLE: unknown-primitive-error ; : unknown-primitive-error ( -- * ) - \ unknown-primitive-error inference-error ; + \ unknown-primitive-error inference-warning ; diff --git a/basis/stack-checker/known-words/known-words.factor b/basis/stack-checker/known-words/known-words.factor index 0c20c41d99..1b4d9012db 100644 --- a/basis/stack-checker/known-words/known-words.factor +++ b/basis/stack-checker/known-words/known-words.factor @@ -141,9 +141,7 @@ M: object infer-call* apply-word/effect ; : infer-exit ( -- ) - \ exit - { integer } { } t >>terminated? - apply-word/effect ; + \ exit (( n -- * )) apply-word/effect ; : infer-load-locals ( -- ) pop-literal nip @@ -189,7 +187,7 @@ M: object infer-call* { \ load-locals [ infer-load-locals ] } { \ get-local [ infer-get-local ] } { \ drop-locals [ infer-drop-locals ] } - { \ do-primitive [ unknown-primitive-error inference-warning ] } + { \ do-primitive [ unknown-primitive-error ] } { \ alien-invoke [ infer-alien-invoke ] } { \ alien-indirect [ infer-alien-indirect ] } { \ alien-callback [ infer-alien-callback ] } @@ -207,7 +205,7 @@ M: object infer-call* { declare call (call) slip 2slip 3slip dip 2dip 3dip curry compose execute (execute) if dispatch - (throw) load-local load-locals get-local drop-locals do-primitive + (throw) exit load-local load-locals get-local drop-locals do-primitive alien-invoke alien-indirect alien-callback } [ t "special" set-word-prop ] each diff --git a/basis/stack-checker/stack-checker-docs.factor b/basis/stack-checker/stack-checker-docs.factor index db8abac441..088fab34d0 100644 --- a/basis/stack-checker/stack-checker-docs.factor +++ b/basis/stack-checker/stack-checker-docs.factor @@ -21,7 +21,7 @@ $nl ARTICLE: "inference-combinators" "Combinator stack effects" "Without further information, one cannot say what the stack effect of " { $link call } " is; it depends on the given quotation. If the inferencer encounters a " { $link call } " without further information, a " { $link literal-expected } " error is raised." -{ $example "[ dup call ] infer." "Literal value expected\n\nType :help for debugging help." } +{ $example "[ dup call ] infer." "Got a computed value where a literal quotation was expected\n\nType :help for debugging help." } "On the other hand, the stack effect of applying " { $link call } " to a literal quotation or a " { $link curry } " of a literal quotation is easy to compute; it behaves as if the quotation was substituted at that point:" { $example "[ [ 2 + ] call ] infer." "( object -- object )" } "Consider a combinator such as " { $link keep } ". The combinator itself does not have a stack effect, because it applies " { $link call } " to a potentially arbitrary quotation. However, since the combinator is declared " { $link POSTPONE: inline } ", a given usage of it can have a stack effect:" @@ -38,7 +38,7 @@ $nl { $example ": foo 0 [ + ] ; inline" "[ foo reduce ] infer." "( object -- object )" } "Passing a literal quotation on the data stack through an inlined recursive combinator nullifies its literal status. For example, the following will not infer:" { $example - "[ [ reverse ] swap [ reverse ] map swap call ] infer." "Literal value expected\n\nType :help for debugging help." + "[ [ reverse ] swap [ reverse ] map swap call ] infer." "Got a computed value where a literal quotation was expected\n\nType :help for debugging help." } "To make this work, pass the quotation on the retain stack instead:" { $example @@ -67,11 +67,11 @@ $nl "If a recursive word takes quotation parameters from the stack and calls them, it must be declared " { $link POSTPONE: inline } " (as documented in " { $link "inference-combinators" } ") as well as " { $link POSTPONE: recursive } "." $nl "Furthermore, the input parameters which are quotations must be annotated in the stack effect. For example, the following will not infer:" -{ $example ": bad ( quot -- ) [ call ] keep foo ; inline recursive" "[ [ ] bad ] infer." "Literal value expected\n\nType :help for debugging help." } +{ $example ": bad ( quot -- ) [ call ] keep foo ; inline recursive" "[ [ ] bad ] infer." "Got a computed value where a literal quotation was expected\n\nType :help for debugging help." } "The following is correct:" { $example ": good ( quot: ( -- ) -- ) [ call ] keep good ; inline recursive" "[ [ ] good ] infer." "( -- )" } "An inline recursive word cannot pass a quotation on the data stack through the recursive call. For example, the following will not infer:" -{ $example ": bad ( ? quot: ( ? -- ) -- ) 2dup [ not ] dip bad call ; inline recursive" "[ [ drop ] bad ] infer." "Literal value expected\n\nType :help for debugging help." } +{ $example ": bad ( ? quot: ( ? -- ) -- ) 2dup [ not ] dip bad call ; inline recursive" "[ [ drop ] bad ] infer." "Got a computed value where a literal quotation was expected\n\nType :help for debugging help." } "However a small change can be made:" { $example ": good ( ? quot: ( ? -- ) -- ) [ good ] 2keep [ not ] dip call ; inline recursive" "[ [ drop ] good ] infer." "( object -- )" } "An inline recursive word must have a fixed stack effect in its base case. The following will not infer:" diff --git a/basis/stack-checker/stack-checker-tests.factor b/basis/stack-checker/stack-checker-tests.factor index bc6eb9f092..fadfadd885 100644 --- a/basis/stack-checker/stack-checker-tests.factor +++ b/basis/stack-checker/stack-checker-tests.factor @@ -6,7 +6,8 @@ quotations effects tools.test continuations generic.standard sorting assocs definitions prettyprint io inspector classes.tuple classes.union classes.predicate debugger threads.private io.streams.string io.timeouts io.thread -sequences.private destructors combinators eval locals.backend ; +sequences.private destructors combinators eval locals.backend +system ; IN: stack-checker.tests \ infer. must-infer @@ -581,4 +582,6 @@ DEFER: eee' : debugging-curry-folding ( quot -- ) [ debugging-curry-folding ] curry call ; inline recursive -[ [ ] debugging-curry-folding ] must-infer \ No newline at end of file +[ [ ] debugging-curry-folding ] must-infer + +[ [ exit ] [ 1 2 3 ] if ] must-infer \ No newline at end of file diff --git a/build-support/cleanup b/build-support/cleanup new file mode 100644 index 0000000000..2d2aab0bba --- /dev/null +++ b/build-support/cleanup @@ -0,0 +1,8 @@ +vm +temp +logs +.git +.gitignore +Makefile +unmaintained +build-support diff --git a/core/checksums/crc32/crc32.factor b/core/checksums/crc32/crc32.factor index 7ea2964411..47da144d4d 100644 --- a/core/checksums/crc32/crc32.factor +++ b/core/checksums/crc32/crc32.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2006 Doug Coleman ! See http://factorcode.org/license.txt for BSD license. USING: kernel math sequences sequences.private namespaces -words io io.binary io.files io.streams.string quotations +words io io.binary io.files quotations definitions checksums ; IN: checksums.crc32 diff --git a/core/io/streams/sequence/sequence.factor b/core/io/streams/sequence/sequence.factor new file mode 100644 index 0000000000..bbb3576c05 --- /dev/null +++ b/core/io/streams/sequence/sequence.factor @@ -0,0 +1,38 @@ +! Copyright (C) 2009 Daniel Ehrenberg +! See http://factorcode.org/license.txt for BSD license. +USING: sequences io kernel accessors math math.order ; +IN: io.streams.sequence + +SLOT: underlying +SLOT: i + +: >sequence-stream< ( stream -- i underlying ) + [ i>> ] [ underlying>> ] bi ; inline + +: next ( stream -- ) + [ 1+ ] change-i drop ; + +: sequence-read1 ( stream -- elt/f ) + [ >sequence-stream< ?nth ] + [ next ] bi ; inline + +: add-length ( n stream -- i+n ) + [ i>> + ] [ underlying>> length ] bi min ; + +: (sequence-read) ( n stream -- seq/f ) + [ add-length ] keep + [ [ swap dup ] change-i drop ] + [ underlying>> ] bi + subseq ; inline + +: sequence-read ( n stream -- seq/f ) + dup >sequence-stream< bounds-check? + [ (sequence-read) ] [ 2drop f ] if ; inline + +: find-sep ( seps stream -- sep/f n ) + swap [ >sequence-stream< ] dip + [ memq? ] curry find-from swap ; inline + +: sequence-read-until ( separators stream -- seq sep/f ) + [ find-sep ] keep + [ sequence-read ] [ next ] bi swap ; inline diff --git a/core/io/streams/string/string-tests.factor b/core/io/streams/string/string-tests.factor index a6502046c8..967c0d4613 100644 --- a/core/io/streams/string/string-tests.factor +++ b/core/io/streams/string/string-tests.factor @@ -15,12 +15,12 @@ unit-test [ "xyzzy" ] [ [ "xyzzy" write ] with-string-writer ] unit-test -[ "a" ] [ 1 SBUF" cba" stream-read ] unit-test -[ "ab" ] [ 2 SBUF" cba" stream-read ] unit-test -[ "abc" ] [ 3 SBUF" cba" stream-read ] unit-test -[ "abc" ] [ 4 SBUF" cba" stream-read ] unit-test +[ "a" ] [ 1 "abc" stream-read ] unit-test +[ "ab" ] [ 2 "abc" stream-read ] unit-test +[ "abc" ] [ 3 "abc" stream-read ] unit-test +[ "abc" ] [ 4 "abc" stream-read ] unit-test [ "abc" f ] [ - 3 SBUF" cba" [ stream-read ] keep stream-read1 + 3 "abc" [ stream-read ] keep stream-read1 ] unit-test [ diff --git a/core/io/streams/string/string.factor b/core/io/streams/string/string.factor index 4582490726..73bf5f5efe 100644 --- a/core/io/streams/string/string.factor +++ b/core/io/streams/string/string.factor @@ -1,18 +1,12 @@ -! Copyright (C) 2003, 2009 Slava Pestov. +! Copyright (C) 2003, 2009 Slava Pestov, Daniel Ehrenberg. ! See http://factorcode.org/license.txt for BSD license. USING: accessors io kernel math namespaces sequences sbufs -strings generic splitting continuations destructors -io.streams.plain io.encodings math.order growable ; +strings generic splitting continuations destructors sequences.private +io.streams.plain io.encodings math.order growable io.streams.sequence ; IN: io.streams.string > like ; - -: growable-read-until ( growable n -- str ) - >fixnum dupd tail-slice swap harden-as dup reverse-here ; - SINGLETON: null-encoding M: null-encoding decode-char drop stream-read1 ; @@ -32,34 +26,18 @@ M: growable stream-flush drop ; swap [ output-stream get ] compose with-output-stream* >string ; inline -M: growable stream-read1 [ f ] [ pop ] if-empty ; +! New implementation -: find-last-sep ( seq seps -- n ) - swap [ memq? ] curry find-last drop ; +TUPLE: string-reader { underlying string read-only } { i array-capacity } ; -M: growable stream-read-until - [ find-last-sep ] keep over [ - [ swap 1+ growable-read-until ] 2keep [ nth ] 2keep - set-length - ] [ - [ swap drop 0 growable-read-until f like f ] keep - delete-all - ] if ; - -M: growable stream-read - [ - drop f - ] [ - [ length swap - 0 max ] keep - [ swap growable-read-until ] 2keep - set-length - ] if-empty ; - -M: growable stream-read-partial - stream-read ; +M: string-reader stream-read-partial stream-read ; +M: string-reader stream-read sequence-read ; +M: string-reader stream-read1 sequence-read1 ; +M: string-reader stream-read-until sequence-read-until ; +M: string-reader dispose drop ; : ( str -- stream ) - >sbuf dup reverse-here null-encoding ; + 0 string-reader boa null-encoding ; : with-string-reader ( str quot -- ) [ ] dip with-input-stream ; inline diff --git a/core/math/math-docs.factor b/core/math/math-docs.factor index 94ff2c1f29..101557d0cf 100644 --- a/core/math/math-docs.factor +++ b/core/math/math-docs.factor @@ -308,7 +308,7 @@ HELP: find-last-integer HELP: byte-array>bignum { $values { "byte-array" byte-array } { "n" integer } } -{ $description "Converts a byte-array, interpreted as little-endian, into a bignum integer. User code should call " { $link >le } " or " { $link >be } " instead." } ; +{ $description "Converts a byte-array, interpreted as little-endian, into a bignum integer. User code should call " { $link le> } " or " { $link be> } " instead." } ; ARTICLE: "division-by-zero" "Division by zero" "Floating point division never raises an error if the denominator is zero. This means that if at least one of the two inputs to " { $link / } ", " { $link /f } " or " { $link mod } " is a float, the result will be a floating point infinity or not a number value." diff --git a/extra/id3/authors.txt b/extra/id3/authors.txt index ece617b969..2bd5c6037e 100644 --- a/extra/id3/authors.txt +++ b/extra/id3/authors.txt @@ -1,2 +1,2 @@ Tim Wawrzynczak - +Doug Coleman diff --git a/extra/id3/id3-docs.factor b/extra/id3/id3-docs.factor index a54bba1629..d171d03798 100644 --- a/extra/id3/id3-docs.factor +++ b/extra/id3/id3-docs.factor @@ -6,7 +6,7 @@ IN: id3 HELP: file-id3-tags { $values { "path" "a path string" } - { "object/f" "a tuple storing ID3 metadata or f" } } + { "id3v2-info/f" "a tuple storing ID3v2 metadata or f" } } { $description "Return a tuple containing the ID3 information parsed out of the MP3 file, or " { $link f } " if no metadata is present. Currently, the parser supports the following tags: " $nl { $link title>> } $nl { $link artist>> } diff --git a/extra/id3/id3-tests.factor b/extra/id3/id3-tests.factor index bcdc312440..aefbec8550 100644 --- a/extra/id3/id3-tests.factor +++ b/extra/id3/id3-tests.factor @@ -1,35 +1,42 @@ ! Copyright (C) 2009 Tim Wawrzynczak ! See http://factorcode.org/license.txt for BSD license. -USING: tools.test id3 id3.private ; +USING: tools.test id3 combinators ; IN: id3.tests -[ - T{ id3-info - { title "BLAH" } - { artist "ARTIST" } - { album "ALBUM" } - { year "2009" } - { comment "COMMENT" } - { genre "Bluegrass" } - } -] [ "resource:extra/id3/tests/blah.mp3" file-id3-tags ] unit-test +: id3-params ( id3 -- title artist album year comment genre ) + { + [ id3-title ] + [ id3-artist ] + [ id3-album ] + [ id3-year ] + [ id3-comment ] + [ id3-genre ] + } cleave ; [ - T{ id3-info - { title "Anthem of the Trinity" } - { artist "Terry Riley" } - { album "Shri Camel" } - { genre "Classical" } - } -] [ "resource:extra/id3/tests/blah2.mp3" file-id3-tags ] unit-test + "BLAH" + "ARTIST" + "ALBUM" + "2009" + "COMMENT" + "Bluegrass" +] [ "vocab:id3/tests/blah.mp3" file-id3-tags id3-params ] unit-test + +[ + "Anthem of the Trinity" + "Terry Riley" + "Shri Camel" + f + f + "Classical" +] [ "vocab:id3/tests/blah2.mp3" file-id3-tags id3-params ] unit-test [ - T{ id3-info - { title "Stormy Weather" } - { artist "Frank Sinatra" } - { album "Night and Day Frank Sinatra" } - { comment "eng, AG# 08E1C12E" } - { genre "Big Band" } - } -] [ "resource:extra/id3/tests/blah3.mp3" file-id3-tags ] unit-test + "Stormy Weather" + "Frank Sinatra" + "Night and Day Frank Sinatra" + f + "eng, AG# 08E1C12E" + "Big Band" +] [ "vocab:id3/tests/blah3.mp3" file-id3-tags id3-params ] unit-test diff --git a/extra/id3/id3.factor b/extra/id3/id3.factor index f2bbd08996..d1397285d7 100644 --- a/extra/id3/id3.factor +++ b/extra/id3/id3.factor @@ -1,142 +1,43 @@ -! Copyright (C) 2009 Tim Wawrzynczak +! Copyright (C) 2009 Tim Wawrzynczak, Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: sequences io io.encodings.binary io.files io.pathnames strings kernel math io.mmap io.mmap.uchar accessors syntax combinators math.ranges unicode.categories byte-arrays io.encodings.string io.encodings.utf8 assocs math.parser ; +USING: sequences io io.encodings.binary io.files io.pathnames +strings kernel math io.mmap io.mmap.uchar accessors syntax +combinators math.ranges unicode.categories byte-arrays +io.encodings.string io.encodings.utf16 assocs math.parser +combinators.short-circuit fry namespaces combinators.smart +splitting io.encodings.ascii arrays ; IN: id3 ( -- object ) id3-info new ; +: ( -- object ) id3v1-info new ; -: ( header frames -- object ) id3v2-info boa ; +: ( header frames -- object ) + [ [ frame-id>> ] keep ] H{ } map>assoc + id3v2-info boa ; :
( -- object ) header new ; : ( -- object ) frame new ; -! utility words - -: id3v2? ( mmap -- ? ) - "ID3" head? ; +: id3v2? ( mmap -- ? ) "ID3" head? ; inline : id3v1? ( mmap -- ? ) - 128 tail-slice* "TAG" head? ; + { [ length 128 >= ] [ 128 tail-slice* "TAG" head? ] } 1&& ; inline + +: id3v1-frame ( string key -- frame ) + + swap >>frame-id + swap >>data ; + +: id3v1>id3v2 ( id3v1 -- id3v2 ) + [ + { + [ title>> "TIT2" id3v1-frame ] + [ artist>> "TPE1" id3v1-frame ] + [ album>> "TALB" id3v1-frame ] + [ year>> "TYER" id3v1-frame ] + [ comment>> "COMM" id3v1-frame ] + [ genre>> "TCON" id3v1-frame ] + } cleave + ] output>array f swap ; : >28bitword ( seq -- int ) - 0 [ swap 7 shift bitor ] reduce ; + 0 [ [ 7 shift ] dip bitor ] reduce ; inline : filter-text-data ( data -- filtered ) - [ printable? ] filter ; - -! frame details stuff + [ printable? ] filter ; inline : valid-frame-id? ( id -- ? ) - [ [ digit? ] [ LETTER? ] bi or ] all? ; - -: read-frame-id ( mmap -- id ) - 4 head-slice ; - -: read-frame-size ( mmap -- size ) - [ 4 8 ] dip subseq ; - -: read-frame-flags ( mmap -- flags ) - [ 8 10 ] dip subseq ; + [ { [ digit? ] [ LETTER? ] } 1|| ] all? ; inline : read-frame-data ( frame mmap -- frame data ) - [ 10 over size>> 10 + ] dip filter-text-data ; + [ 10 over size>> 10 + ] dip filter-text-data ; inline -! read whole frames +: decode-text ( string -- string' ) + dup 2 short head + { { HEX: ff HEX: fe } { HEX: fe HEX: ff } } member? + utf16 ascii ? decode ; inline : (read-frame) ( mmap -- frame ) [ ] dip { - [ read-frame-id utf8 decode >>frame-id ] - [ read-frame-flags >byte-array >>flags ] - [ read-frame-size >28bitword >>size ] - [ read-frame-data utf8 decode >>data ] + [ 4 head-slice decode-text >>frame-id ] + [ [ 4 8 ] dip subseq >28bitword >>size ] + [ [ 8 10 ] dip subseq >byte-array >>flags ] + [ read-frame-data decode-text >>data ] } cleave ; : read-frame ( mmap -- frame/f ) - dup read-frame-id valid-frame-id? [ (read-frame) ] [ drop f ] if ; + dup 4 head-slice valid-frame-id? + [ (read-frame) ] [ drop f ] if ; : remove-frame ( mmap frame -- mmap ) - size>> 10 + tail-slice ; + size>> 10 + tail-slice ; inline : read-frames ( mmap -- frames ) [ dup read-frame dup ] @@ -209,89 +119,71 @@ TUPLE: id3-info title artist album year comment genre ; ! header stuff -: read-header-supported-version? ( mmap -- ? ) - 3 tail-slice [ { 4 } head? ] [ { 3 } head? ] bi or ; - -: read-header-flags ( mmap -- flags ) - 5 swap nth ; - -: read-header-size ( mmap -- size ) - [ 6 10 ] dip >28bitword ; - -: read-v2-header ( mmap -- id3header ) +: read-v2-header ( seq -- id3header ) [
] dip { - [ read-header-supported-version? >>version ] - [ read-header-flags >>flags ] - [ read-header-size >>size ] - } cleave ; + [ [ 3 5 ] dip >array >>version ] + [ [ 5 ] dip nth >>flags ] + [ [ 6 10 ] dip >28bitword >>size ] + } cleave ; inline -: drop-header ( mmap -- seq1 seq2 ) - dup 10 tail-slice swap ; - -: parse-frames ( id3v2-info -- id3-info ) - [ ] dip frames>> - { - [ [ frame-id>> "TIT2" = ] find nip [ data>> >>title ] when* ] - [ [ frame-id>> "TALB" = ] find nip [ data>> >>album ] when* ] - [ [ frame-id>> "TPE1" = ] find nip [ data>> >>artist ] when* ] - [ [ frame-id>> "TCON" = ] find nip [ data>> [ [ digit? ] filter string>number ] keep swap [ genres at nip ] when* - >>genre ] when* ] - [ [ frame-id>> "COMM" = ] find nip [ data>> >>comment ] when* ] - [ [ frame-id>> "TYER" = ] find nip [ data>> >>year ] when* ] - } cleave ; - -: read-v2-tag-data ( seq -- id3-info ) - drop-header read-v2-header swap read-frames parse-frames ; +: read-v2-tag-data ( seq -- id3v2-info ) + 10 cut-slice + [ read-v2-header ] + [ read-frames ] bi* ; inline ! v1 information -: skip-to-v1-data ( seq -- seq ) - 125 tail-slice* ; - -: read-title ( seq -- title ) - 30 head-slice ; - -: read-artist ( seq -- title ) - [ 30 60 ] dip subseq ; - -: read-album ( seq -- album ) - [ 60 90 ] dip subseq ; - -: read-year ( seq -- year ) - [ 90 94 ] dip subseq ; - -: read-comment ( seq -- comment ) - [ 94 124 ] dip subseq ; - -: read-genre ( seq -- genre ) - [ 124 ] dip nth ; +: skip-to-v1-data ( seq -- seq ) 125 tail-slice* ; inline : (read-v1-tag-data) ( seq -- mp3-file ) - [ ] dip + [ ] dip { - [ read-title utf8 decode filter-text-data >>title ] - [ read-artist utf8 decode filter-text-data >>artist ] - [ read-album utf8 decode filter-text-data >>album ] - [ read-year utf8 decode filter-text-data >>year ] - [ read-comment utf8 decode filter-text-data >>comment ] - [ read-genre >fixnum genres at >>genre ] - } cleave ; + [ 30 head-slice decode-text filter-text-data >>title ] + [ [ 30 60 ] dip subseq decode-text filter-text-data >>artist ] + [ [ 60 90 ] dip subseq decode-text filter-text-data >>album ] + [ [ 90 94 ] dip subseq decode-text filter-text-data >>year ] + [ [ 94 124 ] dip subseq decode-text filter-text-data >>comment ] + [ [ 124 ] dip nth number>string >>genre ] + } cleave ; inline : read-v1-tag-data ( seq -- mp3-file ) - skip-to-v1-data (read-v1-tag-data) ; + skip-to-v1-data (read-v1-tag-data) ; inline + +: parse-genre ( string -- n/f ) + dup "(" ?head-slice drop ")" ?tail-slice drop + string>number dup number? [ + genres ?nth swap or + ] [ + drop + ] if ; inline PRIVATE> -! public interface +: frame-named ( id3 name quot -- obj ) + [ swap frames>> at* ] dip + [ data>> ] prepose [ drop f ] if ; inline -: file-id3-tags ( path -- object/f ) +: id3-title ( id3 -- title/f ) "TIT2" [ ] frame-named ; inline + +: id3-artist ( id3 -- artist/f ) "TPE1" [ ] frame-named ; inline + +: id3-album ( id3 -- album/f ) "TALB" [ ] frame-named ; inline + +: id3-year ( id3 -- year/f ) "TYER" [ ] frame-named ; inline + +: id3-comment ( id3 -- comment/f ) "COMM" [ ] frame-named ; inline + +: id3-genre ( id3 -- genre/f ) + "TCON" [ parse-genre ] frame-named ; inline + +: id3-frame ( id3 key -- value/f ) [ ] frame-named ; inline + +: file-id3-tags ( path -- id3v2-info/f ) [ { - { [ dup id3v2? ] [ read-v2-tag-data ] } ! ( ? -- id3v2 ) - { [ dup id3v1? ] [ read-v1-tag-data ] } ! ( ? -- id3-info ) - [ drop f ] ! ( mmap -- f ) + { [ dup id3v2? ] [ read-v2-tag-data ] } + { [ dup id3v1? ] [ read-v1-tag-data id3v1>id3v2 ] } + [ drop f ] } cond ] with-mapped-uchar-file ; - -! end