produce and produce-as: don't need third quotation either

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

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

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
 

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/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,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 ]
+        [ 65536 read-partial dup ] [ ] produce nip concat f like
-        [ ] [ drop ] produce concat f like
     ] with-input-stream ;
 
 : each-block ( quot: ( block -- ) -- )

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

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 )
-    [ [ accumulator [ while ] dip ] dip 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

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
 

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