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

Conflicts:

	basis/regexp/regexp.factor

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 )

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

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

basis/concurrency/mailboxes/mailboxes.factor

@@ -51,13 +51,13 @@ 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 ;
 
 : 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 ]

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

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* ;
 

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* ;
 

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* ;
 

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" [ "emacsclientw.exe" tail? ] find-in-program-files ]
-        [ "Emacs" t [ "emacsclient.exe" tail? ] find-in-program-files ]
+        [ "Emacs" [ "emacsclient.exe" tail? ] find-in-program-files ]
         [ "emacsclient.exe" ]
     } 0|| ;

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* ;
 

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* ;
 

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* ;

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* ;
 

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*

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* ;
 

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* ;
 

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* ;
 

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* ;
 

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 ]
+            [ "\0" read-until drop dup empty? not ] [ ] produce nip
-            [ ] [ drop ] produce
         ] with-input-stream*
     ] [ FreeEnvironmentStrings win32-error=0/f ] bi ;

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 )

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 ] [

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

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 ;

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." } ;

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

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

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

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 ;

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 ;

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 ]
+            [ _ find-next-volume dup ] [ ] produce nip
-            [ ]
-            [ drop ] produce
             swap prefix
         ]
     ] [ '[ _ FindVolumeClose win32-error=0/f ] ] bi [ ] cleanup ;

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
@@ -9,3 +9,13 @@ 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 delete-file ] ignore-errors
+[ ] [ "mmap-empty-file.txt" temp-file touch-file ] unit-test
+
+[
+    "mmap-empty-file.txt" temp-file [
+        drop
+    ] with-mapped-file
+] [ bad-mmap-size? ] must-fail-with

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 -- )

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 ;
 

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

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 -- )

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

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 ;
 
 [

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 ;

basis/math/functions/functions.factor

@@ -29,7 +29,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

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 ;
 

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

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 ;

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 ;

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>
 

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 ;

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 ;

basis/stack-checker/known-words/known-words.factor

@@ -141,9 +141,7 @@ M: object infer-call*
     apply-word/effect ;
 
 : infer-exit ( -- )
-    \ exit
+    \ exit (( n -- * )) apply-word/effect ;
-    { integer } { } t >>terminated? <effect>
-    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
 

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
@@ -511,9 +512,9 @@ 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
+[ [ [ f dup ] [ ] while ] infer ] must-fail
 
 : erg's-inference-bug ( -- ) f dup [ erg's-inference-bug ] when ; inline
 
@@ -581,4 +582,6 @@ DEFER: eee'
 : debugging-curry-folding ( quot -- )
     [ debugging-curry-folding ] curry call ; inline recursive
 
-[ [ ] debugging-curry-folding ] must-infer
+[ [ ] debugging-curry-folding ] must-infer
+
+[ [ exit ] [ 1 2 3 ] if ] must-infer

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 -- * )

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

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 ;

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
 

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 ]

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
+    0 [ EnumClipboardFormats win32-error dup dup 0 > ] [ ] produce 2nip ;
-    [ EnumClipboardFormats win32-error dup dup 0 > ]
-    [ ]
-    [ drop ]
-    produce nip ;
 
 : with-clipboard ( quot -- )
     f OpenClipboard win32-error=0/f

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 ]
+    [ dup empty? not ] swap '[ dup @ cut-slice swap ] produce nip ; inline
-    [ ] produce nip ; inline
 
 PRIVATE>
 

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

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 ;

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

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 ;

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 {

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
 

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

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

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

core/io/io.factor

@@ -65,12 +65,12 @@ SYMBOL: error-stream
 : bl ( -- ) " " write ;
 
 : lines ( stream -- seq )
-    [ [ readln dup ] [ ] [ drop ] produce ] with-input-stream ;
+    [ [ readln dup ] [ ] produce nip ] with-input-stream ;
 
 <PRIVATE
 
 : each-morsel ( handler: ( data -- ) reader: ( -- data ) -- )
-    [ dup ] compose swap [ drop ] while ; inline
+    [ dup ] compose swap while drop ; inline
 
 PRIVATE>
 
@@ -79,8 +79,7 @@ PRIVATE>
 
 : contents ( stream -- seq )
     [
-        [ 65536 read-partial dup ]
+        [ 65536 read-partial dup ] [ ] produce nip concat f like
-        [ ] [ drop ] produce concat f like
     ] with-input-stream ;
 
 : each-block ( quot: ( block -- ) -- )

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 ; inline
+
+: sequence-read1 ( stream -- elt/f )
+    [ >sequence-stream< ?nth ]
+    [ next ] bi ; inline
+
+: add-length ( n stream -- i+n )
+    [ i>> + ] [ underlying>> length ] bi min  ; inline
+
+: (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

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
+[ "a" ] [ 1 "abc" <string-reader> stream-read ] unit-test
-[ "ab" ] [ 2 SBUF" cba" stream-read ] unit-test
+[ "ab" ] [ 2 "abc" <string-reader> stream-read ] unit-test
-[ "abc" ] [ 3 SBUF" cba" stream-read ] unit-test
+[ "abc" ] [ 3 "abc" <string-reader> stream-read ] unit-test
-[ "abc" ] [ 4 SBUF" cba" 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
 
 [

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
+strings generic splitting continuations destructors sequences.private
-io.streams.plain io.encodings math.order growable ;
+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 )
+TUPLE: string-reader { underlying string read-only } { i array-capacity } ;
-    swap [ memq? ] curry find-last drop ;
 
-M: growable stream-read-until
+M: string-reader stream-read-partial stream-read ;
-    [ find-last-sep ] keep over [
+M: string-reader stream-read sequence-read ;
-        [ swap 1+ growable-read-until ] 2keep [ nth ] 2keep
+M: string-reader stream-read1 sequence-read1 ;
-        set-length
+M: string-reader stream-read-until sequence-read-until ;
-    ] [
+M: string-reader dispose drop ;
-        [ 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 ;
 
 : <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

core/kernel/kernel-docs.factor

@@ -638,15 +638,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
@@ -667,18 +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 }
-"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 }
 "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 } ;

core/kernel/kernel.factor

@@ -185,21 +185,20 @@ PRIVATE>
 
 : either? ( x y quot -- ? ) bi@ or ; inline
 
-: most ( x y quot -- z )
+: most ( x y quot -- z ) 2keep ? ; inline
-    [ 2dup ] dip call [ drop ] [ nip ] if ; inline
 
 ! Loops
 : loop ( pred: ( -- ? ) -- )
     [ call ] keep [ loop ] curry when ; inline recursive
 
-: do ( pred body tail -- pred body tail )
+: do ( pred body -- pred body )
-    over 3dip ; inline
+    dup 2dip ; inline
 
-: while ( pred: ( -- ? ) body: ( -- ) tail: ( -- ) -- )
+: while ( pred: ( -- ? ) body: ( -- ) -- )
-    [ pick 3dip [ do while ] 3curry ] keep if ; inline recursive
+    swap do compose [ loop ] curry when ; inline
 
-: until ( pred: ( -- ? ) body: ( -- ) tail: ( -- ) -- )
+: until ( pred: ( -- ? ) body: ( -- ) -- )
-    [ [ not ] compose ] 2dip while ; inline
+    [ [ not ] compose ] dip while ; inline
 
 ! Object protocol
 GENERIC: hashcode* ( depth obj -- code )

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 )

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."

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>

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 }" }
+    { $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:"
+    "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 > ] [ ] [ drop ] produce ." "{ 8 2 2 9 }" }
+    { $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
+{ $examples "See " { $link produce } " for 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 }" }
-} ;
 
 HELP: sigma
 { $values { "seq" sequence } { "quot" quotation } { "n" number } }

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 )
+: produce-as ( pred quot exemplar -- seq )
-    [ swap accumulator [ swap while ] dip ] dip like ; inline
+    [ 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

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

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

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>

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   

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 ;
 

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

extra/id3/authors.txt

@@ -1,2 +1,2 @@
 Tim Wawrzynczak
-
+Doug Coleman

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>> }

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
 
-[
+: id3-params ( id3 -- title artist album year comment genre )
-    T{ id3-info
+    {
-       { title "BLAH" }
+        [ id3-title ]
-       { artist "ARTIST" }
+        [ id3-artist ]
-       { album "ALBUM" }
+        [ id3-album ]
-       { year "2009" }
+        [ id3-year ]
-       { comment "COMMENT" }
+        [ id3-comment ]
-       { genre "Bluegrass" }
+        [ id3-genre ]
-    }
+    } cleave ;
-] [ "resource:extra/id3/tests/blah.mp3" file-id3-tags ] unit-test
 
 [
-    T{ id3-info
+   "BLAH"
-       { title "Anthem of the Trinity" }
+   "ARTIST"
-       { artist "Terry Riley" }
+   "ALBUM"
-       { album "Shri Camel" }
+   "2009"
-       { genre "Classical" }
+   "COMMENT"
-    }
+   "Bluegrass"
-] [ "resource:extra/id3/tests/blah2.mp3" file-id3-tags ] unit-test
+] [ "vocab:id3/tests/blah.mp3" file-id3-tags id3-params ] unit-test
+
+[
+    "Anthem of the Trinity"
+    "Terry Riley"
+    "Shri Camel"
+    f
+    f
+    "Classical"
+] [ "vocab:id3/tests/blah2.mp3" file-id3-tags id3-params ] unit-test
 
 [    
-    T{ id3-info
+   "Stormy Weather"
-       { title "Stormy Weather" }
+   "Frank Sinatra"
-       { artist "Frank Sinatra" }
+   "Night and Day Frank Sinatra"
-       { album "Night and Day Frank Sinatra" }
+    f
-       { comment "eng, AG# 08E1C12E" }
+   "eng, AG# 08E1C12E"
-       { genre "Big Band" }
+   "Big Band"
-    }
+] [ "vocab:id3/tests/blah3.mp3" file-id3-tags id3-params ] unit-test
-] [ "resource:extra/id3/tests/blah3.mp3" file-id3-tags ] unit-test
 

extra/id3/id3.factor

@@ -1,142 +1,43 @@
-! 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 ;
+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 combinators.smart
+splitting io.encodings.ascii arrays ;
 IN: id3
 
 <PRIVATE
 
-! genres
 CONSTANT: genres
-  H{
+    {
-    { 0 "Blues" }
+        "Blues" "Classic Rock" "Country" "Dance" "Disco" "Funk" 
-    { 1 "Classic Rock" }
+        "Grunge" "Hip-Hop" "Jazz" "Metal" "New Age" "Oldies" "Other" 
-    { 2 "Country" }
+        "Pop" "R&B" "Rap" "Reggae" "Rock" "Techno" "Industrial" 
-    { 3 "Dance" }
+        "Alternative" "Ska" "Death Metal" "Pranks" "Soundtrack" 
-    { 4 "Disco" }
+        "Euro-Techno" "Ambient" "Trip-Hop" "Vocal" "Jazz+Funk" 
-    { 5 "Funk" }
+        "Fusion" "Trance" "Classical" "Instrumental" "Acid" "House" 
-    { 6 "Grunge" }
+        "Game" "Sound Clip" "Gospel" "Noise" "AlternRock" "Bass" 
-    { 7 "Hip-Hop" }
+        "Soul" "Punk" "Space" "Meditative" "Instrumental Pop" 
-    { 8 "Jazz" }
+        "Instrumental Rock" "Ethnic" "Gothic" "Darkwave" 
-    { 9 "Metal" }
+        "Techno-Industrial" "Electronic" "Pop-Folk" "Eurodance" 
-    { 10 "New Age" }
+        "Dream" "Southern Rock" "Comedy" "Cult" "Gangsta" "Top 40" 
-    { 11 "Oldies" }
+        "Christian Rap" "Pop/Funk" "Jungle" "Native American" 
-    { 12 "Other" }
+        "Cabaret" "New Wave" "Psychedelic" "Rave" "Showtunes" 
-    { 13 "Pop" }
+        "Trailer" "Lo-Fi" "Tribal" "Acid Punk" "Acid Jazz" "Polka" 
-    { 14 "R&B" }
+        "Retro" "Musical" "Rock & Roll" "Hard Rock" "Folk" 
-    { 15 "Rap" }
+        "Folk-Rock" "National Folk" "Swing" "Fast Fusion" "Bebop" 
-    { 16 "Reggae" }
+        "Latin" "Revival" "Celtic" "Bluegrass" "Avantgarde" 
-    { 17 "Rock" }
+        "Gothic Rock" "Progressive Rock" "Psychedelic Rock" 
-    { 18 "Techno" }
+        "Symphonic Rock" "Slow Rock" "Big Band" "Chorus" 
-    { 19 "Industrial" }
+        "Easy Listening" "Acoustic" "Humour" "Speech" "Chanson" 
-    { 20 "Alternative" }
+        "Opera" "Chamber Music" "Sonata" "Symphony" "Booty Bass" 
-    { 21 "Ska" }
+        "Primus" "Porn Groove" "Satire" "Slow Jam" "Club" "Tango" 
-    { 22 "Death Metal" }
+        "Samba" "Folklore" "Ballad" "Power Ballad" "Rhythmic Soul" 
-    { 23 "Pranks" }
+        "Freestyle" "Duet" "Punk Rock" "Drum Solo" "A capella" 
-    { 24 "Soundtrack" }
+        "Euro-House" "Dance Hall"
-    { 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
 
 TUPLE: header version flags size ;
 
@@ -144,154 +45,145 @@ 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 ) 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? ; inline
-
-: id3v2? ( mmap -- ? )
-    "ID3" head? ;
 
 : id3v1? ( mmap -- ? )
-    128 tail-slice* "TAG" head? ;
+    { [ 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 ;
-
-: read-frame-size ( mmap -- size )
-    [ 4 8 ] dip subseq ;
-
-: read-frame-flags ( mmap -- flags )
-    [ 8 10 ] dip subseq ;
 
 : 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
+: 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 ]
+        [ 4 head-slice decode-text >>frame-id ]
-        [ read-frame-flags >byte-array  >>flags ]
+        [ [ 4 8 ] dip subseq >28bitword >>size ]
-        [ read-frame-size  >28bitword   >>size ]
+        [ [ 8 10 ] dip subseq >byte-array >>flags ]
-        [ read-frame-data  utf8 decode  >>data ]
+        [ read-frame-data decode-text >>data ]
     } cleave ;
 
 : read-frame ( mmap -- frame/f )
-    dup read-frame-id valid-frame-id? [ (read-frame) ] [ drop f ] if ;
+    dup 4 head-slice 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 ]
     [ [ remove-frame ] keep ]
-    [ drop ] produce nip ;
+    produce 2nip ;
     
 ! header stuff
 
-: read-header-supported-version? ( mmap -- ? )
+: read-v2-header ( seq -- id3header )
-    3 tail-slice [ { 4 } head? ] [ { 3 } head? ] bi or ;
-
-: read-header-flags ( mmap -- flags )
-    5 swap nth ;
-
-: read-header-size ( mmap -- size )
-    [ 6 10 ] dip <slice> >28bitword ;
-
-: read-v2-header ( mmap -- id3header )
     [ <header> ] dip
     {
-        [ read-header-supported-version?  >>version ]
+        [ [ 3 5 ] dip <slice> >array >>version ]
-        [ read-header-flags >>flags ]
+        [ [ 5 ] dip nth >>flags ]
-        [ read-header-size >>size ]
+        [ [ 6 10 ] dip <slice> >28bitword >>size ]
-    } cleave ;
+    } cleave ; inline
 
-: drop-header ( mmap -- seq1 seq2 )
+: read-v2-tag-data ( seq -- id3v2-info )
-    dup 10 tail-slice swap ;
+    10 cut-slice
-
+    [ read-v2-header ]
-: parse-frames ( id3v2-info -- id3-info )
+    [ read-frames ] bi* <id3v2-info> ; inline
-    [ <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*
-          >>genre ] when* ]
-        [ [ frame-id>> "COMM" = ] find nip [ data>> >>comment ] when* ]
-        [ [ frame-id>> "TYER" = ] find nip [ data>> >>year ] when* ]
-    } cleave ;
-
-: read-v2-tag-data ( seq -- id3-info )
-    drop-header read-v2-header swap read-frames <id3v2-info> parse-frames ;
     
 ! v1 information
 
-: skip-to-v1-data ( seq -- seq )
+: skip-to-v1-data ( seq -- seq ) 125 tail-slice* ; inline
-    125 tail-slice* ;
-
-: read-title ( seq -- title )
-    30 head-slice ;
-
-: read-artist ( seq -- title )
-    [ 30 60 ] dip subseq ;
-
-: read-album ( seq -- album )
-    [ 60 90 ] dip subseq ;
-
-: read-year ( seq -- year )
-    [ 90 94 ] dip subseq ;
-
-: read-comment ( seq -- comment )
-    [ 94 124 ] dip subseq ;
-
-: read-genre ( seq -- genre )
-    [ 124 ] dip nth ;
 
 : (read-v1-tag-data) ( seq -- mp3-file )
-    [ <id3-info> ] dip
+    [ <id3v1-info> ] dip
     {
-        [ read-title   utf8 decode  filter-text-data >>title   ]
+        [ 30 head-slice decode-text filter-text-data >>title ]
-        [ read-artist  utf8 decode  filter-text-data >>artist  ]
+        [ [ 30 60 ] dip subseq decode-text filter-text-data >>artist ]
-        [ read-album   utf8 decode  filter-text-data >>album   ]
+        [ [ 60 90 ] dip subseq decode-text filter-text-data >>album ]
-        [ read-year    utf8 decode  filter-text-data >>year    ]
+        [ [ 90 94 ] dip subseq decode-text filter-text-data >>year ]
-        [ read-comment utf8 decode  filter-text-data >>comment ]
+        [ [ 94 124 ] dip subseq decode-text filter-text-data >>comment ]
-        [ read-genre   >fixnum       genres at       >>genre ]
+        [ [ 124 ] dip nth number>string >>genre ]
-    } cleave ;
+    } 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 id3v2? ] [ read-v2-tag-data ] }
-            { [ dup id3v1? ] [ read-v1-tag-data ] } ! ( ? -- id3-info )
+            { [ dup id3v1? ] [ read-v1-tag-data id3v1>id3v2 ] }
-            [ drop f ] ! ( mmap -- f )
+            [ drop f ]
         } cond
     ] with-mapped-uchar-file ;
-
-! end

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 ]
+    [ dup IOIteratorNext dup MACH_PORT_NULL = not ] [ ] produce nip ;
-    [ ]
-    [ drop ] produce ;
 
 : io-objects-from-iterator ( i -- array )
     io-objects-from-iterator* [ release-io-object ] dip ;

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>

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 ;

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 )
     [

extra/otug-talk/otug-talk.factor

@@ -223,7 +223,7 @@ CONSTANT: otug-slides
     }
     { $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" }

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 )

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)

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 ;

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>
 

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

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
 

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 ^ * + ;

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 / ;

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

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)