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

db4
Daniel Ehrenberg 2009-02-27 00:56:54 -06:00
commit 0214dc5e7d
5 changed files with 59 additions and 194 deletions

View File

@ -80,4 +80,4 @@ TUPLE: inconsistent-recursive-call-error word ;
TUPLE: unknown-primitive-error ; TUPLE: unknown-primitive-error ;
: unknown-primitive-error ( -- * ) : unknown-primitive-error ( -- * )
\ unknown-primitive-error inference-error ; \ unknown-primitive-error inference-warning ;

View File

@ -141,9 +141,7 @@ M: object infer-call*
apply-word/effect ; apply-word/effect ;
: infer-exit ( -- ) : infer-exit ( -- )
\ exit \ exit (( n -- * )) apply-word/effect ;
{ integer } { } t >>terminated? <effect>
apply-word/effect ;
: infer-load-locals ( -- ) : infer-load-locals ( -- )
pop-literal nip pop-literal nip
@ -189,7 +187,7 @@ M: object infer-call*
{ \ load-locals [ infer-load-locals ] } { \ load-locals [ infer-load-locals ] }
{ \ get-local [ infer-get-local ] } { \ get-local [ infer-get-local ] }
{ \ drop-locals [ infer-drop-locals ] } { \ drop-locals [ infer-drop-locals ] }
{ \ do-primitive [ unknown-primitive-error inference-warning ] } { \ do-primitive [ unknown-primitive-error ] }
{ \ alien-invoke [ infer-alien-invoke ] } { \ alien-invoke [ infer-alien-invoke ] }
{ \ alien-indirect [ infer-alien-indirect ] } { \ alien-indirect [ infer-alien-indirect ] }
{ \ alien-callback [ infer-alien-callback ] } { \ alien-callback [ infer-alien-callback ] }
@ -207,7 +205,7 @@ M: object infer-call*
{ {
declare call (call) slip 2slip 3slip dip 2dip 3dip declare call (call) slip 2slip 3slip dip 2dip 3dip
curry compose execute (execute) if dispatch <tuple-boa> 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 alien-invoke alien-indirect alien-callback
} [ t "special" set-word-prop ] each } [ t "special" set-word-prop ] each

View File

@ -6,7 +6,8 @@ quotations effects tools.test continuations generic.standard
sorting assocs definitions prettyprint io inspector sorting assocs definitions prettyprint io inspector
classes.tuple classes.union classes.predicate debugger classes.tuple classes.union classes.predicate debugger
threads.private io.streams.string io.timeouts io.thread 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 IN: stack-checker.tests
\ infer. must-infer \ infer. must-infer
@ -581,4 +582,6 @@ DEFER: eee'
: debugging-curry-folding ( quot -- ) : debugging-curry-folding ( quot -- )
[ debugging-curry-folding ] curry call ; inline recursive [ debugging-curry-folding ] curry call ; inline recursive
[ [ ] debugging-curry-folding ] must-infer [ [ ] debugging-curry-folding ] must-infer
[ [ exit ] [ 1 2 3 ] if ] must-infer

View File

@ -20,7 +20,7 @@ IN: id3.tests
"2009" "2009"
"COMMENT" "COMMENT"
"Bluegrass" "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" "Anthem of the Trinity"
@ -29,7 +29,7 @@ IN: id3.tests
f f
f f
"Classical" "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" "Stormy Weather"
@ -38,5 +38,5 @@ IN: id3.tests
f f
"eng, AG# 08E1C12E" "eng, AG# 08E1C12E"
"Big Band" "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

View File

@ -4,140 +4,39 @@ USING: sequences io io.encodings.binary io.files io.pathnames
strings kernel math io.mmap io.mmap.uchar accessors syntax strings kernel math io.mmap io.mmap.uchar accessors syntax
combinators math.ranges unicode.categories byte-arrays combinators math.ranges unicode.categories byte-arrays
io.encodings.string io.encodings.utf16 assocs math.parser io.encodings.string io.encodings.utf16 assocs math.parser
combinators.short-circuit fry namespaces multiline combinators.short-circuit fry namespaces combinators.smart
combinators.smart splitting io.encodings.ascii ; splitting io.encodings.ascii arrays ;
IN: id3 IN: id3
<PRIVATE <PRIVATE
CONSTANT: genres CONSTANT: genres
{ {
"Blues" "Blues" "Classic Rock" "Country" "Dance" "Disco" "Funk"
"Classic Rock" "Grunge" "Hip-Hop" "Jazz" "Metal" "New Age" "Oldies" "Other"
"Country" "Pop" "R&B" "Rap" "Reggae" "Rock" "Techno" "Industrial"
"Dance" "Alternative" "Ska" "Death Metal" "Pranks" "Soundtrack"
"Disco" "Euro-Techno" "Ambient" "Trip-Hop" "Vocal" "Jazz+Funk"
"Funk" "Fusion" "Trance" "Classical" "Instrumental" "Acid" "House"
"Grunge" "Game" "Sound Clip" "Gospel" "Noise" "AlternRock" "Bass"
"Hip-Hop" "Soul" "Punk" "Space" "Meditative" "Instrumental Pop"
"Jazz" "Instrumental Rock" "Ethnic" "Gothic" "Darkwave"
"Metal" "Techno-Industrial" "Electronic" "Pop-Folk" "Eurodance"
"New Age" "Dream" "Southern Rock" "Comedy" "Cult" "Gangsta" "Top 40"
"Oldies" "Christian Rap" "Pop/Funk" "Jungle" "Native American"
"Other" "Cabaret" "New Wave" "Psychedelic" "Rave" "Showtunes"
"Pop" "Trailer" "Lo-Fi" "Tribal" "Acid Punk" "Acid Jazz" "Polka"
"R&B" "Retro" "Musical" "Rock & Roll" "Hard Rock" "Folk"
"Rap" "Folk-Rock" "National Folk" "Swing" "Fast Fusion" "Bebop"
"Reggae" "Latin" "Revival" "Celtic" "Bluegrass" "Avantgarde"
"Rock" "Gothic Rock" "Progressive Rock" "Psychedelic Rock"
"Techno" "Symphonic Rock" "Slow Rock" "Big Band" "Chorus"
"Industrial" "Easy Listening" "Acoustic" "Humour" "Speech" "Chanson"
"Alternative" "Opera" "Chamber Music" "Sonata" "Symphony" "Booty Bass"
"Ska" "Primus" "Porn Groove" "Satire" "Slow Jam" "Club" "Tango"
"Death Metal" "Samba" "Folklore" "Ballad" "Power Ballad" "Rhythmic Soul"
"Pranks" "Freestyle" "Duet" "Punk Rock" "Drum Solo" "A capella"
"Soundtrack" "Euro-House" "Dance Hall"
"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 ; TUPLE: header version flags size ;
@ -146,9 +45,9 @@ TUPLE: frame frame-id flags size data ;
TUPLE: id3v2-info header frames ; 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> ( header frames -- object )
[ [ frame-id>> ] keep ] H{ } map>assoc [ [ frame-id>> ] keep ] H{ } map>assoc
@ -186,25 +85,12 @@ TUPLE: id3-info title artist album year comment genre ;
: filter-text-data ( data -- filtered ) : filter-text-data ( data -- filtered )
[ printable? ] filter ; inline [ printable? ] filter ; inline
! frame details stuff
: valid-frame-id? ( id -- ? ) : valid-frame-id? ( id -- ? )
[ { [ digit? ] [ LETTER? ] } 1|| ] all? ; inline [ { [ 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 ) : read-frame-data ( frame mmap -- frame data )
[ 10 over size>> 10 + ] dip <slice> filter-text-data ; inline [ 10 over size>> 10 + ] dip <slice> filter-text-data ; inline
! read whole frames
: decode-text ( string -- string' ) : decode-text ( string -- string' )
dup 2 short head dup 2 short head
{ { HEX: ff HEX: fe } { HEX: fe HEX: ff } } member? { { 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 ) : (read-frame) ( mmap -- frame )
[ <frame> ] dip [ <frame> ] dip
{ {
[ read-frame-id decode-text >>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 decode-text >>data ] [ read-frame-data decode-text >>data ]
} cleave ; } cleave ;
: read-frame ( mmap -- frame/f ) : read-frame ( mmap -- frame/f )
dup read-frame-id valid-frame-id? dup 4 head-slice valid-frame-id?
[ (read-frame) ] [ drop f ] if ; [ (read-frame) ] [ drop f ] if ;
: remove-frame ( mmap frame -- mmap ) : remove-frame ( mmap frame -- mmap )
@ -233,54 +119,32 @@ TUPLE: id3-info title artist album year comment genre ;
! header stuff ! header stuff
: read-header-supported-version? ( mmap -- ? ) : read-v2-header ( seq -- id3header )
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 )
[ <header> ] dip [ <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 ; inline } cleave ; inline
: drop-header ( mmap -- seq1 seq2 )
[ 10 tail-slice ] [ ] bi ; inline
: read-v2-tag-data ( seq -- id3v2-info ) : read-v2-tag-data ( seq -- id3v2-info )
drop-header read-v2-header 10 cut-slice
swap read-frames <id3v2-info> ; inline [ read-v2-header ]
[ read-frames ] bi* <id3v2-info> ; inline
! v1 information ! v1 information
: skip-to-v1-data ( seq -- seq ) 125 tail-slice* ; inline : 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 ) : (read-v1-tag-data) ( seq -- mp3-file )
[ <id3-info> ] dip [ <id3v1-info> ] dip
{ {
[ read-title decode-text filter-text-data >>title ] [ 30 head-slice decode-text filter-text-data >>title ]
[ read-artist decode-text filter-text-data >>artist ] [ [ 30 60 ] dip subseq decode-text filter-text-data >>artist ]
[ read-album decode-text filter-text-data >>album ] [ [ 60 90 ] dip subseq decode-text filter-text-data >>album ]
[ read-year decode-text filter-text-data >>year ] [ [ 90 94 ] dip subseq decode-text filter-text-data >>year ]
[ read-comment decode-text filter-text-data >>comment ] [ [ 94 124 ] dip subseq decode-text filter-text-data >>comment ]
[ read-genre number>string >>genre ] [ [ 124 ] dip nth number>string >>genre ]
} cleave ; inline } cleave ; inline
: read-v1-tag-data ( seq -- mp3-file ) : read-v1-tag-data ( seq -- mp3-file )