From 3c859a77bfe8fdeea191c4132768f7928aa4f0b1 Mon Sep 17 00:00:00 2001
From: Samuel Tardieu <sam@rfc1149.net>
Date: Wed, 18 Feb 2009 01:56:54 +0100
Subject: [PATCH 01/22] Simplify most
---
core/kernel/kernel.factor | 3 +--
1 file changed, 1 insertion(+), 2 deletions(-)
diff --git a/core/kernel/kernel.factor b/core/kernel/kernel.factor
index 06fe289281..697000920a 100644
--- a/core/kernel/kernel.factor
+++ b/core/kernel/kernel.factor
@@ -185,8 +185,7 @@ PRIVATE>
: either? ( x y quot -- ? ) bi@ or ; inline
-: most ( x y quot -- z )
- [ 2dup ] dip call [ drop ] [ nip ] if ; inline
+: most ( x y quot -- z ) 2keep ? ; inline
! Loops
: loop ( pred: ( -- ? ) -- )
From 087d931c36ebdc60fafd0c02e77486ea95d289bb Mon Sep 17 00:00:00 2001
From: Samuel Tardieu <sam@rfc1149.net>
Date: Wed, 18 Feb 2009 02:19:49 +0100
Subject: [PATCH 02/22] Remove the tail argument from do/until/while
---
basis/bit-arrays/bit-arrays.factor | 2 +-
.../tree/propagation/propagation-tests.factor | 2 +-
basis/concurrency/mailboxes/mailboxes.factor | 2 +-
basis/deques/deques.factor | 2 +-
basis/formatting/formatting.factor | 2 +-
basis/io/monitors/monitors-tests.factor | 4 ++--
basis/io/pools/pools.factor | 2 +-
basis/io/thread/thread.factor | 2 +-
basis/math/functions/functions.factor | 2 +-
basis/math/primes/factors/factors.factor | 4 ++--
basis/math/primes/primes.factor | 2 +-
basis/random/random.factor | 2 +-
basis/stack-checker/stack-checker-tests.factor | 2 +-
basis/threads/threads.factor | 2 +-
basis/tools/walker/walker.factor | 6 +++---
basis/ui/event-loop/event-loop.factor | 2 +-
basis/ui/tools/interactor/interactor-tests.factor | 2 +-
basis/ui/ui.factor | 2 +-
core/io/io.factor | 2 +-
core/kernel/kernel-docs.factor | 12 +++---------
core/kernel/kernel.factor | 12 ++++++------
core/math/integers/integers.factor | 4 ++--
core/sequences/sequences.factor | 2 +-
core/slots/slots.factor | 2 +-
core/sorting/sorting.factor | 2 +-
extra/adsoda/adsoda.factor | 2 +-
extra/bubble-chamber/bubble-chamber.factor | 8 ++++----
extra/graph-theory/graph-theory.factor | 2 +-
extra/irc/ui/ui.factor | 2 +-
extra/otug-talk/otug-talk.factor | 2 +-
extra/project-euler/012/012.factor | 2 +-
extra/project-euler/014/014.factor | 2 +-
extra/project-euler/100/100.factor | 2 +-
unmaintained/combinators-lib/lib.factor | 7 ++-----
34 files changed, 50 insertions(+), 59 deletions(-)
diff --git a/basis/bit-arrays/bit-arrays.factor b/basis/bit-arrays/bit-arrays.factor
index 3da22e09d6..e7dd6695a7 100644
--- a/basis/bit-arrays/bit-arrays.factor
+++ b/basis/bit-arrays/bit-arrays.factor
@@ -78,7 +78,7 @@ M: bit-array byte-length length 7 + -3 shift ;
[ dup 0 = ] [
[ pick underlying>> pick set-alien-unsigned-1 ] keep
[ 1+ ] [ -8 shift ] bi*
- ] [ ] until 2drop
+ ] until 2drop
] if ;
: bit-array>integer ( bit-array -- n )
diff --git a/basis/compiler/tree/propagation/propagation-tests.factor b/basis/compiler/tree/propagation/propagation-tests.factor
index b9a88de34a..f261b8747f 100644
--- a/basis/compiler/tree/propagation/propagation-tests.factor
+++ b/basis/compiler/tree/propagation/propagation-tests.factor
@@ -441,7 +441,7 @@ TUPLE: mixed-mutable-immutable { x integer } { y sequence read-only } ;
[ V{ real } ] [ [ recursive-test-3 ] final-classes ] unit-test
-[ V{ real } ] [ [ [ dup 10 < ] [ ] [ ] while ] final-classes ] unit-test
+[ V{ real } ] [ [ [ dup 10 < ] while ] final-classes ] unit-test
[ V{ float } ] [
[ { float } declare 10 [ 2.3 * ] times ] final-classes
diff --git a/basis/concurrency/mailboxes/mailboxes.factor b/basis/concurrency/mailboxes/mailboxes.factor
index 656fbbb591..6dcf3dc34f 100755
--- a/basis/concurrency/mailboxes/mailboxes.factor
+++ b/basis/concurrency/mailboxes/mailboxes.factor
@@ -57,7 +57,7 @@ M: mailbox dispose* threads>> notify-all ;
f mailbox-get-all-timeout ;
: while-mailbox-empty ( mailbox quot -- )
- [ '[ _ mailbox-empty? ] ] dip [ ] while ; inline
+ [ '[ _ mailbox-empty? ] ] dip while ; inline
: mailbox-get-timeout? ( mailbox timeout pred -- obj )
[ block-unless-pred ]
diff --git a/basis/deques/deques.factor b/basis/deques/deques.factor
index 73769cc4d2..1e1be404a7 100644
--- a/basis/deques/deques.factor
+++ b/basis/deques/deques.factor
@@ -36,6 +36,6 @@ GENERIC: deque-empty? ( deque -- ? )
: slurp-deque ( deque quot -- )
[ drop '[ _ deque-empty? not ] ]
[ '[ _ pop-back @ ] ]
- 2bi [ ] while ; inline
+ 2bi while ; inline
MIXIN: deque
diff --git a/basis/formatting/formatting.factor b/basis/formatting/formatting.factor
index 5a1e3650fe..ac0b0850b4 100644
--- a/basis/formatting/formatting.factor
+++ b/basis/formatting/formatting.factor
@@ -41,7 +41,7 @@ IN: formatting
[ dup 10.0 >=
[ 10.0 / [ 1+ ] dip ]
[ 10.0 * [ 1- ] dip ] if
- ] [ ] while
+ ] while
] keep 0 < [ neg ] when ;
: exp>string ( exp base digits -- string )
diff --git a/basis/io/monitors/monitors-tests.factor b/basis/io/monitors/monitors-tests.factor
index 8252b6ef72..576ac7ca30 100644
--- a/basis/io/monitors/monitors-tests.factor
+++ b/basis/io/monitors/monitors-tests.factor
@@ -101,13 +101,13 @@ os { winnt linux macosx } member? [
! Non-recursive
[ ] [ "monitor-timeout-test" temp-file f <monitor> "m" set ] unit-test
[ ] [ 3 seconds "m" get set-timeout ] unit-test
- [ [ t ] [ "m" get next-change drop ] [ ] while ] must-fail
+ [ [ t ] [ "m" get next-change drop ] while ] must-fail
[ ] [ "m" get dispose ] unit-test
! Recursive
[ ] [ "monitor-timeout-test" temp-file t <monitor> "m" set ] unit-test
[ ] [ 3 seconds "m" get set-timeout ] unit-test
- [ [ t ] [ "m" get next-change drop ] [ ] while ] must-fail
+ [ [ t ] [ "m" get next-change drop ] while ] must-fail
[ ] [ "m" get dispose ] unit-test
] with-monitors
] when
diff --git a/basis/io/pools/pools.factor b/basis/io/pools/pools.factor
index 2c1f8ea3c3..e03bdeabf9 100644
--- a/basis/io/pools/pools.factor
+++ b/basis/io/pools/pools.factor
@@ -35,7 +35,7 @@ GENERIC: make-connection ( pool -- conn )
: acquire-connection ( pool -- conn )
dup check-pool
- [ dup connections>> empty? ] [ dup new-connection ] [ ] while
+ [ dup connections>> empty? ] [ dup new-connection ] while
connections>> pop ;
: (with-pooled-connection) ( conn pool quot -- )
diff --git a/basis/io/thread/thread.factor b/basis/io/thread/thread.factor
index 7589d4918e..88db135f44 100644
--- a/basis/io/thread/thread.factor
+++ b/basis/io/thread/thread.factor
@@ -11,7 +11,7 @@ SYMBOL: io-thread-running?
sleep-time io-multiplex yield ;
: start-io-thread ( -- )
- [ [ io-thread-running? get-global ] [ io-thread ] [ ] while ]
+ [ [ io-thread-running? get-global ] [ io-thread ] while ]
"I/O wait" spawn drop ;
[
diff --git a/basis/math/functions/functions.factor b/basis/math/functions/functions.factor
index 85b4d711ac..605744b65f 100644
--- a/basis/math/functions/functions.factor
+++ b/basis/math/functions/functions.factor
@@ -39,7 +39,7 @@ M: real sqrt
: factor-2s ( n -- r s )
#! factor an integer into 2^r * s
dup 0 = [ 1 ] [
- 0 swap [ dup even? ] [ [ 1+ ] [ 2/ ] bi* ] [ ] while
+ 0 swap [ dup even? ] [ [ 1+ ] [ 2/ ] bi* ] while
] if ; inline
<PRIVATE
diff --git a/basis/math/primes/factors/factors.factor b/basis/math/primes/factors/factors.factor
index 4c36fc0a85..beab0ac5a6 100644
--- a/basis/math/primes/factors/factors.factor
+++ b/basis/math/primes/factors/factors.factor
@@ -7,7 +7,7 @@ IN: math.primes.factors
: count-factor ( n d -- n' c )
[ 1 ] 2dip [ /i ] keep
- [ dupd /mod zero? ] curry [ nip [ 1+ ] dip ] [ drop ] while
+ [ dupd /mod zero? ] curry [ nip [ 1+ ] dip ] while drop
swap ;
: write-factor ( n d -- n' d )
@@ -18,7 +18,7 @@ PRIVATE>
: group-factors ( n -- seq )
[
2
- [ 2dup sq < ] [ write-factor next-prime ] [ ] until
+ [ 2dup sq < ] [ write-factor next-prime ] until
drop dup 2 < [ drop ] [ 1 2array , ] if
] { } make ;
diff --git a/basis/math/primes/primes.factor b/basis/math/primes/primes.factor
index 807ebf097b..688fdad713 100644
--- a/basis/math/primes/primes.factor
+++ b/basis/math/primes/primes.factor
@@ -21,7 +21,7 @@ PRIVATE>
} cond ; foldable
: next-prime ( n -- p )
- next-odd [ dup really-prime? ] [ 2 + ] [ ] until ; foldable
+ next-odd [ dup really-prime? ] [ 2 + ] until ; foldable
: primes-between ( low high -- seq )
[ dup 3 max dup even? [ 1 + ] when ] dip
diff --git a/basis/random/random.factor b/basis/random/random.factor
index 17bcc8f1b1..26b328b291 100755
--- a/basis/random/random.factor
+++ b/basis/random/random.factor
@@ -55,7 +55,7 @@ PRIVATE>
: randomize ( seq -- seq )
dup length [ dup 1 > ]
[ [ random ] [ 1- ] bi [ pick exchange ] keep ]
- [ ] while drop ;
+ while drop ;
: delete-random ( seq -- elt )
[ length random-integer ] keep [ nth ] 2keep delete-nth ;
diff --git a/basis/stack-checker/stack-checker-tests.factor b/basis/stack-checker/stack-checker-tests.factor
index bc6eb9f092..6cfe80dbf6 100644
--- a/basis/stack-checker/stack-checker-tests.factor
+++ b/basis/stack-checker/stack-checker-tests.factor
@@ -513,7 +513,7 @@ ERROR: custom-error ;
! Corner case
[ [ [ f dup ] [ dup ] [ ] produce ] infer ] must-fail
-[ [ [ f dup ] [ ] [ ] while ] infer ] must-fail
+[ [ [ f dup ] while ] infer ] must-fail
: erg's-inference-bug ( -- ) f dup [ erg's-inference-bug ] when ; inline
diff --git a/basis/threads/threads.factor b/basis/threads/threads.factor
index 305ef0cca3..e168653f1d 100644
--- a/basis/threads/threads.factor
+++ b/basis/threads/threads.factor
@@ -115,7 +115,7 @@ DEFER: stop
sleep-queue
[ dup expire-sleep? ]
[ dup heap-pop drop expire-sleep ]
- [ ] while
+ while
drop ;
: start ( namestack thread -- )
diff --git a/basis/tools/walker/walker.factor b/basis/tools/walker/walker.factor
index 8915d2d611..119a2e8587 100644
--- a/basis/tools/walker/walker.factor
+++ b/basis/tools/walker/walker.factor
@@ -205,7 +205,7 @@ SYMBOL: +stopped+
]
} case
] handle-synchronous
- ] [ ] while ;
+ ] while ;
: step-back-msg ( continuation -- continuation' )
walker-history tget
@@ -233,7 +233,7 @@ SYMBOL: +stopped+
{ step-back [ step-back-msg ] }
} case f
] handle-synchronous
- ] [ ] while ;
+ ] while ;
: walker-loop ( -- )
+running+ set-status
@@ -256,7 +256,7 @@ SYMBOL: +stopped+
[ walker-suspended ]
} case
] handle-synchronous
- ] [ ] until ;
+ ] until ;
: associate-thread ( walker -- )
walker-thread tset
diff --git a/basis/ui/event-loop/event-loop.factor b/basis/ui/event-loop/event-loop.factor
index 7c08d802f5..26983e3b95 100644
--- a/basis/ui/event-loop/event-loop.factor
+++ b/basis/ui/event-loop/event-loop.factor
@@ -13,6 +13,6 @@ IN: ui.event-loop
HOOK: do-events ui-backend ( -- )
-: event-loop ( -- ) [ event-loop? ] [ do-events ] [ ] while ;
+: event-loop ( -- ) [ event-loop? ] [ do-events ] while ;
: ui-wait ( -- ) 10 milliseconds sleep ;
diff --git a/basis/ui/tools/interactor/interactor-tests.factor b/basis/ui/tools/interactor/interactor-tests.factor
index 628570c3e3..101b7307dd 100644
--- a/basis/ui/tools/interactor/interactor-tests.factor
+++ b/basis/ui/tools/interactor/interactor-tests.factor
@@ -22,7 +22,7 @@ tools.test kernel calendar parser accessors calendar io ;
! This should not throw an exception
[ ] [ "interactor" get evaluate-input ] unit-test
- [ ] [ [ "interactor" get interactor-busy? ] [ yield ] [ ] while ] unit-test
+ [ ] [ [ "interactor" get interactor-busy? ] [ yield ] while ] unit-test
[ ] [ "[ 1 2 3 ]" "interactor" get set-editor-string ] unit-test
diff --git a/basis/ui/ui.factor b/basis/ui/ui.factor
index 78f150987f..769dc9c64e 100644
--- a/basis/ui/ui.factor
+++ b/basis/ui/ui.factor
@@ -155,7 +155,7 @@ SYMBOL: ui-thread
: update-ui-loop ( -- )
[ ui-running? ui-thread get-global self eq? and ]
[ ui-notify-flag get lower-flag update-ui ]
- [ ] while ;
+ while ;
: start-ui-thread ( -- )
[ self ui-thread set-global update-ui-loop ]
diff --git a/core/io/io.factor b/core/io/io.factor
index 11a2a6d1a8..52ac23622a 100644
--- a/core/io/io.factor
+++ b/core/io/io.factor
@@ -70,7 +70,7 @@ SYMBOL: error-stream
<PRIVATE
: each-morsel ( handler: ( data -- ) reader: ( -- data ) -- )
- [ dup ] compose swap [ drop ] while ; inline
+ [ dup ] compose swap while drop ; inline
PRIVATE>
diff --git a/core/kernel/kernel-docs.factor b/core/kernel/kernel-docs.factor
index b8191004db..fcc70cc8e5 100644
--- a/core/kernel/kernel-docs.factor
+++ b/core/kernel/kernel-docs.factor
@@ -637,15 +637,15 @@ HELP: 4dip
} ;
HELP: while
-{ $values { "pred" { $quotation "( -- ? )" } } { "body" "a quotation" } { "tail" "a quotation" } }
+{ $values { "pred" { $quotation "( -- ? )" } } { "body" "a quotation" } }
{ $description "Calls " { $snippet "body" } " until " { $snippet "pred" } " returns " { $link f } "." } ;
HELP: until
-{ $values { "pred" { $quotation "( -- ? )" } } { "body" "a quotation" } { "tail" "a quotation" } }
+{ $values { "pred" { $quotation "( -- ? )" } } { "body" "a quotation" } }
{ $description "Calls " { $snippet "body" } " until " { $snippet "pred" } " returns " { $link t } "." } ;
HELP: do
-{ $values { "pred" { $quotation "( -- ? )" } } { "body" "a quotation" } { "tail" "a quotation" } }
+{ $values { "pred" { $quotation "( -- ? )" } } { "body" "a quotation" } }
{ $description "Executes one iteration of a " { $link while } " or " { $link until } " loop." } ;
HELP: loop
@@ -666,12 +666,6 @@ ARTICLE: "looping-combinators" "Looping combinators"
"In most cases, loops should be written using high-level combinators (such as " { $link "sequences-combinators" } ") or tail recursion. However, sometimes, the best way to express intent is with a loop."
{ $subsection while }
{ $subsection until }
-"The above two combinators take a " { $snippet "tail" } " quotation. Strictly speaking, the " { $snippet "tail" } " is not necessary, since the following are equivalent:"
-{ $code
- "[ P ] [ Q ] [ T ] while"
- "[ P ] [ Q ] [ ] while T"
-}
-"However, depending on the stack effects of " { $snippet "pred" } " and " { $snippet "quot" } ", the " { $snippet "tail" } " quotation might need to be non-empty in order to balance out the stack effect of branches for stack effect inference."
$nl
"To execute one iteration of a loop, use the following word:"
{ $subsection do }
diff --git a/core/kernel/kernel.factor b/core/kernel/kernel.factor
index 697000920a..cf4bf95db9 100644
--- a/core/kernel/kernel.factor
+++ b/core/kernel/kernel.factor
@@ -191,14 +191,14 @@ PRIVATE>
: loop ( pred: ( -- ? ) -- )
[ call ] keep [ loop ] curry when ; inline recursive
-: do ( pred body tail -- pred body tail )
- over 3dip ; inline
+: do ( pred body -- pred body )
+ dup 2dip ; inline
-: while ( pred: ( -- ? ) body: ( -- ) tail: ( -- ) -- )
- [ pick 3dip [ do while ] 3curry ] keep if ; inline recursive
+: while ( pred: ( -- ? ) body: ( -- ) -- )
+ swap do compose [ loop ] curry when ; inline
-: until ( pred: ( -- ? ) body: ( -- ) tail: ( -- ) -- )
- [ [ not ] compose ] 2dip while ; inline
+: until ( pred: ( -- ? ) body: ( -- ) -- )
+ [ [ not ] compose ] dip while ; inline
! Object protocol
GENERIC: hashcode* ( depth obj -- code )
diff --git a/core/math/integers/integers.factor b/core/math/integers/integers.factor
index 6ed945216e..845fdc0fcf 100644
--- a/core/math/integers/integers.factor
+++ b/core/math/integers/integers.factor
@@ -41,7 +41,7 @@ M: fixnum bitnot fixnum-bitnot ;
M: fixnum bit? neg shift 1 bitand 0 > ;
: fixnum-log2 ( x -- n )
- 0 swap [ dup 1 eq? ] [ [ 1+ ] [ 2/ ] bi* ] [ ] until drop ;
+ 0 swap [ dup 1 eq? ] [ [ 1+ ] [ 2/ ] bi* ] until drop ;
M: fixnum (log2) fixnum-log2 ;
@@ -103,7 +103,7 @@ M: bignum (log2) bignum-log2 ;
: /f-loop ( scale mantissa den -- scale' fraction-and-guard rem )
[ 2dup /i log2 53 > ]
[ [ shift-mantissa ] dip ]
- [ ] while /mod ; inline
+ while /mod ; inline
! Third step: post-scaling
: unscaled-float ( mantissa -- n )
diff --git a/core/sequences/sequences.factor b/core/sequences/sequences.factor
index 9e64cfa536..2983520620 100755
--- a/core/sequences/sequences.factor
+++ b/core/sequences/sequences.factor
@@ -488,7 +488,7 @@ PRIVATE>
V{ } clone [ [ push ] curry compose ] keep ; inline
: produce-as ( pred quot tail exemplar -- seq )
- [ swap accumulator [ swap while ] dip ] dip like ; inline
+ [ [ accumulator [ while ] dip ] dip dip ] dip like ; inline
: produce ( pred quot tail -- seq )
{ } produce-as ; inline
diff --git a/core/slots/slots.factor b/core/slots/slots.factor
index 24ff1b0f8b..ea020c5c55 100755
--- a/core/slots/slots.factor
+++ b/core/slots/slots.factor
@@ -199,7 +199,7 @@ M: array make-slot
swap
peel-off-name
peel-off-class
- [ dup empty? ] [ peel-off-attributes ] [ ] until drop
+ [ dup empty? ] [ peel-off-attributes ] until drop
check-initial-value ;
M: slot-spec make-slot
diff --git a/core/sorting/sorting.factor b/core/sorting/sorting.factor
index 938bf17cd2..043505759e 100644
--- a/core/sorting/sorting.factor
+++ b/core/sorting/sorting.factor
@@ -126,7 +126,7 @@ TUPLE: merge
: sort-loop ( merge quot -- )
[ 2 [ over seq>> length over > ] ] dip
[ [ 1 shift 2dup ] dip sort-pass ] curry
- [ ] while 2drop ; inline
+ while 2drop ; inline
: each-pair ( seq quot -- )
[ [ length 1+ 2/ ] keep ] dip
diff --git a/extra/adsoda/adsoda.factor b/extra/adsoda/adsoda.factor
index 01e437bc7d..ec77501b8f 100755
--- a/extra/adsoda/adsoda.factor
+++ b/extra/adsoda/adsoda.factor
@@ -337,7 +337,7 @@ TUPLE: solid dimension silhouettes
: compute-adjacencies ( solid -- solid )
dup dimension>> [ >= ] curry
[ keep swap ] curry MAX-FACE-PER-CORNER swap
- [ [ test-faces-combinaisons ] 2keep 1- ] [ ] while drop ;
+ [ [ test-faces-combinaisons ] 2keep 1- ] while drop ;
: find-adjacencies ( solid -- solid )
erase-old-adjacencies
diff --git a/extra/bubble-chamber/bubble-chamber.factor b/extra/bubble-chamber/bubble-chamber.factor
index 4bddd4b632..713bb223e1 100644
--- a/extra/bubble-chamber/bubble-chamber.factor
+++ b/extra/bubble-chamber/bubble-chamber.factor
@@ -135,7 +135,7 @@ METHOD: collide ( <axion> -- )
0 >>theta-d
0 >>theta-dd
- [ 0.00001 theta-dd-small? ] [ -0.001 0.001 random-theta-dd ] [ ] while
+ [ 0.00001 theta-dd-small? ] [ -0.001 0.001 random-theta-dd ] while
drop ;
@@ -201,7 +201,7 @@ METHOD: collide ( <hadron> -- )
0 >>theta-d
0 >>theta-dd
- [ 0.00001 theta-dd-small? ] [ -0.001 0.001 random-theta-dd ] [ ] while
+ [ 0.00001 theta-dd-small? ] [ -0.001 0.001 random-theta-dd ] while
0 1 0 1 rgba boa >>myc
@@ -302,7 +302,7 @@ METHOD: collide ( <muon> -- )
0 >>theta-d
0 >>theta-dd
- [ 0.001 theta-dd-small? ] [ -0.1 0.1 random-theta-dd ] [ ] while
+ [ 0.001 theta-dd-small? ] [ -0.1 0.1 random-theta-dd ] while
set-good-color
set-anti-color
@@ -355,7 +355,7 @@ METHOD: collide ( <quark> -- )
0 >>theta-d
0 >>theta-dd
- [ 0.00001 theta-dd-small? ] [ -0.001 0.001 random-theta-dd ] [ ] while
+ [ 0.00001 theta-dd-small? ] [ -0.001 0.001 random-theta-dd ] while
drop ;
diff --git a/extra/graph-theory/graph-theory.factor b/extra/graph-theory/graph-theory.factor
index 842f4d1f38..b14832dc03 100644
--- a/extra/graph-theory/graph-theory.factor
+++ b/extra/graph-theory/graph-theory.factor
@@ -78,7 +78,7 @@ PRIVATE>
: full-depth-first ( graph pre post tail -- ? )
'[ [ visited? get [ nip not ] assoc-find ]
[ drop _ _ (depth-first) @ ]
- [ 2drop ] while ] swap search-wrap ; inline
+ while 2drop ] swap search-wrap ; inline
: dag? ( graph -- ? )
V{ } clone swap [ 2dup swap push dupd
diff --git a/extra/irc/ui/ui.factor b/extra/irc/ui/ui.factor
index 59e4cf6cb4..d788eb3c2c 100755
--- a/extra/irc/ui/ui.factor
+++ b/extra/irc/ui/ui.factor
@@ -152,7 +152,7 @@ M: object handle-inbox
: display ( stream tab -- )
'[ _ [ [ t ]
[ _ dup chat>> hear handle-inbox ]
- [ ] while ] with-output-stream ] "ircv" spawn drop ;
+ while ] with-output-stream ] "ircv" spawn drop ;
: <irc-pane> ( tab -- tab pane )
<scrolling-pane>
diff --git a/extra/otug-talk/otug-talk.factor b/extra/otug-talk/otug-talk.factor
index b52749dbe1..716afc0dc2 100644
--- a/extra/otug-talk/otug-talk.factor
+++ b/extra/otug-talk/otug-talk.factor
@@ -223,7 +223,7 @@ M: png-gadget ungraft* ( gadget -- )
}
{ $slide "Modifiers"
{ $code ": bank ( n -- n )" " readln string>number +" " dup \"Balance: $\" write . ;" }
- { $code "0 [ dup 0 > ] [ bank ] [ ] while" }
+ { $code "0 [ dup 0 > ] [ bank ] while" }
}
{ $slide "Modifiers"
{ $code "0 [ dup 0 > ] [ bank ] [ ] do while" }
diff --git a/extra/project-euler/012/012.factor b/extra/project-euler/012/012.factor
index b25bfc90f1..ff482c6812 100644
--- a/extra/project-euler/012/012.factor
+++ b/extra/project-euler/012/012.factor
@@ -34,7 +34,7 @@ IN: project-euler.012
! --------
: euler012 ( -- answer )
- 8 [ dup nth-triangle tau* 500 < ] [ 1+ ] [ ] while nth-triangle ;
+ 8 [ dup nth-triangle tau* 500 < ] [ 1+ ] while nth-triangle ;
! [ euler012 ] 10 ave-time
! 6573 ms ave run time - 346.27 SD (10 trials)
diff --git a/extra/project-euler/014/014.factor b/extra/project-euler/014/014.factor
index aa04784151..e93e3d11bc 100644
--- a/extra/project-euler/014/014.factor
+++ b/extra/project-euler/014/014.factor
@@ -43,7 +43,7 @@ IN: project-euler.014
PRIVATE>
: collatz ( n -- seq )
- [ [ dup 1 > ] [ dup , next-collatz ] [ ] while , ] { } make ;
+ [ [ dup 1 > ] [ dup , next-collatz ] while , ] { } make ;
: euler014 ( -- answer )
1000000 [1,b] 0 [ collatz longest ] reduce first ;
diff --git a/extra/project-euler/100/100.factor b/extra/project-euler/100/100.factor
index 98dbba19fd..ec372add3b 100644
--- a/extra/project-euler/100/100.factor
+++ b/extra/project-euler/100/100.factor
@@ -26,7 +26,7 @@ IN: project-euler.100
: euler100 ( -- answer )
1 1
[ dup dup 1- * 2 * 10 24 ^ <= ]
- [ tuck 6 * swap - 2 - ] [ ] while nip ;
+ [ tuck 6 * swap - 2 - ] while nip ;
! TODO: solution needs generalization
diff --git a/unmaintained/combinators-lib/lib.factor b/unmaintained/combinators-lib/lib.factor
index 5e78d183b0..9b3abe3984 100755
--- a/unmaintained/combinators-lib/lib.factor
+++ b/unmaintained/combinators-lib/lib.factor
@@ -126,12 +126,9 @@ MACRO: multikeep ( word out-indexes -- ... )
r> [ drop \ r> , ] each
] [ ] make ;
-: do-while ( pred body tail -- )
- [ tuck 2slip ] dip while ; inline
-
: generate ( generator predicate -- obj )
- '[ dup @ dup [ nip ] unless not ]
- swap [ ] do-while ;
+ '[ dup @ dup [ nip ] unless ]
+ swap do until ;
MACRO: predicates ( seq -- quot/f )
dup [ 1quotation [ drop ] prepend ] map
From da2ebe21a651759c9b1e93beccecc2ec603281c2 Mon Sep 17 00:00:00 2001
From: Samuel Tardieu <sam@rfc1149.net>
Date: Wed, 18 Feb 2009 03:00:16 +0100
Subject: [PATCH 03/22] Fix two overzealous [ ] removal in tests
---
basis/compiler/tree/propagation/propagation-tests.factor | 2 +-
basis/stack-checker/stack-checker-tests.factor | 2 +-
2 files changed, 2 insertions(+), 2 deletions(-)
diff --git a/basis/compiler/tree/propagation/propagation-tests.factor b/basis/compiler/tree/propagation/propagation-tests.factor
index f261b8747f..52ae83eb12 100644
--- a/basis/compiler/tree/propagation/propagation-tests.factor
+++ b/basis/compiler/tree/propagation/propagation-tests.factor
@@ -441,7 +441,7 @@ TUPLE: mixed-mutable-immutable { x integer } { y sequence read-only } ;
[ V{ real } ] [ [ recursive-test-3 ] final-classes ] unit-test
-[ V{ real } ] [ [ [ dup 10 < ] while ] final-classes ] unit-test
+[ V{ real } ] [ [ [ dup 10 < ] [ ] while ] final-classes ] unit-test
[ V{ float } ] [
[ { float } declare 10 [ 2.3 * ] times ] final-classes
diff --git a/basis/stack-checker/stack-checker-tests.factor b/basis/stack-checker/stack-checker-tests.factor
index 6cfe80dbf6..d90db8ab89 100644
--- a/basis/stack-checker/stack-checker-tests.factor
+++ b/basis/stack-checker/stack-checker-tests.factor
@@ -513,7 +513,7 @@ ERROR: custom-error ;
! Corner case
[ [ [ f dup ] [ dup ] [ ] produce ] infer ] must-fail
-[ [ [ f dup ] while ] infer ] must-fail
+[ [ [ f dup ] [ ] while ] infer ] must-fail
: erg's-inference-bug ( -- ) f dup [ erg's-inference-bug ] when ; inline
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 04/22] 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 05/22] 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 06/22] 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 07/22] 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 08/22] 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 09/22] 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 10/22] 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 11/22] 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 12/22] 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 13/22] 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 14/22] 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 15/22] 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 16/22] 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 17/22] 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
From 473095b6d58b6181b20d9304a5d889208d244642 Mon Sep 17 00:00:00 2001
From: "Jose A. Ortega Ruiz" <jao@gnu.org>
Date: Sat, 28 Feb 2009 02:29:35 +0100
Subject: [PATCH 18/22] FUEL: Persistent listener history.
---
misc/fuel/fuel-listener.el | 32 +++++++++++++++++++++++++++++++-
1 file changed, 31 insertions(+), 1 deletion(-)
diff --git a/misc/fuel/fuel-listener.el b/misc/fuel/fuel-listener.el
index b8bf4d4b7f..1d23571a0a 100644
--- a/misc/fuel/fuel-listener.el
+++ b/misc/fuel/fuel-listener.el
@@ -59,6 +59,35 @@ buffer."
:type 'boolean
:group 'fuel-listener)
+(defcustom fuel-listener-history-filename (expand-file-name "~/.fuel_history")
+ "File where listener input history is saved, so that it persists between sessions."
+ :type 'filename
+ :group 'fuel-listener)
+
+(defcustom fuel-listener-history-size comint-input-ring-size
+ "Maximum size of the saved listener input history."
+ :type 'integer
+ :group 'fuel-listener)
+
+
+;;; Listener history:
+
+(defun fuel-listener--sentinel (proc event)
+ (when (string= event "finished\n")
+ (with-current-buffer (process-buffer proc)
+ (let ((comint-input-ring-file-name fuel-listener-history-filename))
+ (comint-write-input-ring)
+ (when (buffer-name (current-buffer))
+ (insert "\nBye bye. It's been nice listening to you!\n")
+ (insert "Press C-cz to bring me back.\n" ))))))
+
+(defun fuel-listener--history-setup ()
+ (set (make-local-variable 'comint-input-ring-file-name) fuel-listener-history-filename)
+ (set (make-local-variable 'comint-input-ring-size) fuel-listener-history-size)
+ (add-hook 'kill-buffer-hook 'comint-write-input-ring nil t)
+ (comint-read-input-ring t)
+ (set-process-sentinel (get-buffer-process (current-buffer)) 'fuel-listener--sentinel))
+
;;; Fuel listener buffer/process:
@@ -84,7 +113,8 @@ buffer."
(pop-to-buffer (fuel-listener--buffer))
(make-comint-in-buffer "fuel listener" (current-buffer) factor nil
"-run=listener" (format "-i=%s" image))
- (fuel-listener--wait-for-prompt 10000)
+ (fuel-listener--wait-for-prompt 60000)
+ (fuel-listener--history-setup)
(fuel-con--setup-connection (current-buffer))))
(defun fuel-listener--connect-process (port)
From 87d70e952328e266bf0a19ad202bd0e5d4143a9d Mon Sep 17 00:00:00 2001
From: "Jose A. Ortega Ruiz" <jao@gnu.org>
Date: Sat, 28 Feb 2009 02:56:38 +0100
Subject: [PATCH 19/22] FUEL: Autoloads for customization groups.
---
misc/fuel/fu.el | 13 +++++++++++++
1 file changed, 13 insertions(+)
diff --git a/misc/fuel/fu.el b/misc/fuel/fu.el
index e9217fbd03..01ec0d60e6 100644
--- a/misc/fuel/fu.el
+++ b/misc/fuel/fu.el
@@ -37,5 +37,18 @@
(autoload 'fuel-scaffold-help "fuel-scaffold.el"
"Create a Factor vocabulary help file." t)
+(mapc (lambda (group)
+ (custom-add-load group (symbol-name group))
+ (custom-add-load 'fuel (symbol-name group)))
+ '(fuel fuel-faces
+ factor-mode
+ fuel-autodoc
+ fuel-stack
+ fuel-help
+ fuel-xref
+ fuel-listener
+ fuel-scaffold
+ fuel-debug
+ fuel-mode))
;;; fu.el ends here
From bb0e2a49ba0d0559b83c0b7c51bc636e00780679 Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Sat, 28 Feb 2009 15:01:28 -0600
Subject: [PATCH 20/22] =?UTF-8?q?pr=C3=A9lude=20to=20a=20haiku?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
---
core/system/system.factor | 5 ++++-
1 file changed, 4 insertions(+), 1 deletion(-)
diff --git a/core/system/system.factor b/core/system/system.factor
index 2d8ed1b657..8f587d28c2 100644
--- a/core/system/system.factor
+++ b/core/system/system.factor
@@ -25,9 +25,11 @@ SINGLETON: solaris
SINGLETON: macosx
SINGLETON: linux
+SINGLETON: haiku
+
UNION: bsd freebsd netbsd openbsd macosx ;
-UNION: unix bsd solaris linux ;
+UNION: unix bsd solaris linux haiku ;
: os ( -- class ) \ os get-global ; foldable
@@ -51,6 +53,7 @@ UNION: unix bsd solaris linux ;
{ "solaris" solaris }
{ "macosx" macosx }
{ "linux" linux }
+ { "haiku" haiku }
} at ;
PRIVATE>
From cd53c2bd37dbd2de342f69752e43a04b08a5d1f1 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Sat, 28 Feb 2009 15:31:34 -0600
Subject: [PATCH 21/22] produce and produce-as: don't need third quotation
either
---
basis/bootstrap/image/image.factor | 2 +-
basis/concurrency/mailboxes/mailboxes.factor | 2 +-
basis/environment/winnt/winnt.factor | 3 +--
basis/heaps/heaps.factor | 2 +-
basis/http/http.factor | 2 +-
basis/io/directories/unix/unix.factor | 2 +-
basis/io/directories/windows/windows.factor | 2 +-
basis/io/files/info/windows/windows.factor | 4 +---
basis/math/combinatorics/combinatorics.factor | 2 +-
basis/persistent/deques/deques.factor | 2 +-
basis/persistent/heaps/heaps.factor | 2 +-
basis/quoted-printable/quoted-printable.factor | 4 ++--
basis/regexp/regexp.factor | 2 +-
basis/stack-checker/stack-checker-tests.factor | 2 +-
basis/ui/windows/windows.factor | 6 +-----
basis/unicode/breaks/breaks.factor | 3 +--
basis/unicode/case/case.factor | 2 +-
basis/unix/groups/groups.factor | 2 +-
basis/unix/users/users.factor | 2 +-
basis/unix/utilities/utilities.factor | 2 +-
basis/unix/utmpx/utmpx.factor | 2 +-
core/classes/algebra/algebra.factor | 2 +-
core/effects/parser/parser.factor | 2 +-
core/io/io-docs.factor | 2 +-
core/io/io.factor | 5 ++---
core/kernel/kernel-docs.factor | 3 +--
core/math/parser/parser.factor | 2 +-
core/sequences/sequences-docs.factor | 17 ++++++-----------
core/sequences/sequences.factor | 8 ++++----
extra/id3/id3.factor | 2 +-
extra/iokit/iokit.factor | 4 +---
extra/math/text/utils/utils.factor | 2 +-
extra/multi-methods/multi-methods.factor | 2 +-
extra/project-euler/002/002.factor | 2 +-
extra/project-euler/019/019.factor | 2 +-
extra/project-euler/071/071.factor | 2 +-
extra/project-euler/148/148.factor | 2 +-
extra/project-euler/common/common.factor | 2 +-
38 files changed, 48 insertions(+), 65 deletions(-)
diff --git a/basis/bootstrap/image/image.factor b/basis/bootstrap/image/image.factor
index 10cde266cc..5c76a0fcf8 100644
--- a/basis/bootstrap/image/image.factor
+++ b/basis/bootstrap/image/image.factor
@@ -240,7 +240,7 @@ GENERIC: ' ( obj -- ptr )
#! n is positive or zero.
[ dup 0 > ]
[ [ bignum-bits neg shift ] [ bignum-radix bitand ] bi ]
- [ ] produce nip ;
+ produce nip ;
: emit-bignum ( n -- )
dup dup 0 < [ neg ] when bignum>seq
diff --git a/basis/concurrency/mailboxes/mailboxes.factor b/basis/concurrency/mailboxes/mailboxes.factor
index 6dcf3dc34f..f6aec94b41 100755
--- a/basis/concurrency/mailboxes/mailboxes.factor
+++ b/basis/concurrency/mailboxes/mailboxes.factor
@@ -51,7 +51,7 @@ M: mailbox dispose* threads>> notify-all ;
block-if-empty
[ dup mailbox-empty? ]
[ dup data>> pop-back ]
- [ ] produce nip ;
+ produce nip ;
: mailbox-get-all ( mailbox -- array )
f mailbox-get-all-timeout ;
diff --git a/basis/environment/winnt/winnt.factor b/basis/environment/winnt/winnt.factor
index 2ad3393aec..eb90a36ee7 100644
--- a/basis/environment/winnt/winnt.factor
+++ b/basis/environment/winnt/winnt.factor
@@ -27,7 +27,6 @@ M: winnt (os-envs) ( -- seq )
GetEnvironmentStrings [
<memory-stream> [
utf16n decode-input
- [ "\0" read-until drop dup empty? not ]
- [ ] [ drop ] produce
+ [ "\0" read-until drop dup empty? not ] [ ] produce nip
] with-input-stream*
] [ FreeEnvironmentStrings win32-error=0/f ] bi ;
diff --git a/basis/heaps/heaps.factor b/basis/heaps/heaps.factor
index aa1ebf7786..564d7db17f 100644
--- a/basis/heaps/heaps.factor
+++ b/basis/heaps/heaps.factor
@@ -190,7 +190,7 @@ M: heap heap-pop ( heap -- value key )
: heap-pop-all ( heap -- alist )
[ dup heap-empty? not ]
[ dup heap-pop swap 2array ]
- [ ] produce nip ;
+ produce nip ;
: slurp-heap ( heap quot: ( elt -- ) -- )
over heap-empty? [ 2drop ] [
diff --git a/basis/http/http.factor b/basis/http/http.factor
index d4acd282f8..a64a11690c 100755
--- a/basis/http/http.factor
+++ b/basis/http/http.factor
@@ -12,7 +12,7 @@ base64 ;
IN: http
: (read-header) ( -- alist )
- [ read-crlf dup f like ] [ parse-header-line ] [ drop ] produce ;
+ [ read-crlf dup f like ] [ parse-header-line ] produce nip ;
: collect-headers ( assoc -- assoc' )
H{ } clone [ '[ _ push-at ] assoc-each ] keep ;
diff --git a/basis/io/directories/unix/unix.factor b/basis/io/directories/unix/unix.factor
index 89e091f919..395ce73d7c 100644
--- a/basis/io/directories/unix/unix.factor
+++ b/basis/io/directories/unix/unix.factor
@@ -61,5 +61,5 @@ M: unix (directory-entries) ( path -- seq )
[
'[ _ find-next-file dup ]
[ >directory-entry ]
- [ drop ] produce
+ produce nip
] with-unix-directory ;
diff --git a/basis/io/directories/windows/windows.factor b/basis/io/directories/windows/windows.factor
index a6dacc1841..7554baa944 100755
--- a/basis/io/directories/windows/windows.factor
+++ b/basis/io/directories/windows/windows.factor
@@ -61,7 +61,7 @@ M: windows (directory-entries) ( path -- seq )
'[
[ _ find-next-file dup ]
[ >directory-entry ]
- [ drop ] produce
+ produce nip
over name>> "." = [ nip ] [ swap prefix ] if
]
] [ '[ _ FindClose win32-error=0/f ] ] bi [ ] cleanup ;
diff --git a/basis/io/files/info/windows/windows.factor b/basis/io/files/info/windows/windows.factor
index cf826a59d3..fdff368491 100755
--- a/basis/io/files/info/windows/windows.factor
+++ b/basis/io/files/info/windows/windows.factor
@@ -159,9 +159,7 @@ M: winnt file-system-info ( path -- file-system-info )
find-first-volume
[
'[
- [ _ find-next-volume dup ]
- [ ]
- [ drop ] produce
+ [ _ find-next-volume dup ] [ ] produce nip
swap prefix
]
] [ '[ _ FindVolumeClose win32-error=0/f ] ] bi [ ] cleanup ;
diff --git a/basis/math/combinatorics/combinatorics.factor b/basis/math/combinatorics/combinatorics.factor
index d5dff65c35..afdf4e378e 100644
--- a/basis/math/combinatorics/combinatorics.factor
+++ b/basis/math/combinatorics/combinatorics.factor
@@ -16,7 +16,7 @@ IN: math.combinatorics
! http://msdn2.microsoft.com/en-us/library/aa302371.aspx
: factoradic ( n -- factoradic )
- 0 [ over 0 > ] [ 1+ [ /mod ] keep swap ] [ ] produce reverse 2nip ;
+ 0 [ over 0 > ] [ 1+ [ /mod ] keep swap ] produce reverse 2nip ;
: (>permutation) ( seq n -- seq )
[ '[ _ dupd >= [ 1+ ] when ] map ] keep prefix ;
diff --git a/basis/persistent/deques/deques.factor b/basis/persistent/deques/deques.factor
index 8f93ae1ab8..91f1dcf1f8 100644
--- a/basis/persistent/deques/deques.factor
+++ b/basis/persistent/deques/deques.factor
@@ -67,4 +67,4 @@ PRIVATE>
<deque> [ push-back ] reduce ;
: deque>sequence ( deque -- sequence )
- [ dup deque-empty? not ] [ pop-front swap ] [ ] produce nip ;
+ [ dup deque-empty? not ] [ pop-front swap ] produce nip ;
diff --git a/basis/persistent/heaps/heaps.factor b/basis/persistent/heaps/heaps.factor
index f6d38b5b25..38a7eb1313 100644
--- a/basis/persistent/heaps/heaps.factor
+++ b/basis/persistent/heaps/heaps.factor
@@ -98,6 +98,6 @@ M: branch pheap-push
<persistent-heap> swap [ rot pheap-push ] assoc-each ;
: pheap>alist ( heap -- alist )
- [ dup pheap-empty? not ] [ pheap-pop 2array ] [ ] produce nip ;
+ [ dup pheap-empty? not ] [ pheap-pop 2array ] produce nip ;
: pheap>values ( heap -- seq ) pheap>alist keys ;
diff --git a/basis/quoted-printable/quoted-printable.factor b/basis/quoted-printable/quoted-printable.factor
index 3be1a07eab..e82789ccbf 100644
--- a/basis/quoted-printable/quoted-printable.factor
+++ b/basis/quoted-printable/quoted-printable.factor
@@ -32,7 +32,7 @@ IN: quoted-printable
[ 1- cut-slice swap ] [ f swap ] if* concat ;
: divide-lines ( strings -- strings )
- [ dup ] [ take-some ] [ ] produce nip ;
+ [ dup ] [ take-some ] produce nip ;
PRIVATE>
@@ -53,7 +53,7 @@ PRIVATE>
] when ;
: read-quoted ( -- bytes )
- [ read1 dup ] [ read-char ] [ drop ] B{ } produce-as ;
+ [ read1 dup ] [ read-char ] B{ } produce-as nip ;
PRIVATE>
diff --git a/basis/regexp/regexp.factor b/basis/regexp/regexp.factor
index 86f978373b..11d257b6b2 100644
--- a/basis/regexp/regexp.factor
+++ b/basis/regexp/regexp.factor
@@ -75,7 +75,7 @@ IN: regexp
[ [ split1-slice nip ] keep ] [ 2drop f f ] if ;
: all-matches ( string regexp -- seq )
- [ dup ] swap '[ _ next-match ] [ ] produce nip harvest ;
+ [ dup ] swap '[ _ next-match ] produce nip harvest ;
: count-matches ( string regexp -- n )
all-matches length ;
diff --git a/basis/stack-checker/stack-checker-tests.factor b/basis/stack-checker/stack-checker-tests.factor
index 4361052b63..6e7774aba1 100644
--- a/basis/stack-checker/stack-checker-tests.factor
+++ b/basis/stack-checker/stack-checker-tests.factor
@@ -512,7 +512,7 @@ ERROR: custom-error ;
[ [ missing->r-check ] infer ] must-fail
! Corner case
-[ [ [ f dup ] [ dup ] [ ] produce ] infer ] must-fail
+[ [ [ f dup ] [ dup ] produce ] infer ] must-fail
[ [ [ f dup ] [ ] while ] infer ] must-fail
diff --git a/basis/ui/windows/windows.factor b/basis/ui/windows/windows.factor
index 9df694ee37..3b4bcd6e17 100755
--- a/basis/ui/windows/windows.factor
+++ b/basis/ui/windows/windows.factor
@@ -22,11 +22,7 @@ SINGLETON: windows-ui-backend
[ [ dup CHAR: \n = [ CHAR: \r , ] when , ] each ] "" make ;
: enum-clipboard ( -- seq )
- 0
- [ EnumClipboardFormats win32-error dup dup 0 > ]
- [ ]
- [ drop ]
- produce nip ;
+ 0 [ EnumClipboardFormats win32-error dup dup 0 > ] [ ] produce 2nip ;
: with-clipboard ( quot -- )
f OpenClipboard win32-error=0/f
diff --git a/basis/unicode/breaks/breaks.factor b/basis/unicode/breaks/breaks.factor
index 2f8daef8b2..ddcb99b829 100644
--- a/basis/unicode/breaks/breaks.factor
+++ b/basis/unicode/breaks/breaks.factor
@@ -102,8 +102,7 @@ PRIVATE>
<PRIVATE
: >pieces ( str quot: ( str -- i ) -- graphemes )
- [ dup empty? not ] swap '[ dup @ cut-slice swap ]
- [ ] produce nip ; inline
+ [ dup empty? not ] swap '[ dup @ cut-slice swap ] produce nip ; inline
PRIVATE>
diff --git a/basis/unicode/case/case.factor b/basis/unicode/case/case.factor
index 3ac98cd57f..c75582dacd 100644
--- a/basis/unicode/case/case.factor
+++ b/basis/unicode/case/case.factor
@@ -18,7 +18,7 @@ SYMBOL: locale ! Just casing locale, or overall?
<PRIVATE
: split-subseq ( string sep -- strings )
- [ dup ] swap '[ _ split1-slice swap ] [ ] produce nip ;
+ [ dup ] swap '[ _ split1-slice swap ] produce nip ;
: replace ( old new str -- newstr )
[ split-subseq ] dip join ; inline
diff --git a/basis/unix/groups/groups.factor b/basis/unix/groups/groups.factor
index b2a50b7374..91feae6471 100644
--- a/basis/unix/groups/groups.factor
+++ b/basis/unix/groups/groups.factor
@@ -77,7 +77,7 @@ M: integer user-groups ( id -- seq )
user-name (user-groups) ;
: all-groups ( -- seq )
- [ getgrent dup ] [ group-struct>group ] [ drop ] produce ;
+ [ getgrent dup ] [ group-struct>group ] produce nip ;
: <group-cache> ( -- assoc )
all-groups [ [ id>> ] keep ] H{ } map>assoc ;
diff --git a/basis/unix/users/users.factor b/basis/unix/users/users.factor
index da38972955..a523f0818b 100644
--- a/basis/unix/users/users.factor
+++ b/basis/unix/users/users.factor
@@ -36,7 +36,7 @@ PRIVATE>
: all-users ( -- seq )
[
- [ getpwent dup ] [ passwd>new-passwd ] [ drop ] produce
+ [ getpwent dup ] [ passwd>new-passwd ] produce nip
] with-pwent ;
SYMBOL: user-cache
diff --git a/basis/unix/utilities/utilities.factor b/basis/unix/utilities/utilities.factor
index 29b137e3de..e1d26eab66 100644
--- a/basis/unix/utilities/utilities.factor
+++ b/basis/unix/utilities/utilities.factor
@@ -14,7 +14,7 @@ IN: unix.utilities
: alien>strings ( alien encoding -- strings )
[ [ dup more? ] ] dip
'[ [ advance ] [ *void* _ alien>string ] bi ]
- [ ] produce nip ;
+ produce nip ;
: strings>alien ( strings encoding -- array )
'[ _ malloc-string ] void*-array{ } map-as f suffix ;
diff --git a/basis/unix/utmpx/utmpx.factor b/basis/unix/utmpx/utmpx.factor
index 9f12bc599b..6e72f7d114 100644
--- a/basis/unix/utmpx/utmpx.factor
+++ b/basis/unix/utmpx/utmpx.factor
@@ -57,7 +57,7 @@ M: unix utmpx>utmpx-record ( utmpx -- utmpx-record )
[
[ getutxent dup ]
[ utmpx>utmpx-record ]
- [ drop ] produce
+ produce nip
] with-utmpx ;
os {
diff --git a/core/classes/algebra/algebra.factor b/core/classes/algebra/algebra.factor
index 825cd67a4d..c774ef1c1d 100755
--- a/core/classes/algebra/algebra.factor
+++ b/core/classes/algebra/algebra.factor
@@ -210,7 +210,7 @@ M: anonymous-complement (classes-intersect?)
[ [ name>> ] compare ] sort >vector
[ dup empty? not ]
[ dup largest-class [ over delete-nth ] dip ]
- [ ] produce nip ;
+ produce nip ;
: min-class ( class seq -- class/f )
over [ classes-intersect? ] curry filter
diff --git a/core/effects/parser/parser.factor b/core/effects/parser/parser.factor
index 6b7e953b6c..a009db76b1 100644
--- a/core/effects/parser/parser.factor
+++ b/core/effects/parser/parser.factor
@@ -21,7 +21,7 @@ ERROR: bad-effect ;
] if ;
: parse-effect-tokens ( end -- tokens )
- [ parse-effect-token dup ] curry [ ] [ drop ] produce ;
+ [ parse-effect-token dup ] curry [ ] produce nip ;
: parse-effect ( end -- effect )
parse-effect-tokens { "--" } split1 dup
diff --git a/core/io/io-docs.factor b/core/io/io-docs.factor
index 5d8aa6a88f..489cac6703 100644
--- a/core/io/io-docs.factor
+++ b/core/io/io-docs.factor
@@ -224,7 +224,7 @@ $io-error ;
ARTICLE: "stream-protocol" "Stream protocol"
"The stream protocol consists of a large number of generic words, many of which are optional."
$nl
-"Stream protocol words are rarely called directly, since code which only works with one stream at a time should be written use " { $link "stdio" } " instead, wrapping I/O operations such as " { $link read } " and " { $link write } " in " { $link with-input-stream } " and " { $link with-output-stream } "."
+"Stream protocol words are rarely called directly, since code which only works with one stream at a time should be written to use " { $link "stdio" } " instead, wrapping I/O operations such as " { $link read } " and " { $link write } " in " { $link with-input-stream } " and " { $link with-output-stream } "."
$nl
"All streams must implement the " { $link dispose } " word in addition to the stream protocol."
$nl
diff --git a/core/io/io.factor b/core/io/io.factor
index 52ac23622a..cb68b1c4fe 100644
--- a/core/io/io.factor
+++ b/core/io/io.factor
@@ -65,7 +65,7 @@ SYMBOL: error-stream
: bl ( -- ) " " write ;
: lines ( stream -- seq )
- [ [ readln dup ] [ ] [ drop ] produce ] with-input-stream ;
+ [ [ readln dup ] [ ] produce nip ] with-input-stream ;
<PRIVATE
@@ -79,8 +79,7 @@ PRIVATE>
: contents ( stream -- seq )
[
- [ 65536 read-partial dup ]
- [ ] [ drop ] produce concat f like
+ [ 65536 read-partial dup ] [ ] produce nip concat f like
] with-input-stream ;
: each-block ( quot: ( block -- ) -- )
diff --git a/core/kernel/kernel-docs.factor b/core/kernel/kernel-docs.factor
index c2719c056a..800bc86b66 100644
--- a/core/kernel/kernel-docs.factor
+++ b/core/kernel/kernel-docs.factor
@@ -667,12 +667,11 @@ ARTICLE: "looping-combinators" "Looping combinators"
"In most cases, loops should be written using high-level combinators (such as " { $link "sequences-combinators" } ") or tail recursion. However, sometimes, the best way to express intent is with a loop."
{ $subsection while }
{ $subsection until }
-$nl
"To execute one iteration of a loop, use the following word:"
{ $subsection do }
"This word is intended as a modifier. The normal " { $link while } " loop never executes the body if the predicate returns first on the first iteration. To ensure the body executes at least once, use " { $link do } ":"
{ $code
- "[ P ] [ Q ] [ T ] do while"
+ "[ P ] [ Q ] do while"
}
"A simpler looping combinator which executes a single quotation until it returns " { $link f } ":"
{ $subsection loop } ;
diff --git a/core/math/parser/parser.factor b/core/math/parser/parser.factor
index ac6c5e9790..0d8f0c0b08 100644
--- a/core/math/parser/parser.factor
+++ b/core/math/parser/parser.factor
@@ -96,7 +96,7 @@ PRIVATE>
: positive>base ( num radix -- str )
dup 1 <= [ "Invalid radix" throw ] when
- [ dup 0 > ] swap [ /mod >digit ] curry [ ] "" produce-as nip
+ [ dup 0 > ] swap [ /mod >digit ] curry "" produce-as nip
dup reverse-here ; inline
PRIVATE>
diff --git a/core/sequences/sequences-docs.factor b/core/sequences/sequences-docs.factor
index c12761ab38..67084e256f 100755
--- a/core/sequences/sequences-docs.factor
+++ b/core/sequences/sequences-docs.factor
@@ -915,24 +915,19 @@ HELP: supremum
{ $errors "Throws an error if the sequence is empty." } ;
HELP: produce
-{ $values { "pred" { $quotation "( -- ? )" } } { "quot" { $quotation "( -- obj )" } } { "tail" "a quotation" } { "seq" "a sequence" } }
+{ $values { "pred" { $quotation "( -- ? )" } } { "quot" { $quotation "( -- obj )" } } { "seq" "a sequence" } }
{ $description "Calls " { $snippet "pred" } " repeatedly. If the predicate yields " { $link f } ", stops, otherwise, calls " { $snippet "quot" } " to yield a value. Values are accumulated and returned in a sequence at the end." }
{ $examples
"The following example divides a number by two until we reach zero, and accumulates intermediate results:"
- { $example "USING: kernel math prettyprint sequences ;" "1337 [ dup 0 > ] [ 2/ dup ] [ ] produce nip ." "{ 668 334 167 83 41 20 10 5 2 1 0 }" }
- "The " { $snippet "tail" } " quotation is used when the predicate produces more than one output value. In this case, we have to drop this value even if the predicate fails in order for stack inference to calculate a stack effect for the " { $link produce } " call:"
- { $unchecked-example "USING: kernel prettyprint random sequences ;" "[ 10 random dup 1 > ] [ ] [ drop ] produce ." "{ 8 2 2 9 }" }
+ { $example "USING: kernel math prettyprint sequences ;" "1337 [ dup 0 > ] [ 2/ dup ] produce nip ." "{ 668 334 167 83 41 20 10 5 2 1 0 }" }
+ "The following example collects random numbers as long as they are greater than 1:"
+ { $unchecked-example "USING: kernel prettyprint random sequences ;" "[ 10 random dup 1 > ] [ ] produce nip ." "{ 8 2 2 9 }" }
} ;
HELP: produce-as
-{ $values { "pred" { $quotation "( -- ? )" } } { "quot" { $quotation "( -- obj )" } } { "tail" "a quotation" } { "exemplar" sequence } { "seq" "a sequence" } }
+{ $values { "pred" { $quotation "( -- ? )" } } { "quot" { $quotation "( -- obj )" } } { "exemplar" sequence } { "seq" "a sequence" } }
{ $description "Calls " { $snippet "pred" } " repeatedly. If the predicate yields " { $link f } ", stops, otherwise, calls " { $snippet "quot" } " to yield a value. Values are accumulated and returned in a sequence of type " { $snippet "exemplar" } " at the end." }
-{ $examples
- "The following example divides a number by two until we reach zero, and accumulates intermediate results:"
- { $example "USING: kernel math prettyprint sequences ;" "1337 [ dup 0 > ] [ 2/ dup ] [ ] V{ } produce-as nip ." "V{ 668 334 167 83 41 20 10 5 2 1 0 }" }
- "The " { $snippet "tail" } " quotation is used when the predicate produces more than one output value. In this case, we have to drop this value even if the predicate fails in order for stack inference to calculate a stack effect for the " { $link produce } " call:"
- { $unchecked-example "USING: kernel prettyprint random sequences ;" "[ 10 random dup 1 > ] [ ] [ drop ] B{ } produce-as ." "B{ 8 2 2 9 }" }
-} ;
+{ $examples "See " { $link produce } " for examples." } ;
HELP: sigma
{ $values { "seq" sequence } { "quot" quotation } { "n" number } }
diff --git a/core/sequences/sequences.factor b/core/sequences/sequences.factor
index 2983520620..fba7aa3b03 100755
--- a/core/sequences/sequences.factor
+++ b/core/sequences/sequences.factor
@@ -487,14 +487,14 @@ PRIVATE>
: accumulator ( quot -- quot' vec )
V{ } clone [ [ push ] curry compose ] keep ; inline
-: produce-as ( pred quot tail exemplar -- seq )
- [ [ accumulator [ while ] dip ] dip dip ] dip like ; inline
+: produce-as ( pred quot exemplar -- seq )
+ [ accumulator [ while ] dip ] dip like ; inline
-: produce ( pred quot tail -- seq )
+: produce ( pred quot -- seq )
{ } produce-as ; inline
: follow ( obj quot -- seq )
- [ dup ] swap [ keep ] curry [ ] produce nip ; inline
+ [ dup ] swap [ keep ] curry produce nip ; inline
: prepare-index ( seq quot -- seq n quot )
[ dup length ] dip ; inline
diff --git a/extra/id3/id3.factor b/extra/id3/id3.factor
index d1397285d7..f01c400338 100644
--- a/extra/id3/id3.factor
+++ b/extra/id3/id3.factor
@@ -115,7 +115,7 @@ TUPLE: id3v1-info title artist album year comment genre ;
: read-frames ( mmap -- frames )
[ dup read-frame dup ]
[ [ remove-frame ] keep ]
- [ drop ] produce nip ;
+ produce 2nip ;
! header stuff
diff --git a/extra/iokit/iokit.factor b/extra/iokit/iokit.factor
index 3fb14e8ec5..12eb6d6e92 100755
--- a/extra/iokit/iokit.factor
+++ b/extra/iokit/iokit.factor
@@ -166,9 +166,7 @@ M: mach-error error.
IOObjectRelease mach-error ;
: io-objects-from-iterator* ( i -- i array )
- [ dup IOIteratorNext dup MACH_PORT_NULL = not ]
- [ ]
- [ drop ] produce ;
+ [ dup IOIteratorNext dup MACH_PORT_NULL = not ] [ ] produce nip ;
: io-objects-from-iterator ( i -- array )
io-objects-from-iterator* [ release-io-object ] dip ;
diff --git a/extra/math/text/utils/utils.factor b/extra/math/text/utils/utils.factor
index 73326de273..422a79a1f3 100644
--- a/extra/math/text/utils/utils.factor
+++ b/extra/math/text/utils/utils.factor
@@ -4,4 +4,4 @@ USING: kernel math sequences ;
IN: math.text.utils
: 3digit-groups ( n -- seq )
- [ dup 0 > ] [ 1000 /mod ] [ ] produce nip ;
+ [ dup 0 > ] [ 1000 /mod ] produce nip ;
diff --git a/extra/multi-methods/multi-methods.factor b/extra/multi-methods/multi-methods.factor
index 5ad1d944d3..3370ab7f86 100755
--- a/extra/multi-methods/multi-methods.factor
+++ b/extra/multi-methods/multi-methods.factor
@@ -82,7 +82,7 @@ SYMBOL: total
: topological-sort ( seq quot -- newseq )
[ >vector [ dup empty? not ] ] dip
[ dupd maximal-element [ over delete-nth ] dip ] curry
- [ ] produce nip ; inline
+ produce nip ; inline
: classes< ( seq1 seq2 -- lt/eq/gt )
[
diff --git a/extra/project-euler/002/002.factor b/extra/project-euler/002/002.factor
index 9c462b6b2e..136ebbb6da 100644
--- a/extra/project-euler/002/002.factor
+++ b/extra/project-euler/002/002.factor
@@ -41,7 +41,7 @@ PRIVATE>
! -------------------
: fib-upto* ( n -- seq )
- 0 1 [ pick over >= ] [ tuck + dup ] [ ] produce [ 3drop ] dip
+ 0 1 [ pick over >= ] [ tuck + dup ] produce [ 3drop ] dip
but-last-slice { 0 1 } prepend ;
: euler002a ( -- answer )
diff --git a/extra/project-euler/019/019.factor b/extra/project-euler/019/019.factor
index 16a7139f51..4b750ac180 100644
--- a/extra/project-euler/019/019.factor
+++ b/extra/project-euler/019/019.factor
@@ -53,7 +53,7 @@ IN: project-euler.019
: first-days ( end-date start-date -- days )
[ 2dup after=? ]
[ dup 1 months time+ swap day-of-week ]
- [ ] produce 2nip ;
+ produce 2nip ;
PRIVATE>
diff --git a/extra/project-euler/071/071.factor b/extra/project-euler/071/071.factor
index feecd997fa..69d9eb1a03 100644
--- a/extra/project-euler/071/071.factor
+++ b/extra/project-euler/071/071.factor
@@ -40,7 +40,7 @@ IN: project-euler.071
PRIVATE>
: euler071 ( -- answer )
- 2/5 [ dup denominator 1000000 <= ] [ 3/7 mediant dup ] [ ] produce
+ 2/5 [ dup denominator 1000000 <= ] [ 3/7 mediant dup ] produce
nip penultimate numerator ;
! [ euler071 ] 100 ave-time
diff --git a/extra/project-euler/148/148.factor b/extra/project-euler/148/148.factor
index 533874fa67..5aa0299dda 100644
--- a/extra/project-euler/148/148.factor
+++ b/extra/project-euler/148/148.factor
@@ -35,7 +35,7 @@ IN: project-euler.148
dup 1+ * 2/ ; inline
: >base7 ( x -- y )
- [ dup 0 > ] [ 7 /mod ] [ ] produce nip ;
+ [ dup 0 > ] [ 7 /mod ] produce nip ;
: (use-digit) ( prev x index -- next )
[ [ 1+ * ] [ sum-1toN 7 sum-1toN ] bi ] dip ^ * + ;
diff --git a/extra/project-euler/common/common.factor b/extra/project-euler/common/common.factor
index 1a57a91e5e..ac8986b3ff 100644
--- a/extra/project-euler/common/common.factor
+++ b/extra/project-euler/common/common.factor
@@ -72,7 +72,7 @@ PRIVATE>
] if ;
: number>digits ( n -- seq )
- [ dup 0 = not ] [ 10 /mod ] [ ] produce reverse nip ;
+ [ dup 0 = not ] [ 10 /mod ] produce reverse nip ;
: nth-triangle ( n -- n )
dup 1+ * 2 / ;
From 5b2c0c9cbf8440d99158f6ed4929fa23f61e74c8 Mon Sep 17 00:00:00 2001
From: Daniel Ehrenberg <littledan@Macintosh-122.local>
Date: Mon, 2 Mar 2009 00:06:27 -0600
Subject: [PATCH 22/22] Adding missing inline declarations
---
core/io/streams/sequence/sequence.factor | 4 ++--
1 file changed, 2 insertions(+), 2 deletions(-)
diff --git a/core/io/streams/sequence/sequence.factor b/core/io/streams/sequence/sequence.factor
index bbb3576c05..7933dd86ca 100644
--- a/core/io/streams/sequence/sequence.factor
+++ b/core/io/streams/sequence/sequence.factor
@@ -10,14 +10,14 @@ SLOT: i
[ i>> ] [ underlying>> ] bi ; inline
: next ( stream -- )
- [ 1+ ] change-i drop ;
+ [ 1+ ] change-i drop ; inline
: sequence-read1 ( stream -- elt/f )
[ >sequence-stream< ?nth ]
[ next ] bi ; inline
: add-length ( n stream -- i+n )
- [ i>> + ] [ underlying>> length ] bi min ;
+ [ i>> + ] [ underlying>> length ] bi min ; inline
: (sequence-read) ( n stream -- seq/f )
[ add-length ] keep