diff --git a/basis/stack-checker/errors/errors.factor b/basis/stack-checker/errors/errors.factor index 6a9a7cb8af..7f35ece714 100644 --- a/basis/stack-checker/errors/errors.factor +++ b/basis/stack-checker/errors/errors.factor @@ -80,4 +80,4 @@ TUPLE: inconsistent-recursive-call-error word ; TUPLE: unknown-primitive-error ; : unknown-primitive-error ( -- * ) - \ unknown-primitive-error inference-error ; + \ unknown-primitive-error inference-warning ; diff --git a/basis/stack-checker/known-words/known-words.factor b/basis/stack-checker/known-words/known-words.factor index 0c20c41d99..1b4d9012db 100644 --- a/basis/stack-checker/known-words/known-words.factor +++ b/basis/stack-checker/known-words/known-words.factor @@ -141,9 +141,7 @@ M: object infer-call* apply-word/effect ; : infer-exit ( -- ) - \ exit - { integer } { } t >>terminated? - apply-word/effect ; + \ exit (( n -- * )) apply-word/effect ; : infer-load-locals ( -- ) pop-literal nip @@ -189,7 +187,7 @@ M: object infer-call* { \ load-locals [ infer-load-locals ] } { \ get-local [ infer-get-local ] } { \ drop-locals [ infer-drop-locals ] } - { \ do-primitive [ unknown-primitive-error inference-warning ] } + { \ do-primitive [ unknown-primitive-error ] } { \ alien-invoke [ infer-alien-invoke ] } { \ alien-indirect [ infer-alien-indirect ] } { \ alien-callback [ infer-alien-callback ] } @@ -207,7 +205,7 @@ M: object infer-call* { declare call (call) slip 2slip 3slip dip 2dip 3dip curry compose execute (execute) if dispatch - (throw) load-local load-locals get-local drop-locals do-primitive + (throw) exit load-local load-locals get-local drop-locals do-primitive alien-invoke alien-indirect alien-callback } [ t "special" set-word-prop ] each diff --git a/basis/stack-checker/stack-checker-tests.factor b/basis/stack-checker/stack-checker-tests.factor index bc6eb9f092..fadfadd885 100644 --- a/basis/stack-checker/stack-checker-tests.factor +++ b/basis/stack-checker/stack-checker-tests.factor @@ -6,7 +6,8 @@ quotations effects tools.test continuations generic.standard sorting assocs definitions prettyprint io inspector classes.tuple classes.union classes.predicate debugger threads.private io.streams.string io.timeouts io.thread -sequences.private destructors combinators eval locals.backend ; +sequences.private destructors combinators eval locals.backend +system ; IN: stack-checker.tests \ infer. must-infer @@ -581,4 +582,6 @@ DEFER: eee' : debugging-curry-folding ( quot -- ) [ debugging-curry-folding ] curry call ; inline recursive -[ [ ] debugging-curry-folding ] must-infer \ No newline at end of file +[ [ ] debugging-curry-folding ] must-infer + +[ [ exit ] [ 1 2 3 ] if ] must-infer \ No newline at end of file diff --git a/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..d1397285d7 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 ( -- object ) id3-info new ; +: ( -- object ) id3v1-info new ; : ( header frames -- object ) [ [ frame-id>> ] keep ] H{ } map>assoc @@ -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 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 ) [ ] 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 >28bitword ; inline - -: read-v2-header ( mmap -- id3header ) +: read-v2-header ( seq -- id3header ) [
] dip { - [ read-header-supported-version? >>version ] - [ read-header-flags >>flags ] - [ read-header-size >>size ] + [ [ 3 5 ] dip >array >>version ] + [ [ 5 ] dip nth >>flags ] + [ [ 6 10 ] dip >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 ; inline + 10 cut-slice + [ read-v2-header ] + [ read-frames ] bi* ; 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 ) - [ ] dip + [ ] 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 )