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

basis/compiler/tree/cleanup/cleanup-tests.factor

@@ -510,3 +510,8 @@ cell-bits 32 = [
     [ { array } declare 2 <groups> [ . . ] assoc-each ]
     \ nth-unsafe inlined?
 ] unit-test
+
+[ t ] [
+    [ { fixnum fixnum } declare = ]
+    \ both-fixnums? inlined?
+] unit-test

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?
+    [ class>> ] bi@ {
-    f <literal-info> object-info ?
+        { [ 2dup [ fixnum classes-intersect? not ] either? ] [ f <literal-info> ] }
+        { [ 2dup [ fixnum class<= ] both? ] [ t <literal-info> ] }
+        [ object-info ]
+    } cond 2nip
 ] "outputs" set-word-prop
 
 {

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* ;
 

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* ;
 

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* ;
 

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 ,
         ,

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" [ "emacsclientw.exe" tail? ] find-in-program-files ]
-        [ "Emacs" t [ "emacsclient.exe" tail? ] find-in-program-files ]
+        [ "Emacs" [ "emacsclient.exe" tail? ] find-in-program-files ]
         [ "emacsclient.exe" ]
     } 0|| ;

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* ;
 

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* ;
 

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* ;

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* ;
 

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*

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* ;
 

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* ;
 

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* ;
 

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* ;
 

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

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." } ;

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

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
     '[
         _ _ _ [ <directory-iterator> ] dip
         pusher [ [ f ] compose iterate-directory drop ] dip

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

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

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 ;
+
 : <mapped-file> ( 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 -- )

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 [ <fd> |dispose drop ] keep
         [ 0 mmap dup MAP_FAILED = [ (io-error) ] when ] keep
     ] with-destructors ;
 

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
 
 : <byte-writer> ( encoding -- stream )
@@ -9,8 +12,16 @@ IN: io.streams.byte-array
     [ <byte-writer> ] 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-reader> ( byte-array encoding -- stream )
-    [ >byte-vector dup reverse-here ] dip <decoder> ;
+    [ B{ } like 0 byte-reader boa ] dip <decoder> ;
 
 : with-byte-reader ( byte-array encoding quot -- )
     [ <byte-reader> ] dip with-input-stream* ; inline

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 ;

basis/stack-checker/known-words/known-words.factor

@@ -141,9 +141,7 @@ M: object infer-call*
     apply-word/effect ;
 
 : infer-exit ( -- )
-    \ exit
+    \ exit (( n -- * )) apply-word/effect ;
-    { integer } { } t >>terminated? <effect>
-    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 <tuple-boa>
-    (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
 

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:"

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
+[ [ ] debugging-curry-folding ] must-infer
+
+[ [ exit ] [ 1 2 3 ] if ] must-infer

build-support/cleanup

@@ -0,0 +1,8 @@
+vm
+temp
+logs
+.git
+.gitignore
+Makefile
+unmaintained
+build-support

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
 

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

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
+[ "a" ] [ 1 "abc" <string-reader> stream-read ] unit-test
-[ "ab" ] [ 2 SBUF" cba" stream-read ] unit-test
+[ "ab" ] [ 2 "abc" <string-reader> stream-read ] unit-test
-[ "abc" ] [ 3 SBUF" cba" stream-read ] unit-test
+[ "abc" ] [ 3 "abc" <string-reader> stream-read ] unit-test
-[ "abc" ] [ 4 SBUF" cba" stream-read ] unit-test
+[ "abc" ] [ 4 "abc" <string-reader> stream-read ] unit-test
 [ "abc" f ] [
-    3 SBUF" cba" [ stream-read ] keep stream-read1
+    3 "abc" <string-reader> [ stream-read ] keep stream-read1
 ] unit-test
 
 [

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
+strings generic splitting continuations destructors sequences.private
-io.streams.plain io.encodings math.order growable ;
+io.streams.plain io.encodings math.order growable io.streams.sequence ;
 IN: io.streams.string
 
 <PRIVATE
 
-: harden-as ( seq growble-exemplar -- newseq )
-    underlying>> 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 ;
     <string-writer> 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 )
+TUPLE: string-reader { underlying string read-only } { i array-capacity } ;
-    swap [ memq? ] curry find-last drop ;
 
-M: growable stream-read-until
+M: string-reader stream-read-partial stream-read ;
-    [ find-last-sep ] keep over [
+M: string-reader stream-read sequence-read ;
-        [ swap 1+ growable-read-until ] 2keep [ nth ] 2keep
+M: string-reader stream-read1 sequence-read1 ;
-        set-length
+M: string-reader stream-read-until sequence-read-until ;
-    ] [
+M: string-reader dispose drop ;
-        [ 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 ;
 
 : <string-reader> ( str -- stream )
-    >sbuf dup reverse-here null-encoding <decoder> ;
+    0 string-reader boa null-encoding <decoder> ;
 
 : with-string-reader ( str quot -- )
     [ <string-reader> ] dip with-input-stream ; inline

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."

extra/id3/authors.txt

@@ -1,2 +1,2 @@
 Tim Wawrzynczak
-
+Doug Coleman

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>> }

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
 
-[
+: id3-params ( id3 -- title artist album year comment genre )
-    T{ id3-info
+    {
-       { title "BLAH" }
+        [ id3-title ]
-       { artist "ARTIST" }
+        [ id3-artist ]
-       { album "ALBUM" }
+        [ id3-album ]
-       { year "2009" }
+        [ id3-year ]
-       { comment "COMMENT" }
+        [ id3-comment ]
-       { genre "Bluegrass" }
+        [ id3-genre ]
-    }
+    } cleave ;
-] [ "resource:extra/id3/tests/blah.mp3" file-id3-tags ] unit-test
 
 [
-    T{ id3-info
+   "BLAH"
-       { title "Anthem of the Trinity" }
+   "ARTIST"
-       { artist "Terry Riley" }
+   "ALBUM"
-       { album "Shri Camel" }
+   "2009"
-       { genre "Classical" }
+   "COMMENT"
-    }
+   "Bluegrass"
-] [ "resource:extra/id3/tests/blah2.mp3" file-id3-tags ] unit-test
+] [ "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
+   "Stormy Weather"
-       { title "Stormy Weather" }
+   "Frank Sinatra"
-       { artist "Frank Sinatra" }
+   "Night and Day Frank Sinatra"
-       { album "Night and Day Frank Sinatra" }
+    f
-       { comment "eng, AG# 08E1C12E" }
+   "eng, AG# 08E1C12E"
-       { genre "Big Band" }
+   "Big Band"
-    }
+] [ "vocab:id3/tests/blah3.mp3" file-id3-tags id3-params ] unit-test
-] [ "resource:extra/id3/tests/blah3.mp3" file-id3-tags ] unit-test
 

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
 
 <PRIVATE
 
-! genres
 CONSTANT: genres
-  H{
+    {
-    { 0 "Blues" }
+        "Blues" "Classic Rock" "Country" "Dance" "Disco" "Funk" 
-    { 1 "Classic Rock" }
+        "Grunge" "Hip-Hop" "Jazz" "Metal" "New Age" "Oldies" "Other" 
-    { 2 "Country" }
+        "Pop" "R&B" "Rap" "Reggae" "Rock" "Techno" "Industrial" 
-    { 3 "Dance" }
+        "Alternative" "Ska" "Death Metal" "Pranks" "Soundtrack" 
-    { 4 "Disco" }
+        "Euro-Techno" "Ambient" "Trip-Hop" "Vocal" "Jazz+Funk" 
-    { 5 "Funk" }
+        "Fusion" "Trance" "Classical" "Instrumental" "Acid" "House" 
-    { 6 "Grunge" }
+        "Game" "Sound Clip" "Gospel" "Noise" "AlternRock" "Bass" 
-    { 7 "Hip-Hop" }
+        "Soul" "Punk" "Space" "Meditative" "Instrumental Pop" 
-    { 8 "Jazz" }
+        "Instrumental Rock" "Ethnic" "Gothic" "Darkwave" 
-    { 9 "Metal" }
+        "Techno-Industrial" "Electronic" "Pop-Folk" "Eurodance" 
-    { 10 "New Age" }
+        "Dream" "Southern Rock" "Comedy" "Cult" "Gangsta" "Top 40" 
-    { 11 "Oldies" }
+        "Christian Rap" "Pop/Funk" "Jungle" "Native American" 
-    { 12 "Other" }
+        "Cabaret" "New Wave" "Psychedelic" "Rave" "Showtunes" 
-    { 13 "Pop" }
+        "Trailer" "Lo-Fi" "Tribal" "Acid Punk" "Acid Jazz" "Polka" 
-    { 14 "R&B" }
+        "Retro" "Musical" "Rock & Roll" "Hard Rock" "Folk" 
-    { 15 "Rap" }
+        "Folk-Rock" "National Folk" "Swing" "Fast Fusion" "Bebop" 
-    { 16 "Reggae" }
+        "Latin" "Revival" "Celtic" "Bluegrass" "Avantgarde" 
-    { 17 "Rock" }
+        "Gothic Rock" "Progressive Rock" "Psychedelic Rock" 
-    { 18 "Techno" }
+        "Symphonic Rock" "Slow Rock" "Big Band" "Chorus" 
-    { 19 "Industrial" }
+        "Easy Listening" "Acoustic" "Humour" "Speech" "Chanson" 
-    { 20 "Alternative" }
+        "Opera" "Chamber Music" "Sonata" "Symphony" "Booty Bass" 
-    { 21 "Ska" }
+        "Primus" "Porn Groove" "Satire" "Slow Jam" "Club" "Tango" 
-    { 22 "Death Metal" }
+        "Samba" "Folklore" "Ballad" "Power Ballad" "Rhythmic Soul" 
-    { 23 "Pranks" }
+        "Freestyle" "Duet" "Punk Rock" "Drum Solo" "A capella" 
-    { 24 "Soundtrack" }
+        "Euro-House" "Dance Hall"
-    { 25 "Euro-Techno" }
+    }
-    { 26 "Ambient" }
-    { 27 "Trip-Hop" }
-    { 28 "Vocal" }
-    { 29 "Jazz+Funk" }
-    { 30 "Fusion" }
-    { 31 "Trance" }
-    { 32 "Classical" }
-    { 33 "Instrumental" }
-    { 34 "Acid" }
-    { 35 "House" }
-    { 36 "Game" }
-    { 37 "Sound Clip" }
-    { 38 "Gospel" }
-    { 39 "Noise" }
-    { 40 "AlternRock" }
-    { 41 "Bass" }
-    { 42 "Soul" }
-    { 43 "Punk" }
-    { 44 "Space" }
-    { 45 "Meditative" }
-    { 46 "Instrumental Pop" }
-    { 47 "Instrumental Rock" }
-    { 48 "Ethnic" }
-    { 49 "Gothic" }
-    { 50 "Darkwave" }
-    { 51 "Techno-Industrial" }
-    { 52 "Electronic" }
-    { 53 "Pop-Folk" }
-    { 54 "Eurodance" }
-    { 55 "Dream" }
-    { 56 "Southern Rock" }
-    { 57 "Comedy" }
-    { 58 "Cult" }
-    { 59 "Gangsta" }
-    { 60 "Top 40" }
-    { 61 "Christian Rap" }
-    { 62 "Pop/Funk" }
-    { 63 "Jungle" }
-    { 64 "Native American" }
-    { 65 "Cabaret" }
-    { 66 "New Wave" }
-    { 67 "Psychedelic" }
-    { 68 "Rave" }
-    { 69 "Showtunes" }
-    { 70 "Trailer" }
-    { 71 "Lo-Fi" }
-    { 72 "Tribal" }
-    { 73 "Acid Punk" }
-    { 74 "Acid Jazz" }
-    { 75 "Polka" }
-    { 76 "Retro" }
-    { 77 "Musical" }
-    { 78 "Rock & Roll" }
-    { 79 "Hard Rock" }
-    { 80 "Folk" }
-    { 81 "Folk-Rock" }
-    { 82 "National Folk" }
-    { 83 "Swing" }
-    { 84 "Fast Fusion" }
-    { 85 "Bebop" }
-    { 86 "Latin" }
-    { 87 "Revival" }
-    { 88 "Celtic" }
-    { 89 "Bluegrass" }
-    { 90 "Avantgarde" }
-    { 91 "Gothic Rock" }
-    { 92 "Progressive Rock" }
-    { 93 "Psychedelic Rock" }
-    { 94 "Symphonic Rock" }
-    { 95 "Slow Rock" }
-    { 96 "Big Band" }
-    { 97 "Chorus" }
-    { 98 "Easy Listening" }
-    { 99 "Acoustic" }
-    { 100 "Humour" }
-    { 101 "Speech" }
-    { 102 "Chanson" }
-    { 103 "Opera" }
-    { 104 "Chamber Music" }
-    { 105 "Sonata" }
-    { 106 "Symphony" }
-    { 107 "Booty Bass" }
-    { 108 "Primus" }
-    { 109 "Porn Groove" }
-    { 110 "Satire" }
-    { 111 "Slow Jam" }
-    { 112 "Club" }
-    { 113 "Tango" }
-    { 114 "Samba" }
-    { 115 "Folklore" }
-    { 116 "Ballad" }
-    { 117 "Power Ballad" }
-    { 118 "Rhythmic Soul" }
-    { 119 "Freestyle" }
-    { 120 "Duet" }
-    { 121 "Punk Rock" }
-    { 122 "Drum Solo" }
-    { 123 "A capella" }
-    { 124 "Euro-House" }
-    { 125 "Dance Hall" }
-} ! end genre hashtable
-
-! tuples
 
 TUPLE: header version flags size ;
 
@@ -144,63 +45,72 @@ TUPLE: frame frame-id flags size data ;
 
 TUPLE: id3v2-info header frames ;
 
-TUPLE: id3-info title artist album year comment genre ;
+TUPLE: id3v1-info title artist album year comment genre ;
 
-: <id3-info> ( -- object ) id3-info new ;
+: <id3v1-info> ( -- object ) id3v1-info new ;
 
-: <id3v2-info> ( header frames -- object ) id3v2-info boa ;
+: <id3v2-info> ( header frames -- object )
+    [ [ frame-id>> ] keep ] H{ } map>assoc
+    id3v2-info boa ;
 
 : <header> ( -- object ) header new ;
 
 : <frame> ( -- object ) frame new ;
 
-! utility words
+: id3v2? ( mmap -- ? ) "ID3" head? ; inline
-
-: id3v2? ( mmap -- ? )
-    "ID3" head? ;
 
 : id3v1? ( mmap -- ? )
-    128 tail-slice* "TAG" head? ;
+    { [ length 128 >= ] [ 128 tail-slice* "TAG" head? ] } 1&& ; inline
+
+: id3v1-frame ( string key -- frame )
+    <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 <id3v2-info> ;
 
 : >28bitword ( seq -- int )
-    0 [ swap 7 shift bitor ] reduce ;
+    0 [ [ 7 shift ] dip bitor ] reduce ; inline
 
 : filter-text-data ( data -- filtered )
-    [ printable? ] filter ;
+    [ printable? ] filter ; inline
-
-! frame details stuff
 
 : valid-frame-id? ( id -- ? )
-    [ [ digit? ] [ LETTER? ] bi or ] all? ;
+    [ { [ digit? ] [ LETTER? ] } 1|| ] all? ; inline
-
-: 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 ;
 
 : read-frame-data ( frame mmap -- frame data )
-    [ 10 over size>> 10 + ] dip <slice> filter-text-data ;
+    [ 10 over size>> 10 + ] dip <slice> 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 )
     [ <frame> ] dip
     {
-        [ read-frame-id    utf8 decode  >>frame-id ]
+        [ 4 head-slice decode-text >>frame-id ]
-        [ read-frame-flags >byte-array  >>flags ]
+        [ [ 4 8 ] dip subseq >28bitword >>size ]
-        [ read-frame-size  >28bitword   >>size ]
+        [ [ 8 10 ] dip subseq >byte-array >>flags ]
-        [ read-frame-data  utf8 decode  >>data ]
+        [ 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 -- ? )
+: read-v2-header ( seq -- id3header )
-    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 <slice> >28bitword ;
-
-: read-v2-header ( mmap -- id3header )
     [ <header> ] dip
     {
-        [ read-header-supported-version?  >>version ]
+        [ [ 3 5 ] dip <slice> >array >>version ]
-        [ read-header-flags >>flags ]
+        [ [ 5 ] dip nth >>flags ]
-        [ read-header-size >>size ]
+        [ [ 6 10 ] dip <slice> >28bitword >>size ]
-    } cleave ;
+    } cleave ; inline
 
-: drop-header ( mmap -- seq1 seq2 )
+: read-v2-tag-data ( seq -- id3v2-info )
-    dup 10 tail-slice swap ;
+    10 cut-slice
-
+    [ read-v2-header ]
-: parse-frames ( id3v2-info -- id3-info )
+    [ read-frames ] bi* <id3v2-info> ; inline
-    [ <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 <id3v2-info> parse-frames ;
     
 ! v1 information
 
-: skip-to-v1-data ( seq -- seq )
+: skip-to-v1-data ( seq -- seq ) 125 tail-slice* ; inline
-    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 ;
 
 : (read-v1-tag-data) ( seq -- mp3-file )
-    [ <id3-info> ] dip
+    [ <id3v1-info> ] dip
     {
-        [ read-title   utf8 decode  filter-text-data >>title   ]
+        [ 30 head-slice decode-text filter-text-data >>title ]
-        [ read-artist  utf8 decode  filter-text-data >>artist  ]
+        [ [ 30 60 ] dip subseq decode-text filter-text-data >>artist ]
-        [ read-album   utf8 decode  filter-text-data >>album   ]
+        [ [ 60 90 ] dip subseq decode-text filter-text-data >>album ]
-        [ read-year    utf8 decode  filter-text-data >>year    ]
+        [ [ 90 94 ] dip subseq decode-text filter-text-data >>year ]
-        [ read-comment utf8 decode  filter-text-data >>comment ]
+        [ [ 94 124 ] dip subseq decode-text filter-text-data >>comment ]
-        [ read-genre   >fixnum       genres at       >>genre ]
+        [ [ 124 ] dip nth number>string >>genre ]
-    } cleave ;
+    } 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 id3v2? ] [ read-v2-tag-data ] }
-            { [ dup id3v1? ] [ read-v1-tag-data ] } ! ( ? -- id3-info )
+            { [ dup id3v1? ] [ read-v1-tag-data id3v1>id3v2 ] }
-            [ drop f ] ! ( mmap -- f )
+            [ drop f ]
         } cond
     ] with-mapped-uchar-file ;
-
-! end