From 063e4571095699d46f419a422258f8d9a72f61fc Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Thu, 26 Feb 2009 13:41:30 -0600
Subject: [PATCH 01/18] Remove superflous \
---
basis/editors/emacs/emacs.factor | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
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 ,
,
From 3f70bb3b22d2854c97fc08e4ad1bb6b6bd446b02 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Thu, 26 Feb 2009 13:41:50 -0600
Subject: [PATCH 02/18] Update docs for improved error reporting
---
basis/stack-checker/stack-checker-docs.factor | 8 ++++----
1 file changed, 4 insertions(+), 4 deletions(-)
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:"
From a2404fad9490e6ed2af2fd7a39fdf19bf6d7c522 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Thu, 26 Feb 2009 13:44:37 -0600
Subject: [PATCH 03/18] Add missing file
---
build-support/cleanup | 8 ++++++++
1 file changed, 8 insertions(+)
create mode 100644 build-support/cleanup
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
From bda8b2dda63687176c35602c86a10accb3f3b100 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Thu, 26 Feb 2009 14:11:26 -0600
Subject: [PATCH 04/18] Better inlining for both-fixnums?
---
basis/compiler/tree/cleanup/cleanup-tests.factor | 5 +++++
.../tree/propagation/known-words/known-words.factor | 7 +++++--
2 files changed, 10 insertions(+), 2 deletions(-)
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 <groups> [ . . ] 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 <literal-info> object-info ?
+ [ class>> ] bi@ {
+ { [ 2dup [ fixnum classes-intersect? not ] either? ] [ f <literal-info> ] }
+ { [ 2dup [ fixnum class<= ] both? ] [ t <literal-info> ] }
+ [ object-info ]
+ } cond 2nip
] "outputs" set-word-prop
{
From dc370e56abf0d6888388921a0a5d053847a3e84f Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Thu, 26 Feb 2009 17:34:26 -0600
Subject: [PATCH 05/18] mmap now throws an understandable exception upon trying
to mmap a zero length file. fix a bug with calling |dispose on an integer if
mmap failed on unix
---
basis/io/mmap/mmap-tests.factor | 20 ++++++++++++++++++++
basis/io/mmap/mmap.factor | 9 +++++++--
basis/io/mmap/unix/unix.factor | 2 +-
3 files changed, 28 insertions(+), 3 deletions(-)
diff --git a/basis/io/mmap/mmap-tests.factor b/basis/io/mmap/mmap-tests.factor
index 166167a7e7..b892bded20 100644
--- a/basis/io/mmap/mmap-tests.factor
+++ b/basis/io/mmap/mmap-tests.factor
@@ -9,3 +9,23 @@ 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 touch-file ] unit-test
+
+! Test for leaking resources bug on Unix
+[ ]
+[
+ 100000 [
+ [
+ "mmap-empty-file.txt" temp-file [
+ drop
+ ] with-mapped-file
+ ] [ dup bad-mmap-size? [ drop ] [ rethrow ] if ] recover
+ ] times
+
+ "asdf" "mmap-asdf-file.txt" temp-file [ ascii set-file-contents ] keep [
+ drop
+ ] with-mapped-file
+] unit-test
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 ;
+
: <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 -- )
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 [ <fd> |dispose drop ] keep
[ 0 mmap dup MAP_FAILED = [ (io-error) ] when ] keep
] with-destructors ;
From e986a604876d66d27f08c04aa893b4b4372686cf Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Thu, 26 Feb 2009 17:54:44 -0600
Subject: [PATCH 06/18] id3 shouldn't fail on files with length < 128
---
extra/id3/id3.factor | 8 ++++++--
1 file changed, 6 insertions(+), 2 deletions(-)
diff --git a/extra/id3/id3.factor b/extra/id3/id3.factor
index f2bbd08996..289cc27b6b 100644
--- a/extra/id3/id3.factor
+++ b/extra/id3/id3.factor
@@ -1,6 +1,10 @@
! Copyright (C) 2009 Tim Wawrzynczak
! 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.utf8 assocs math.parser
+combinators.short-circuit ;
IN: id3
<PRIVATE
@@ -160,7 +164,7 @@ TUPLE: id3-info title artist album year comment genre ;
"ID3" head? ;
: id3v1? ( mmap -- ? )
- 128 tail-slice* "TAG" head? ;
+ { [ length 128 >= ] [ 128 tail-slice* "TAG" head? ] } 1&& ;
: >28bitword ( seq -- int )
0 [ swap 7 shift bitor ] reduce ;
From 16d3562b238382db24ef49df7a19a53dddc0adc9 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Thu, 26 Feb 2009 18:03:15 -0600
Subject: [PATCH 07/18] factor id3 a bit
---
extra/id3/id3.factor | 20 +++++++++++---------
1 file changed, 11 insertions(+), 9 deletions(-)
diff --git a/extra/id3/id3.factor b/extra/id3/id3.factor
index 289cc27b6b..abfe01c3e4 100644
--- a/extra/id3/id3.factor
+++ b/extra/id3/id3.factor
@@ -4,12 +4,11 @@ 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
-combinators.short-circuit ;
+combinators.short-circuit fry ;
IN: id3
<PRIVATE
-! genres
CONSTANT: genres
H{
{ 0 "Blues" }
@@ -225,7 +224,7 @@ TUPLE: id3-info title artist album year comment genre ;
: read-v2-header ( mmap -- id3header )
[ <header> ] dip
{
- [ read-header-supported-version? >>version ]
+ [ read-header-supported-version? >>version ]
[ read-header-flags >>flags ]
[ read-header-size >>size ]
} cleave ;
@@ -233,16 +232,19 @@ TUPLE: id3-info title artist album year comment genre ;
: drop-header ( mmap -- seq1 seq2 )
dup 10 tail-slice swap ;
+: frame-tag ( frame string -- tag/f )
+ '[ frame-id>> _ = ] find nip ; inline
+
: parse-frames ( id3v2-info -- id3-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*
+ [ "TIT2" frame-tag [ data>> >>title ] when* ]
+ [ "TALB" frame-tag [ data>> >>album ] when* ]
+ [ "TPE1" frame-tag [ data>> >>artist ] when* ]
+ [ "TCON" frame-tag [ 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* ]
+ [ "COMM" frame-tag [ data>> >>comment ] when* ]
+ [ "TYER" frame-tag [ data>> >>year ] when* ]
} cleave ;
: read-v2-tag-data ( seq -- id3-info )
From a083832ab497392ed008467389554b63d4089f5f Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Thu, 26 Feb 2009 18:10:11 -0600
Subject: [PATCH 08/18] fix typo in math docs
---
core/math/math-docs.factor | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
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."
From 084311750e2b0e2be608dcfc17ddfb91d6ffce2f Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Thu, 26 Feb 2009 18:11:07 -0600
Subject: [PATCH 09/18] add using to mmap tests
---
basis/io/mmap/mmap-tests.factor | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/basis/io/mmap/mmap-tests.factor b/basis/io/mmap/mmap-tests.factor
index b892bded20..70a1869bd0 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
From 1bd35e6f625fc257ef677ccbc50696b9db0eafec Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Thu, 26 Feb 2009 19:58:25 -0600
Subject: [PATCH 10/18] better io.mmap test
---
basis/io/mmap/mmap-tests.factor | 18 ++++--------------
1 file changed, 4 insertions(+), 14 deletions(-)
diff --git a/basis/io/mmap/mmap-tests.factor b/basis/io/mmap/mmap-tests.factor
index 70a1869bd0..a4d55f3c1e 100644
--- a/basis/io/mmap/mmap-tests.factor
+++ b/basis/io/mmap/mmap-tests.factor
@@ -11,21 +11,11 @@ IN: io.mmap.tests
[ "mmap-test-file.txt" temp-file delete-file ] ignore-errors
-[ ]
-[ "mmap-empty-file.txt" temp-file touch-file ] unit-test
+[ "mmap-empty-file.txt" temp-file delete-file ] ignore-errors
+[ ] [ "mmap-empty-file.txt" temp-file touch-file ] unit-test
-! Test for leaking resources bug on Unix
-[ ]
[
- 100000 [
- [
- "mmap-empty-file.txt" temp-file [
- drop
- ] with-mapped-file
- ] [ dup bad-mmap-size? [ drop ] [ rethrow ] if ] recover
- ] times
-
- "asdf" "mmap-asdf-file.txt" temp-file [ ascii set-file-contents ] keep [
+ "mmap-empty-file.txt" temp-file [
drop
] with-mapped-file
-] unit-test
+] [ bad-mmap-size? ] must-fail-with
From e1b4e8c66fcf81a5e3c60a47468e7fa8f53a27ea Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Thu, 26 Feb 2009 21:39:53 -0600
Subject: [PATCH 11/18] id3 outputs id3v2-info objects or f now. id3v1 info is
turned into id3v2. you can access the title, album, etc fields by calling
id3-title, etc, but also other frames are saved and can be accessed
---
extra/id3/authors.txt | 2 +-
extra/id3/id3-docs.factor | 2 +-
extra/id3/id3-tests.factor | 59 +++---
extra/id3/id3.factor | 405 +++++++++++++++++++------------------
4 files changed, 246 insertions(+), 222 deletions(-)
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..eabbf00ad7 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"
+] [ "resource:extra/id3/tests/blah.mp3" file-id3-tags id3-params ] unit-test
+
+[
+ "Anthem of the Trinity"
+ "Terry Riley"
+ "Shri Camel"
+ f
+ f
+ "Classical"
+] [ "resource:extra/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"
+] [ "resource:extra/id3/tests/blah3.mp3" file-id3-tags id3-params ] unit-test
diff --git a/extra/id3/id3.factor b/extra/id3/id3.factor
index abfe01c3e4..fba6188b1e 100644
--- a/extra/id3/id3.factor
+++ b/extra/id3/id3.factor
@@ -1,145 +1,144 @@
-! 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
-combinators.short-circuit fry ;
+combinators.short-circuit fry namespaces multiline
+combinators.smart splitting ;
IN: id3
<PRIVATE
CONSTANT: genres
- H{
- { 0 "Blues" }
- { 1 "Classic Rock" }
- { 2 "Country" }
- { 3 "Dance" }
- { 4 "Disco" }
- { 5 "Funk" }
- { 6 "Grunge" }
- { 7 "Hip-Hop" }
- { 8 "Jazz" }
- { 9 "Metal" }
- { 10 "New Age" }
- { 11 "Oldies" }
- { 12 "Other" }
- { 13 "Pop" }
- { 14 "R&B" }
- { 15 "Rap" }
- { 16 "Reggae" }
- { 17 "Rock" }
- { 18 "Techno" }
- { 19 "Industrial" }
- { 20 "Alternative" }
- { 21 "Ska" }
- { 22 "Death Metal" }
- { 23 "Pranks" }
- { 24 "Soundtrack" }
- { 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
+ {
+ "Blues"
+ "Classic Rock"
+ "Country"
+ "Dance"
+ "Disco"
+ "Funk"
+ "Grunge"
+ "Hip-Hop"
+ "Jazz"
+ "Metal"
+ "New Age"
+ "Oldies"
+ "Other"
+ "Pop"
+ "R&B"
+ "Rap"
+ "Reggae"
+ "Rock"
+ "Techno"
+ "Industrial"
+ "Alternative"
+ "Ska"
+ "Death Metal"
+ "Pranks"
+ "Soundtrack"
+ "Euro-Techno"
+ "Ambient"
+ "Trip-Hop"
+ "Vocal"
+ "Jazz+Funk"
+ "Fusion"
+ "Trance"
+ "Classical"
+ "Instrumental"
+ "Acid"
+ "House"
+ "Game"
+ "Sound Clip"
+ "Gospel"
+ "Noise"
+ "AlternRock"
+ "Bass"
+ "Soul"
+ "Punk"
+ "Space"
+ "Meditative"
+ "Instrumental Pop"
+ "Instrumental Rock"
+ "Ethnic"
+ "Gothic"
+ "Darkwave"
+ "Techno-Industrial"
+ "Electronic"
+ "Pop-Folk"
+ "Eurodance"
+ "Dream"
+ "Southern Rock"
+ "Comedy"
+ "Cult"
+ "Gangsta"
+ "Top 40"
+ "Christian Rap"
+ "Pop/Funk"
+ "Jungle"
+ "Native American"
+ "Cabaret"
+ "New Wave"
+ "Psychedelic"
+ "Rave"
+ "Showtunes"
+ "Trailer"
+ "Lo-Fi"
+ "Tribal"
+ "Acid Punk"
+ "Acid Jazz"
+ "Polka"
+ "Retro"
+ "Musical"
+ "Rock & Roll"
+ "Hard Rock"
+ "Folk"
+ "Folk-Rock"
+ "National Folk"
+ "Swing"
+ "Fast Fusion"
+ "Bebop"
+ "Latin"
+ "Revival"
+ "Celtic"
+ "Bluegrass"
+ "Avantgarde"
+ "Gothic Rock"
+ "Progressive Rock"
+ "Psychedelic Rock"
+ "Symphonic Rock"
+ "Slow Rock"
+ "Big Band"
+ "Chorus"
+ "Easy Listening"
+ "Acoustic"
+ "Humour"
+ "Speech"
+ "Chanson"
+ "Opera"
+ "Chamber Music"
+ "Sonata"
+ "Symphony"
+ "Booty Bass"
+ "Primus"
+ "Porn Groove"
+ "Satire"
+ "Slow Jam"
+ "Club"
+ "Tango"
+ "Samba"
+ "Folklore"
+ "Ballad"
+ "Power Ballad"
+ "Rhythmic Soul"
+ "Freestyle"
+ "Duet"
+ "Punk Rock"
+ "Drum Solo"
+ "A capella"
+ "Euro-House"
+ "Dance Hall"
+ }
TUPLE: header version flags size ;
@@ -151,42 +150,58 @@ TUPLE: id3-info title artist album year comment genre ;
: <id3-info> ( -- object ) id3-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? ;
+: id3v2? ( mmap -- ? ) "ID3" head? ; inline
: id3v1? ( mmap -- ? )
- { [ length 128 >= ] [ 128 tail-slice* "TAG" head? ] } 1&& ;
+ { [ 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 ;
+ 4 head-slice ; inline
: read-frame-size ( mmap -- size )
- [ 4 8 ] dip subseq ;
+ [ 4 8 ] dip subseq ; inline
: read-frame-flags ( mmap -- flags )
- [ 8 10 ] dip subseq ;
+ [ 8 10 ] dip subseq ; inline
: 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
@@ -200,10 +215,11 @@ TUPLE: id3-info title artist album year comment genre ;
} cleave ;
: read-frame ( mmap -- frame/f )
- dup read-frame-id valid-frame-id? [ (read-frame) ] [ drop f ] if ;
+ dup read-frame-id 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 ]
@@ -213,13 +229,12 @@ 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 ;
+ 3 tail-slice first { 3 4 } member? ; inline
-: read-header-flags ( mmap -- flags )
- 5 swap nth ;
+: read-header-flags ( mmap -- flags ) 5 swap nth ; inline
: read-header-size ( mmap -- size )
- [ 6 10 ] dip <slice> >28bitword ;
+ [ 6 10 ] dip <slice> >28bitword ; inline
: read-v2-header ( mmap -- id3header )
[ <header> ] dip
@@ -227,51 +242,30 @@ TUPLE: id3-info title artist album year comment genre ;
[ read-header-supported-version? >>version ]
[ read-header-flags >>flags ]
[ read-header-size >>size ]
- } cleave ;
+ } cleave ; inline
: drop-header ( mmap -- seq1 seq2 )
- dup 10 tail-slice swap ;
+ [ 10 tail-slice ] [ ] bi ; inline
-: frame-tag ( frame string -- tag/f )
- '[ frame-id>> _ = ] find nip ; inline
-
-: parse-frames ( id3v2-info -- id3-info )
- [ <id3-info> ] dip frames>>
- {
- [ "TIT2" frame-tag [ data>> >>title ] when* ]
- [ "TALB" frame-tag [ data>> >>album ] when* ]
- [ "TPE1" frame-tag [ data>> >>artist ] when* ]
- [ "TCON" frame-tag [ data>> [ [ digit? ] filter string>number ] keep swap [ genres at nip ] when*
- >>genre ] when* ]
- [ "COMM" frame-tag [ data>> >>comment ] when* ]
- [ "TYER" frame-tag [ data>> >>year ] when* ]
- } cleave ;
-
-: read-v2-tag-data ( seq -- id3-info )
- drop-header read-v2-header swap read-frames <id3v2-info> parse-frames ;
+: read-v2-tag-data ( seq -- id3v2-info )
+ drop-header read-v2-header
+ swap read-frames <id3v2-info> ; inline
! v1 information
-: skip-to-v1-data ( seq -- seq )
- 125 tail-slice* ;
+: skip-to-v1-data ( seq -- seq ) 125 tail-slice* ; inline
-: read-title ( seq -- title )
- 30 head-slice ;
+: read-title ( seq -- title ) 30 head-slice ; inline
-: read-artist ( seq -- title )
- [ 30 60 ] dip subseq ;
+: read-artist ( seq -- title ) [ 30 60 ] dip subseq ; inline
-: read-album ( seq -- album )
- [ 60 90 ] dip subseq ;
+: read-album ( seq -- album ) [ 60 90 ] dip subseq ; inline
-: read-year ( seq -- year )
- [ 90 94 ] dip subseq ;
+: read-year ( seq -- year ) [ 90 94 ] dip subseq ; inline
-: read-comment ( seq -- comment )
- [ 94 124 ] dip subseq ;
+: read-comment ( seq -- comment ) [ 94 124 ] dip subseq ; inline
-: read-genre ( seq -- genre )
- [ 124 ] dip nth ;
+: read-genre ( seq -- genre ) [ 124 ] dip nth ; inline
: (read-v1-tag-data) ( seq -- mp3-file )
[ <id3-info> ] dip
@@ -281,23 +275,46 @@ TUPLE: id3-info title artist album year comment genre ;
[ 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 ;
+ [ read-genre 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
From de9154fc5e7cf979e1d59205433c4b2d2ae25b44 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Thu, 26 Feb 2009 21:50:01 -0600
Subject: [PATCH 12/18] make find-all-files and find-in-program-files not take
the traversal method
---
basis/io/directories/search/search-docs.factor | 2 +-
basis/io/directories/search/search-tests.factor | 2 +-
basis/io/directories/search/search.factor | 3 ++-
basis/io/directories/search/windows/windows.factor | 4 ++--
4 files changed, 6 insertions(+), 5 deletions(-)
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
'[
_ _ _ [ <directory-iterator> ] 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
From efe701af9b614255ab1ca75a9806e06e5abc8fda Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Thu, 26 Feb 2009 21:50:20 -0600
Subject: [PATCH 13/18] fix editors for find-in-program-files change
---
basis/editors/editpadlite/editpadlite.factor | 2 +-
basis/editors/editpadpro/editpadpro.factor | 2 +-
basis/editors/editplus/editplus.factor | 2 +-
basis/editors/emacs/windows/windows.factor | 4 ++--
basis/editors/emeditor/emeditor.factor | 2 +-
basis/editors/etexteditor/etexteditor.factor | 2 +-
basis/editors/gvim/windows/windows.factor | 2 +-
basis/editors/notepadpp/notepadpp.factor | 2 +-
basis/editors/scite/scite.factor | 4 ++--
basis/editors/ted-notepad/ted-notepad.factor | 2 +-
basis/editors/textpad/textpad.factor | 2 +-
basis/editors/ultraedit/ultraedit.factor | 2 +-
basis/editors/wordpad/wordpad.factor | 2 +-
13 files changed, 15 insertions(+), 15 deletions(-)
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/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* ;
From 63c9b1a6b8d0dae85a1c0c7aba6ad7a81c9560c2 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Thu, 26 Feb 2009 22:33:43 -0600
Subject: [PATCH 14/18] try to detect the encoding for id3 headers. need to
try this on some mp3s from the wild
---
extra/id3/id3.factor | 29 +++++++++++++++++------------
1 file changed, 17 insertions(+), 12 deletions(-)
diff --git a/extra/id3/id3.factor b/extra/id3/id3.factor
index fba6188b1e..a4adeedaa5 100644
--- a/extra/id3/id3.factor
+++ b/extra/id3/id3.factor
@@ -3,9 +3,9 @@
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
+io.encodings.string io.encodings.utf16 assocs math.parser
combinators.short-circuit fry namespaces multiline
-combinators.smart splitting ;
+combinators.smart splitting io.encodings.ascii ;
IN: id3
<PRIVATE
@@ -205,13 +205,18 @@ TUPLE: id3-info title artist album year comment genre ;
! 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 ]
- [ read-frame-flags >byte-array >>flags ]
- [ read-frame-size >28bitword >>size ]
- [ read-frame-data utf8 decode >>data ]
+ [ read-frame-id decode-text >>frame-id ]
+ [ read-frame-flags >byte-array >>flags ]
+ [ read-frame-size >28bitword >>size ]
+ [ read-frame-data decode-text >>data ]
} cleave ;
: read-frame ( mmap -- frame/f )
@@ -270,12 +275,12 @@ TUPLE: id3-info title artist album year comment genre ;
: (read-v1-tag-data) ( seq -- mp3-file )
[ <id3-info> ] 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 number>string >>genre ]
+ [ read-title decode-text filter-text-data >>title ]
+ [ read-artist decode-text filter-text-data >>artist ]
+ [ read-album decode-text filter-text-data >>album ]
+ [ read-year decode-text filter-text-data >>year ]
+ [ read-comment decode-text filter-text-data >>comment ]
+ [ read-genre number>string >>genre ]
} cleave ; inline
: read-v1-tag-data ( seq -- mp3-file )
From 11117648ea21caa85d057117a2e546c89b6fdee3 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Thu, 26 Feb 2009 23:30:48 -0600
Subject: [PATCH 15/18] Fix stack checker regressions
---
basis/stack-checker/errors/errors.factor | 2 +-
basis/stack-checker/known-words/known-words.factor | 8 +++-----
basis/stack-checker/stack-checker-tests.factor | 7 +++++--
3 files changed, 9 insertions(+), 8 deletions(-)
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? <effect>
- 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 <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
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
From 16e394517c278639bc7a05012a33cffc12a0a0b3 Mon Sep 17 00:00:00 2001
From: sheeple <sheeple@oberon.local>
Date: Fri, 27 Feb 2009 00:23:04 -0600
Subject: [PATCH 16/18] use vocab: in id3 tests, remove lots of helper words
because it's clear what they do
---
extra/id3/id3-tests.factor | 6 +-
extra/id3/id3.factor | 229 ++++++++-----------------------------
2 files changed, 52 insertions(+), 183 deletions(-)
diff --git a/extra/id3/id3-tests.factor b/extra/id3/id3-tests.factor
index eabbf00ad7..aefbec8550 100644
--- a/extra/id3/id3-tests.factor
+++ b/extra/id3/id3-tests.factor
@@ -20,7 +20,7 @@ IN: id3.tests
"2009"
"COMMENT"
"Bluegrass"
-] [ "resource:extra/id3/tests/blah.mp3" file-id3-tags id3-params ] unit-test
+] [ "vocab:id3/tests/blah.mp3" file-id3-tags id3-params ] unit-test
[
"Anthem of the Trinity"
@@ -29,7 +29,7 @@ IN: id3.tests
f
f
"Classical"
-] [ "resource:extra/id3/tests/blah2.mp3" file-id3-tags id3-params ] unit-test
+] [ "vocab:id3/tests/blah2.mp3" file-id3-tags id3-params ] unit-test
[
"Stormy Weather"
@@ -38,5 +38,5 @@ IN: id3.tests
f
"eng, AG# 08E1C12E"
"Big Band"
-] [ "resource:extra/id3/tests/blah3.mp3" file-id3-tags id3-params ] unit-test
+] [ "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 a4adeedaa5..aa27fb95c7 100644
--- a/extra/id3/id3.factor
+++ b/extra/id3/id3.factor
@@ -4,140 +4,39 @@ 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 multiline
-combinators.smart splitting io.encodings.ascii ;
+combinators.short-circuit fry namespaces combinators.smart
+splitting io.encodings.ascii arrays ;
IN: id3
<PRIVATE
CONSTANT: genres
{
- "Blues"
- "Classic Rock"
- "Country"
- "Dance"
- "Disco"
- "Funk"
- "Grunge"
- "Hip-Hop"
- "Jazz"
- "Metal"
- "New Age"
- "Oldies"
- "Other"
- "Pop"
- "R&B"
- "Rap"
- "Reggae"
- "Rock"
- "Techno"
- "Industrial"
- "Alternative"
- "Ska"
- "Death Metal"
- "Pranks"
- "Soundtrack"
- "Euro-Techno"
- "Ambient"
- "Trip-Hop"
- "Vocal"
- "Jazz+Funk"
- "Fusion"
- "Trance"
- "Classical"
- "Instrumental"
- "Acid"
- "House"
- "Game"
- "Sound Clip"
- "Gospel"
- "Noise"
- "AlternRock"
- "Bass"
- "Soul"
- "Punk"
- "Space"
- "Meditative"
- "Instrumental Pop"
- "Instrumental Rock"
- "Ethnic"
- "Gothic"
- "Darkwave"
- "Techno-Industrial"
- "Electronic"
- "Pop-Folk"
- "Eurodance"
- "Dream"
- "Southern Rock"
- "Comedy"
- "Cult"
- "Gangsta"
- "Top 40"
- "Christian Rap"
- "Pop/Funk"
- "Jungle"
- "Native American"
- "Cabaret"
- "New Wave"
- "Psychedelic"
- "Rave"
- "Showtunes"
- "Trailer"
- "Lo-Fi"
- "Tribal"
- "Acid Punk"
- "Acid Jazz"
- "Polka"
- "Retro"
- "Musical"
- "Rock & Roll"
- "Hard Rock"
- "Folk"
- "Folk-Rock"
- "National Folk"
- "Swing"
- "Fast Fusion"
- "Bebop"
- "Latin"
- "Revival"
- "Celtic"
- "Bluegrass"
- "Avantgarde"
- "Gothic Rock"
- "Progressive Rock"
- "Psychedelic Rock"
- "Symphonic Rock"
- "Slow Rock"
- "Big Band"
- "Chorus"
- "Easy Listening"
- "Acoustic"
- "Humour"
- "Speech"
- "Chanson"
- "Opera"
- "Chamber Music"
- "Sonata"
- "Symphony"
- "Booty Bass"
- "Primus"
- "Porn Groove"
- "Satire"
- "Slow Jam"
- "Club"
- "Tango"
- "Samba"
- "Folklore"
- "Ballad"
- "Power Ballad"
- "Rhythmic Soul"
- "Freestyle"
- "Duet"
- "Punk Rock"
- "Drum Solo"
- "A capella"
- "Euro-House"
- "Dance Hall"
+ "Blues" "Classic Rock" "Country" "Dance" "Disco" "Funk"
+ "Grunge" "Hip-Hop" "Jazz" "Metal" "New Age" "Oldies" "Other"
+ "Pop" "R&B" "Rap" "Reggae" "Rock" "Techno" "Industrial"
+ "Alternative" "Ska" "Death Metal" "Pranks" "Soundtrack"
+ "Euro-Techno" "Ambient" "Trip-Hop" "Vocal" "Jazz+Funk"
+ "Fusion" "Trance" "Classical" "Instrumental" "Acid" "House"
+ "Game" "Sound Clip" "Gospel" "Noise" "AlternRock" "Bass"
+ "Soul" "Punk" "Space" "Meditative" "Instrumental Pop"
+ "Instrumental Rock" "Ethnic" "Gothic" "Darkwave"
+ "Techno-Industrial" "Electronic" "Pop-Folk" "Eurodance"
+ "Dream" "Southern Rock" "Comedy" "Cult" "Gangsta" "Top 40"
+ "Christian Rap" "Pop/Funk" "Jungle" "Native American"
+ "Cabaret" "New Wave" "Psychedelic" "Rave" "Showtunes"
+ "Trailer" "Lo-Fi" "Tribal" "Acid Punk" "Acid Jazz" "Polka"
+ "Retro" "Musical" "Rock & Roll" "Hard Rock" "Folk"
+ "Folk-Rock" "National Folk" "Swing" "Fast Fusion" "Bebop"
+ "Latin" "Revival" "Celtic" "Bluegrass" "Avantgarde"
+ "Gothic Rock" "Progressive Rock" "Psychedelic Rock"
+ "Symphonic Rock" "Slow Rock" "Big Band" "Chorus"
+ "Easy Listening" "Acoustic" "Humour" "Speech" "Chanson"
+ "Opera" "Chamber Music" "Sonata" "Symphony" "Booty Bass"
+ "Primus" "Porn Groove" "Satire" "Slow Jam" "Club" "Tango"
+ "Samba" "Folklore" "Ballad" "Power Ballad" "Rhythmic Soul"
+ "Freestyle" "Duet" "Punk Rock" "Drum Solo" "A capella"
+ "Euro-House" "Dance Hall"
}
TUPLE: header version flags size ;
@@ -186,25 +85,12 @@ TUPLE: id3-info title artist album year comment genre ;
: filter-text-data ( data -- filtered )
[ printable? ] filter ; inline
-! frame details stuff
-
: valid-frame-id? ( id -- ? )
[ { [ digit? ] [ LETTER? ] } 1|| ] all? ; inline
-: read-frame-id ( mmap -- id )
- 4 head-slice ; inline
-
-: read-frame-size ( mmap -- size )
- [ 4 8 ] dip subseq ; inline
-
-: read-frame-flags ( mmap -- flags )
- [ 8 10 ] dip subseq ; inline
-
: read-frame-data ( frame mmap -- frame 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?
@@ -213,14 +99,14 @@ TUPLE: id3-info title artist album year comment genre ;
: (read-frame) ( mmap -- frame )
[ <frame> ] dip
{
- [ read-frame-id decode-text >>frame-id ]
- [ read-frame-flags >byte-array >>flags ]
- [ read-frame-size >28bitword >>size ]
+ [ 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?
+ dup 4 head-slice valid-frame-id?
[ (read-frame) ] [ drop f ] if ;
: remove-frame ( mmap frame -- mmap )
@@ -233,54 +119,32 @@ TUPLE: id3-info title artist album year comment genre ;
! header stuff
-: read-header-supported-version? ( mmap -- ? )
- 3 tail-slice first { 3 4 } member? ; inline
-
-: read-header-flags ( mmap -- flags ) 5 swap nth ; inline
-
-: read-header-size ( mmap -- size )
- [ 6 10 ] dip <slice> >28bitword ; inline
-
-: read-v2-header ( mmap -- id3header )
+: read-v2-header ( seq -- id3header )
[ <header> ] dip
{
- [ read-header-supported-version? >>version ]
- [ read-header-flags >>flags ]
- [ read-header-size >>size ]
+ [ [ 3 5 ] dip <slice> >array >>version ]
+ [ [ 5 ] dip nth >>flags ]
+ [ [ 6 10 ] dip <slice> >28bitword >>size ]
} cleave ; inline
-: drop-header ( mmap -- seq1 seq2 )
- [ 10 tail-slice ] [ ] bi ; inline
-
: read-v2-tag-data ( seq -- id3v2-info )
- drop-header read-v2-header
- swap read-frames <id3v2-info> ; inline
+ 10 cut-slice
+ [ read-v2-header ]
+ [ read-frames ] bi* <id3v2-info> ; inline
! v1 information
: skip-to-v1-data ( seq -- seq ) 125 tail-slice* ; inline
-: read-title ( seq -- title ) 30 head-slice ; inline
-
-: read-artist ( seq -- title ) [ 30 60 ] dip subseq ; inline
-
-: read-album ( seq -- album ) [ 60 90 ] dip subseq ; inline
-
-: read-year ( seq -- year ) [ 90 94 ] dip subseq ; inline
-
-: read-comment ( seq -- comment ) [ 94 124 ] dip subseq ; inline
-
-: read-genre ( seq -- genre ) [ 124 ] dip nth ; inline
-
: (read-v1-tag-data) ( seq -- mp3-file )
[ <id3-info> ] dip
{
- [ read-title decode-text filter-text-data >>title ]
- [ read-artist decode-text filter-text-data >>artist ]
- [ read-album decode-text filter-text-data >>album ]
- [ read-year decode-text filter-text-data >>year ]
- [ read-comment decode-text filter-text-data >>comment ]
- [ read-genre number>string >>genre ]
+ [ 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 )
@@ -323,3 +187,8 @@ PRIVATE>
[ drop f ]
} cond
] with-mapped-uchar-file ;
+
+: write-id3-tags ( id3v2-info path -- )
+ binary [
+
+ ] with-file-writer ;
From ec51a3a1a1fce19fc6ec3e1707d8d919e461f77f Mon Sep 17 00:00:00 2001
From: sheeple <sheeple@oberon.local>
Date: Fri, 27 Feb 2009 00:27:39 -0600
Subject: [PATCH 17/18] id3-info -> id3v1-info, remove work in progress
---
extra/id3/id3.factor | 11 +++--------
1 file changed, 3 insertions(+), 8 deletions(-)
diff --git a/extra/id3/id3.factor b/extra/id3/id3.factor
index aa27fb95c7..d1397285d7 100644
--- a/extra/id3/id3.factor
+++ b/extra/id3/id3.factor
@@ -45,9 +45,9 @@ 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 )
[ [ frame-id>> ] keep ] H{ } map>assoc
@@ -137,7 +137,7 @@ TUPLE: id3-info title artist album year comment genre ;
: skip-to-v1-data ( seq -- seq ) 125 tail-slice* ; inline
: (read-v1-tag-data) ( seq -- mp3-file )
- [ <id3-info> ] dip
+ [ <id3v1-info> ] dip
{
[ 30 head-slice decode-text filter-text-data >>title ]
[ [ 30 60 ] dip subseq decode-text filter-text-data >>artist ]
@@ -187,8 +187,3 @@ PRIVATE>
[ drop f ]
} cond
] with-mapped-uchar-file ;
-
-: write-id3-tags ( id3v2-info path -- )
- binary [
-
- ] with-file-writer ;
From 2c462745f126a2fba9563a2516c8ce321229f5ea Mon Sep 17 00:00:00 2001
From: Daniel Ehrenberg <littledan@Macintosh-122.local>
Date: Fri, 27 Feb 2009 00:53:05 -0600
Subject: [PATCH 18/18] Redoing string streams and byte-array streams without
copying
---
basis/hints/hints.factor | 2 -
basis/io/streams/byte-array/byte-array.factor | 15 ++++++-
core/checksums/crc32/crc32.factor | 2 +-
core/io/streams/sequence/sequence.factor | 38 ++++++++++++++++
core/io/streams/string/string-tests.factor | 10 ++---
core/io/streams/string/string.factor | 44 +++++--------------
6 files changed, 68 insertions(+), 43 deletions(-)
create mode 100644 core/io/streams/sequence/sequence.factor
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/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
: <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
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" <string-reader> stream-read ] unit-test
+[ "ab" ] [ 2 "abc" <string-reader> stream-read ] unit-test
+[ "abc" ] [ 3 "abc" <string-reader> 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
[
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
<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 )
- 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 ;
: <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