From 11117648ea21caa85d057117a2e546c89b6fdee3 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Thu, 26 Feb 2009 23:30:48 -0600 Subject: [PATCH 1/3] 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? - 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 From 16e394517c278639bc7a05012a33cffc12a0a0b3 Mon Sep 17 00:00:00 2001 From: sheeple Date: Fri, 27 Feb 2009 00:23:04 -0600 Subject: [PATCH 2/3] 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 > 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 { - [ 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 Date: Fri, 27 Feb 2009 00:27:39 -0600 Subject: [PATCH 3/3] 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 ; -: ( -- object ) id3-info new ; +: ( -- object ) id3v1-info new ; : ( 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 ) - [ ] dip + [ ] 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 ;