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

basis/base64/base64.factor

@@ -36,7 +36,7 @@ PRIVATE>
     #! pad string with = when not enough bits
     dup length dup 3 mod - cut
     [ 3 <groups> [ encode3 ] map concat ]
-    [ dup empty? [ drop "" ] [ >base64-rem ] if ]
+    [ [ "" ] [ >base64-rem ] if-empty ]
     bi* append ;
 
 : base64> ( base64 -- str )

basis/channels/channels.factor

@@ -33,10 +33,10 @@ PRIVATE>
 
 M: channel to ( value channel -- )
     dup receivers>>
-    dup empty? [ drop dup wait to ] [ nip (to) ] if ;
+    [ dup wait to ] [ nip (to) ] if-empty ;
 
 M: channel from ( channel -- value )
     [
         notify senders>>
-        dup empty? [ drop ] [ (from) ] if
+        [ (from) ] unless-empty
     ] curry "channel receive" suspend ;

basis/checksums/sha1/sha1.factor

@@ -120,7 +120,7 @@ M: sha1 checksum-stream ( stream -- sha1 )
 
 : seq>2seq ( seq -- seq1 seq2 )
     #! { abcdefgh } -> { aceg } { bdfh }
-    2 group flip dup empty? [ drop { } { } ] [ first2 ] if ;
+    2 group flip [ { } { } ] [ first2 ] if-empty ;
 
 : 2seq>seq ( seq1 seq2 -- seq )
     #! { aceg } { bdfh } -> { abcdefgh }

basis/compiler/generator/iterator/iterator.factor

@@ -28,18 +28,18 @@ DEFER: (tail-call?)
     [ first #phi? ] [ rest-slice (tail-call?) ] bi and ;
 
 : (tail-call?) ( cursor -- ? )
-    dup empty? [ drop t ] [
+    [ t ] [
         [ first [ #return? ] [ #terminate? ] bi or ]
         [ tail-phi? ]
         bi or
-    ] if ;
+    ] if-empty ;
 
 : tail-call? ( -- ? )
     node-stack get [
         rest-slice
-        dup empty? [ drop t ] [
+        [ t ] [
             [ (tail-call?) ]
             [ first #terminate? not ]
             bi and
-        ] if
+        ] if-empty
     ] all? ;

basis/compiler/tree/checker/checker.factor

@@ -32,7 +32,7 @@ M: #shuffle check-node*
 M: #copy check-node* inputs/outputs 2array check-lengths ;
 
 : check->r/r> ( node -- )
-    inputs/outputs dup empty? [ 2drop ] [ 2array check-lengths ] if ;
+    inputs/outputs [ drop ] [ 2array check-lengths ] if-empty ;
 
 M: #>r check-node* check->r/r> ;
 

basis/compiler/tree/cleanup/cleanup.factor

@@ -37,8 +37,8 @@ GENERIC: cleanup* ( node -- node/nodes )
     [ cleanup* ] map flatten ;
 
 : cleanup-folding? ( #call -- ? )
-    node-output-infos dup empty?
-    [ drop f ] [ [ literal?>> ] all? ] if ;
+    node-output-infos
+    [ f ] [ [ literal?>> ] all? ] if-empty ;
 
 : cleanup-folding ( #call -- nodes )
     #! Replace a #call having a known result with a #drop of its

basis/compiler/tree/escape-analysis/branches/branches.factor

@@ -15,7 +15,7 @@ M: #branch escape-analysis*
 
 : (merge-allocations) ( values -- allocation )
     [
-        dup [ allocation ] map sift dup empty? [ 2drop f ] [
+        dup [ allocation ] map sift [ drop f ] [
             dup [ t eq? not ] all? [
                 dup [ length ] map all-equal? [
                     nip flip
@@ -23,7 +23,7 @@ M: #branch escape-analysis*
                     [ record-allocations ] keep
                 ] [ drop add-escaping-values t ] if
             ] [ drop add-escaping-values t ] if
-        ] if
+        ] if-empty
     ] map ;
 
 : merge-allocations ( in-values out-values -- )

basis/compiler/tree/normalization/normalization.factor

@@ -205,5 +205,5 @@ M: node normalize* ;
     dup [ collect-label-info ] each-node
     dup count-introductions make-values
     [ (normalize) ] [ nip ] 2bi
-    dup empty? [ drop ] [ #introduce prefix ] if
+    [ #introduce prefix ] unless-empty
     rename-node-values ;

basis/compiler/tree/propagation/info/info.factor

@@ -237,9 +237,8 @@ DEFER: (value-info-union)
     } cond ;
 
 : value-infos-union ( infos -- info )
-    dup empty?
-    [ drop null-info ]
-    [ dup first [ value-info-union ] reduce ] if ;
+    [ null-info ]
+    [ dup first [ value-info-union ] reduce ] if-empty ;
 
 : literals<= ( info1 info2 -- ? )
     {

basis/compiler/tree/tree.factor

@@ -185,7 +185,7 @@ M: #return-recursive inputs/outputs [ in-d>> ] [ out-d>> ] bi ;
     [ label>> calls>> [ in-d>> ] map ] [ in-d>> ] bi suffix ;
 
 : ends-with-terminate? ( nodes -- ? )
-    dup empty? [ drop f ] [ peek #terminate? ] if ;
+    [ f ] [ peek #terminate? ] if-empty ;
 
 M: vector child-visitor V{ } clone ;
 M: vector #introduce, #introduce node, ;

basis/db/postgresql/lib/lib.factor

@@ -87,11 +87,11 @@ M: postgresql-result-null summary ( obj -- str )
             { URL [ dup [ present ] when default-param-value ] }
             [ drop default-param-value ]
         } case 2array
-    ] 2map flip dup empty? [
-        drop f f
+    ] 2map flip [
+        f f
     ] [
         first2 [ >c-void*-array ] [ >c-uint-array ] bi*
-    ] if ;
+    ] if-empty ;
 
 : param-formats ( statement -- seq )
     in-params>> [ type>> type>param-format ] map >c-uint-array ;

basis/db/types/types.factor

@@ -136,7 +136,7 @@ ERROR: no-sql-type ;
 
 : modifiers ( spec -- string )
     modifiers>> [ lookup-modifier ] map " " join
-    dup empty? [ " " prepend ] unless ;
+    [ "" ] [ " " prepend ] if-empty ;
 
 HOOK: bind% db ( spec -- )
 HOOK: bind# db ( spec obj -- )

basis/debugger/debugger.factor

@@ -48,14 +48,12 @@ M: string error. print ;
     ] "" make print ;
 
 : restarts. ( -- )
-    restarts get dup empty? [
-        drop
-    ] [
+    restarts get [
         nl
         "The following restarts are available:" print
         nl
         [ restart. ] each-index
-    ] if ;
+    ] unless-empty ;
 
 : print-error ( error -- )
     [ error. flush ] curry

basis/farkup/farkup.factor

@@ -102,7 +102,12 @@ list = ((list-item nl)+ list-item? | list-item)
 code       =  '[' (!('{' | nl | '[').)+ '{' (!("}]").)+ "}]"
     => [[ [ second >string ] [ fourth >string ] bi code boa ]]
 
-stand-alone      = (code | heading | list | table | paragraph | nl)*
+simple-code
+           = "[{" (!("}]").)+ "}]"
+    => [[ second f swap code boa ]]
+
+stand-alone
+           = (code | simple-code | heading | list | table | paragraph | nl)*
 ;EBNF
 
 
@@ -137,7 +142,7 @@ stand-alone      = (code | heading | list | table | paragraph | nl)*
     ] [
         escape-link
         >r "<img src=\"" write write "\"" write r>
-        dup empty? [ drop ] [ " alt=\"" write write "\"" write ] if
+        [ " alt=\"" write write "\"" write ] unless-empty
         "/>" write
     ] if ;
 

basis/fry/fry.factor

@@ -14,13 +14,13 @@ DEFER: shallow-fry
 
 : ((shallow-fry)) ( accum quot adder -- result )
     >r shallow-fry r>
-    append swap dup empty? [ drop ] [
+    append swap [
         [ prepose ] curry append
-    ] if ; inline
+    ] unless-empty ; inline
 
 : (shallow-fry) ( accum quot -- result )
-    dup empty? [
-        drop 1quotation
+    [
+        1quotation
     ] [
         unclip {
             { \ , [ [ curry ] ((shallow-fry)) ] }
@@ -31,7 +31,7 @@ DEFER: shallow-fry
 
             [ swap >r suffix r> (shallow-fry) ]
         } case
-    ] if ;
+    ] if-empty ;
 
 : shallow-fry ( quot -- quot' ) [ ] swap (shallow-fry) ;
 

basis/furnace/actions/actions.factor

@@ -23,11 +23,11 @@ SYMBOL: rest
 
 : render-validation-messages ( -- )
     form get errors>>
-    dup empty? [ drop ] [
+    [
         <ul "errors" =class ul>
             [ <li> escape-string write </li> ] each
         </ul>
-    ] if ;
+    ] unless-empty ;
 
 CHLOE: validation-messages drop render-validation-messages ;
 
@@ -47,11 +47,11 @@ TUPLE: action rest authorize init display validate submit ;
     2tri ;
 
 : set-nested-form ( form name -- )
-    dup empty? [
-        drop merge-forms
+    [
+        merge-forms
     ] [
         unclip [ set-nested-form ] nest-form
-    ] if ;
+    ] if-empty ;
 
 : restore-validation-errors ( -- )
     form cget [

basis/furnace/auth/features/edit-profile/edit-profile.factor

@@ -42,8 +42,8 @@ IN: furnace.auth.features.edit-profile
         [
             logged-in-user get
 
-            "new-password" value dup empty?
-            [ drop ] [ >>encoded-password ] if
+            "new-password" value
+            [ >>encoded-password ] unless-empty
 
             "realname" value >>realname
             "email" value >>email

basis/furnace/furnace.factor

@@ -112,8 +112,7 @@ SYMBOL: exit-continuation
 
 ! Chloe tags
 : parse-query-attr ( string -- assoc )
-    dup empty?
-    [ drop f ] [ "," split [ dup value ] H{ } map>assoc ] if ;
+    [ f ] [ "," split [ dup value ] H{ } map>assoc ] if-empty ;
 
 : a-url-path ( tag -- string )
     [ "href" required-attr ]

basis/help/help.factor

@@ -72,15 +72,13 @@ M: word article-parent "help-parent" word-prop ;
 M: word set-article-parent swap "help-parent" set-word-prop ;
 
 : $doc-path ( article -- )
-    help-path dup empty? [
-        drop
-    ] [
+    help-path [
         [
             help-path-style get [
                 "Parent topics: " write $links
             ] with-style
         ] ($block)
-    ] if ;
+    ] unless-empty ;
 
 : $title ( topic -- )
     title-style get [
@@ -112,8 +110,7 @@ M: word set-article-parent swap "help-parent" set-word-prop ;
     sort-articles [ \ $subsection swap 2array ] map print-element ;
 
 : $index ( element -- )
-    first call dup empty?
-    [ drop ] [ ($index) ] if ;
+    first call [ ($index) ] unless-empty ;
 
 : $about ( element -- )
     first vocab-help [ 1array $subsection ] when* ;

basis/help/lint/lint.factor

@@ -136,15 +136,14 @@ M: help-error error.
     ] with-scope ;
 
 : typos. ( assoc -- )
-    dup empty? [
-        drop
+    [
         "==== ALL CHECKS PASSED" print
     ] [
         [
             swap vocab-heading.
             [ error. nl ] each
         ] assoc-each
-    ] if ;
+    ] if-empty ;
 
 : help-lint ( prefix -- ) run-help-lint typos. ;
 

basis/help/markup/markup.factor

@@ -15,7 +15,7 @@ IN: help.markup
 ! Element types are words whose name begins with $.
 
 PREDICATE: simple-element < array
-    dup empty? [ drop t ] [ first word? not ] if ;
+    [ t ] [ first word? not ] if-empty ;
 
 SYMBOL: last-element
 SYMBOL: span
@@ -201,8 +201,8 @@ ALIAS: $slot $snippet
     dup [ "related" set-word-prop ] curry each ;
 
 : $related ( element -- )
-    first dup "related" word-prop remove dup empty?
-    [ drop ] [ $see-also ] if ;
+    first dup "related" word-prop remove
+    [ $see-also ] unless-empty ;
 
 : ($grid) ( style quot -- )
     [

basis/hints/hints.factor

@@ -13,10 +13,10 @@ IN: hints
     dup length <reversed>
     [ (picker) 2array ] 2map
     [ drop object eq? not ] assoc-filter
-    dup empty? [ drop [ t ] ] [
+    [ [ t ] ] [
         [ (make-specializer) ] { } assoc>map
         unclip [ swap [ f ] \ if 3array append [ ] like ] reduce
-    ] if ;
+    ] if-empty ;
 
 : specializer-cases ( quot word -- default alist )
     dup [ array? ] all? [ 1array ] unless [

basis/html/streams/streams.factor

@@ -88,11 +88,11 @@ TUPLE: html-sub-stream < html-stream style parent ;
     ] make-css ;
 
 : span-tag ( style quot -- )
-    over span-css-style dup empty? [
-        drop call
+    over span-css-style [
+        call
     ] [
         <span =style span> call </span>
-    ] if ; inline
+    ] if-empty ; inline
 
 : format-html-span ( string style stream -- )
     stream>> [
@@ -121,11 +121,11 @@ M: html-span-stream dispose
     ] make-css ;
 
 : div-tag ( style quot -- )
-    swap div-css-style dup empty? [
-        drop call
+    swap div-css-style [
+        call
     ] [
         <div =style div> call </div>
-    ] if ; inline
+    ] if-empty ; inline
 
 : format-html-div ( string style stream -- )
     stream>> [

basis/inspector/inspector.factor

@@ -50,14 +50,14 @@ SYMBOL: +editable+
 
 : describe* ( obj mirror keys -- )
     rot summary.
-    dup empty? [
-        2drop
+    [
+        drop
     ] [
         dup enum? [ +sequence+ on ] when
         standard-table-style [
             swap [ -rot describe-row ] curry each-index
         ] tabular-output
-    ] if ;
+    ] if-empty ;
 
 : describe ( obj -- )
     dup make-mirror dup sorted-keys describe* ;

basis/io/sockets/sockets.factor

@@ -95,11 +95,11 @@ M: invalid-inet6 summary drop "Invalid IPv6 address" ;
 <PRIVATE
 
 : parse-inet6 ( string -- seq )
-    dup empty? [ drop f ] [
+    [ f ] [
         ":" split [
             hex> [ "Component not a number" throw ] unless*
         ] B{ } map-as
-    ] if ;
+    ] if-empty ;
 
 : pad-inet6 ( string1 string2 -- seq )
     2dup [ length ] bi@ + 8 swap -

basis/lcs/diff2html/diff2html.factor

@@ -3,14 +3,14 @@
 USING: lcs html.elements kernel qualified ;
 FROM: accessors => item>> ;
 FROM: io => write ;
-FROM: sequences => each empty? ;
+FROM: sequences => each if-empty ;
 FROM: xml.entities => escape-string ;
 IN: lcs.diff2html
 
 GENERIC: diff-line ( obj -- )
 
 : write-item ( item -- )
-    item>> dup empty? [ drop " " ] [ escape-string ] if write ;
+    item>> [ " " ] [ escape-string ] if-empty write ;
 
 M: retain diff-line
     <tr>

basis/locals/locals.factor

@@ -98,8 +98,8 @@ C: <quote> quote
 UNION: special local quote local-word local-reader local-writer ;
 
 : load-locals-quot ( args -- quot )
-    dup empty? [
-        drop [ ]
+    [
+        [ ]
     ] [
         dup [ local-reader? ] contains? [
             <reversed> [
@@ -108,14 +108,10 @@ UNION: special local quote local-word local-reader local-writer ;
         ] [
             length [ load-locals ] curry >quotation
         ] if
-    ] if ;
+    ] if-empty ;
 
 : drop-locals-quot ( args -- quot )
-    dup empty? [
-        drop [ ]
-    ] [
-        length [ drop-locals ] curry
-    ] if ;
+    [ [ ] ] [ length [ drop-locals ] curry ] if-empty ;
 
 : point-free-body ( quot args -- newquot )
     >r but-last-slice r> [ localize ] curry map concat ;

basis/logging/insomniac/insomniac.factor

@@ -18,14 +18,14 @@ SYMBOL: insomniac-recipients
     ] "" make ;
 
 : (email-log-report) ( service word-names -- )
-    dupd ?analyze-log dup empty? [ 2drop ] [
+    dupd ?analyze-log [ drop ] [
         <email>
             swap >>body
             insomniac-recipients get >>to
             insomniac-sender get >>from
             swap email-subject >>subject
         send-email
-    ] if ;
+    ] if-empty ;
 
 \ (email-log-report) NOTICE add-error-logging
 

basis/models/history/history.factor

@@ -17,9 +17,8 @@ TUPLE: history < model back forward ;
     swap value>> dup [ swap push ] [ 2drop ] if ;
 
 : go-back/forward ( history to from -- )
-    dup empty?
-    [ 3drop ]
-    [ >r dupd (add-history) r> pop swap set-model ] if ;
+    [ 2drop ]
+    [ >r dupd (add-history) r> pop swap set-model ] if-empty ;
 
 : go-back ( history -- )
     dup [ forward>> ] [ back>> ] bi go-back/forward ;

basis/multiline/multiline.factor

@@ -37,9 +37,8 @@ PRIVATE>
 
 : parse-multiline-string ( end-text -- str )
     [
-        lexer get column>> swap (parse-multiline-string)
-        lexer get (>>column)
-    ] "" make rest but-last ;
+        lexer get [ swap (parse-multiline-string) ] change-column drop
+    ] "" make rest-slice but-last ;
 
 : <"
     "\">" parse-multiline-string parsed ; parsing

basis/prettyprint/prettyprint.factor

@@ -38,13 +38,13 @@ IN: prettyprint
     [ write-in nl ] when* ;
 
 : use. ( seq -- )
-    dup empty? [ drop ] [
+    [
         natural-sort [
             \ USING: pprint-word
             [ pprint-vocab ] each
             \ ; pprint-word
         ] with-pprint nl
-    ] if ;
+    ] unless-empty ;
 
 : vocabs. ( in use -- )
     dupd remove [ { "syntax" "scratchpad" } member? not ] filter
@@ -98,7 +98,7 @@ SYMBOL: ->
 "word-style" set-word-prop
 
 : remove-step-into ( word -- )
-    building get dup empty? [ drop ] [ nip pop wrapped>> ] if , ;
+    building get [ nip pop wrapped>> ] unless-empty , ;
 
 : (remove-breakpoints) ( quot -- newquot )
     [

basis/random/random.factor

@@ -34,14 +34,12 @@ M: f random-32* ( obj -- * ) no-random-number-generator ;
     ] keep head ;
 
 : random ( seq -- elt )
-    dup empty? [
-        drop f
-    ] [
+    [ f ] [
         [
             length dup log2 7 + 8 /i
             random-bytes byte-array>bignum swap mod
         ] keep nth
-    ] if ;
+    ] if-empty ;
 
 : delete-random ( seq -- elt )
     [ length random ] keep [ nth ] 2keep delete-nth ;

basis/stack-checker/backend/backend.factor

@@ -11,9 +11,9 @@ IN: stack-checker.backend
 : push-d ( obj -- ) meta-d get push ;
 
 : pop-d  ( -- obj )
-    meta-d get dup empty? [
-        drop <value> dup 1array #introduce, d-in inc
-    ] [ pop ] if ;
+    meta-d get [
+        <value> dup 1array #introduce, d-in inc
+    ] [ pop ] if-empty ;
 
 : peek-d ( -- obj ) pop-d dup push-d ;
 
@@ -40,7 +40,9 @@ IN: stack-checker.backend
 : output-r ( seq -- ) meta-r get push-all ;
 
 : pop-literal ( -- rstate obj )
-    pop-d [ 1array #drop, ] [ literal [ recursion>> ] [ value>> ] bi ] bi ;
+    pop-d
+    [ 1array #drop, ]
+    [ literal [ recursion>> ] [ value>> ] bi ] bi ;
 
 GENERIC: apply-object ( obj -- )
 

basis/stack-checker/branches/branches.factor

@@ -31,10 +31,10 @@ SYMBOL: +bottom+
 
 : unify-values ( values -- phi-out )
     remove-bottom
-    dup empty? [ drop <value> ] [
+    [ <value> ] [
         [ known ] map dup all-eq?
         [ first make-known ] [ drop <value> ] if
-    ] if ;
+    ] if-empty ;
 
 : phi-outputs ( phi-in -- stack )
     flip [ unify-values ] map ;
@@ -42,12 +42,12 @@ SYMBOL: +bottom+
 SYMBOL: quotations
 
 : unify-branches ( ins stacks -- in phi-in phi-out )
-    zip dup empty? [ drop 0 { } { } ] [
+    zip [ 0 { } { } ] [
         [ keys supremum ] [ ] [ balanced? ] tri
         [ dupd phi-inputs dup phi-outputs ]
         [ quotations get unbalanced-branches-error ]
         if
-    ] if ;
+    ] if-empty ;
 
 : branch-variable ( seq symbol -- seq )
     '[ , _ at ] map ;

basis/stack-checker/errors/errors.factor

@@ -26,8 +26,8 @@ M: inference-error error-help error>> error-help ;
 
 M: inference-error error.
     [
-        rstate>> dup empty?
-        [ drop ] [ "Nesting:" print stack. ] if
+        rstate>>
+        [ "Nesting:" print stack. ] unless-empty
     ] [ error>> error. ] bi ;
 
 TUPLE: literal-expected ;

basis/stack-checker/transforms/transforms.factor

@@ -69,15 +69,15 @@ IN: stack-checker.transforms
 \ cond [ cond>quot ] 1 define-transform
 
 \ case [
-    dup empty? [
-        drop [ no-case ]
+    [
+        [ no-case ]
     ] [
         dup peek quotation? [
             dup peek swap but-last
         ] [
             [ no-case ] swap
         ] if case>quot
-    ] if
+    ] if-empty
 ] 1 define-transform
 
 \ cleave [ cleave>quot ] 1 define-transform

basis/tools/deploy/config/config.factor

@@ -73,7 +73,7 @@ SYMBOL: deploy-image
 : deploy-config ( vocab -- assoc )
     dup default-config swap
     dup deploy-config-path vocab-file-contents
-    parse-fresh dup empty? [ drop ] [ first assoc-union ] if ;
+    parse-fresh [ first assoc-union ] unless-empty ;
 
 : set-deploy-config ( assoc vocab -- )
     >r unparse-use string-lines r>

basis/tools/scaffold/scaffold.factor

@@ -175,7 +175,11 @@ ERROR: no-vocab vocab ;
         {
             [ "IN: " write print nl ]
             [ interesting-words. ]
-            [ "ARTICLE: " write unparse dup write bl print ";" print nl ]
+            [
+                [ "ARTICLE: " write unparse dup write bl print ]
+                [ "{ $vocab-link " write pprint " }" print ] bi
+                ";" print nl
+            ]
             [ "ABOUT: " write unparse print ]
         } cleave
     ] with-string-writer ;

basis/tools/test/test.factor

@@ -67,8 +67,7 @@ SYMBOL: this-test
 : test-failures. ( assoc -- )
     [
         nl
-        dup empty? [
-            drop
+        [
             "==== ALL TESTS PASSED" print
         ] [
             "==== FAILING TESTS:" print
@@ -76,16 +75,16 @@ SYMBOL: this-test
                 swap vocab-heading.
                 [ failure. nl ] each
             ] assoc-each
-        ] if
+        ] if-empty
     ] [
         "==== NOTHING TO TEST" print
     ] if* ;
 
 : run-tests ( prefix -- failures )
-    child-vocabs dup empty? [ drop f ] [
+    child-vocabs [ f ] [
         [ dup run-test ] { } map>assoc
         [ second empty? not ] filter
-    ] if ;
+    ] if-empty ;
 
 : test ( prefix -- )
     run-tests test-failures. ;

basis/tools/vocabs/browser/browser.factor

@@ -36,14 +36,14 @@ IN: tools.vocabs.browser
 
 : vocabs. ( assoc -- )
     [
-        dup empty? [
-            2drop
+        [
+            drop
         ] [
             swap root-heading.
             standard-table-style [
                 vocab-headings. [ vocab. ] each
             ] ($grid)
-        ] if
+        ] if-empty
     ] assoc-each ;
 
 : describe-summary ( vocab -- )
@@ -98,10 +98,10 @@ C: <vocab-author> vocab-author
     ] when* ;
 
 : describe-words ( vocab -- )
-    words dup empty? [
+    words [
         "Words" $heading
-        dup natural-sort $links
-    ] unless drop ;
+        natural-sort $links
+    ] unless-empty ;
 
 : vocab-xref ( vocab quot -- vocabs )
     >r dup vocab-name swap words [ generic? not ] filter r> map
@@ -113,16 +113,16 @@ C: <vocab-author> vocab-author
 : vocab-usage ( vocab -- vocabs ) [ usage ] vocab-xref ;
 
 : describe-uses ( vocab -- )
-    vocab-uses dup empty? [
+    vocab-uses [
         "Uses" $heading
-        dup $vocab-links
-    ] unless drop ;
+        $vocab-links
+    ] unless-empty ;
 
 : describe-usage ( vocab -- )
-    vocab-usage dup empty? [
+    vocab-usage [
         "Used by" $heading
-        dup $vocab-links
-    ] unless drop ;
+        $vocab-links
+    ] unless-empty ;
 
 : $describe-vocab ( element -- )
     first

basis/tools/vocabs/vocabs.factor

@@ -165,11 +165,11 @@ MEMO: vocab-file-contents ( vocab name -- seq )
 
 : vocab-summary ( vocab -- summary )
     dup dup vocab-summary-path vocab-file-contents
-    dup empty? [
-        drop vocab-name " vocabulary" append
+    [
+        vocab-name " vocabulary" append
     ] [
         nip first
-    ] if ;
+    ] if-empty ;
 
 M: vocab summary
     [
@@ -212,11 +212,9 @@ M: vocab-link summary vocab-summary ;
 
 : (all-child-vocabs) ( root name -- vocabs )
     [ vocab-dir append-path subdirs ] keep
-    dup empty? [
-        drop
-    ] [
+    [
         swap [ "." swap 3append ] with map
-    ] if ;
+    ] unless-empty ;
 
 : vocabs-in-dir ( root name -- )
     dupd (all-child-vocabs) [

basis/tools/walker/walker.factor

@@ -197,7 +197,7 @@ SYMBOL: +stopped+
 : step-back-msg ( continuation -- continuation' )
     walker-history tget
     [ pop* ]
-    [ dup empty? [ drop ] [ nip pop ] if ] bi ;
+    [ [ nip pop ] unless-empty ] bi ;
 
 : walker-suspended ( continuation -- continuation' )
     +suspended+ set-status

basis/ui/gestures/gestures.factor

@@ -108,7 +108,7 @@ SYMBOL: double-click-timeout
 
 : drag-gesture ( -- )
     hand-buttons get-global
-    dup empty? [ drop ] [ first <drag> button-gesture ] if ;
+    [ first <drag> button-gesture ] unless-empty ;
 
 SYMBOL: drag-timer
 
@@ -170,7 +170,7 @@ SYMBOL: drag-timer
 
 : modifier ( mod modifiers -- seq )
     [ second swap bitand 0 > ] with filter
-    0 <column> prune dup empty? [ drop f ] [ >array ] if ;
+    0 <column> prune [ f ] [ >array ] if-empty ;
 
 : drag-loc ( -- loc )
     hand-loc get-global hand-click-loc get-global v- ;

basis/ui/tools/listener/listener.factor

@@ -72,11 +72,9 @@ M: listener-operation invoke-command ( target command -- )
     evaluate-input ;
 
 : listener-run-files ( seq -- )
-    dup empty? [
-        drop
-    ] [
+    [
         [ [ run-file ] each ] curry call-listener
-    ] if ;
+    ] unless-empty ;
 
 : com-end ( listener -- )
     input>> interactor-eof ;

basis/unicode/breaks/breaks.factor

@@ -80,10 +80,10 @@ VALUE: grapheme-table
     nip swap length or 1+ ;
 
 : (>graphemes) ( str -- )
-    dup empty? [ drop ] [
+    [
         dup first-grapheme cut-slice
         swap , (>graphemes)
-    ] if ;
+    ] unless-empty ;
 
 : >graphemes ( str -- graphemes )
     [ (>graphemes) ] { } make ;

basis/windows/com/wrapper/wrapper.factor

@@ -100,7 +100,7 @@ unless
     "windows.com.wrapper.callbacks" create ;
 
 : (finish-thunk) ( param-count thunk quot -- thunked-quot )
-    [ dup empty? [ 2drop [ ] ] [ swap 1- '[ , , ndip ] ] if ]
+    [ [ drop [ ] ] [ swap 1- '[ , , ndip ] ] if-empty ]
     dip compose ;
 
 : (make-interface-callbacks) ( interface-name quots iunknown-methods n -- words )

basis/xml/tokenize/tokenize.factor

@@ -164,7 +164,7 @@ SYMBOL: ns-stack
         T{ name f "" "encoding" f }
         T{ name f "" "standalone" f }
     } diff
-    dup empty? [ drop ] [ <extra-attrs> throw ] if ; 
+    [ <extra-attrs> throw ] unless-empty ; 
 
 : good-version ( version -- version )
     dup { "1.0" "1.1" } member? [ <bad-version> throw ] unless ;

basis/xml/writer/writer.factor

@@ -34,7 +34,7 @@ SYMBOL: indenter
 : ?filter-children ( children -- no-whitespace )
     xml-pprint? get [
         [ dup string? [ trim-whitespace ] when ] map
-        [ dup empty? swap string? and not ] filter
+        [ [ empty? ] [ string? ] bi and not ] filter
     ] when ;
 
 : print-name ( name -- )

core/classes/algebra/algebra.factor

@@ -208,9 +208,9 @@ M: anonymous-complement (classes-intersect?)
 
 : min-class ( class seq -- class/f )
     over [ classes-intersect? ] curry filter
-    dup empty? [ 2drop f ] [
+    [ drop f ] [
         tuck [ class<= ] with all? [ peek ] [ drop f ] if
-    ] if ;
+    ] if-empty ;
 
 GENERIC: (flatten-class) ( class -- )
 

core/classes/builtin/builtin.factor

@@ -44,11 +44,11 @@ M: builtin-class (classes-intersect?)
 
 M: anonymous-intersection (flatten-class)
     participants>> [ flatten-builtin-class ] map
-    dup empty? [
-        drop builtins get sift [ (flatten-class) ] each
+    [
+        builtins get sift [ (flatten-class) ] each
     ] [
         unclip [ assoc-intersect ] reduce [ swap set ] assoc-each
-    ] if ;
+    ] if-empty ;
 
 M: anonymous-complement (flatten-class)
     drop builtins get sift [ (flatten-class) ] each ;

core/classes/intersection/intersection.factor

@@ -8,14 +8,14 @@ PREDICATE: intersection-class < class
     "metaclass" word-prop intersection-class eq? ;
 
 : intersection-predicate-quot ( members -- quot )
-    dup empty? [
-        drop [ drop t ]
+    [
+        [ drop t ]
     ] [
         unclip "predicate" word-prop swap [
             "predicate" word-prop [ dup ] swap [ not ] 3append
             [ drop f ]
         ] { } map>assoc alist>quot
-    ] if ;
+    ] if-empty ;
 
 : define-intersection-predicate ( class -- )
     dup participants intersection-predicate-quot define-predicate ;

core/classes/tuple/parser/parser.factor

@@ -26,7 +26,7 @@ ERROR: duplicate-slot-names names ;
 
 : check-duplicate-slots ( slots -- )
     slot-names duplicates
-    dup empty? [ drop ] [ duplicate-slot-names ] if ;
+    [ duplicate-slot-names ] unless-empty ;
 
 ERROR: invalid-slot-name name ;
 

core/classes/union/union.factor

@@ -8,14 +8,14 @@ PREDICATE: union-class < class
     "metaclass" word-prop union-class eq? ;
 
 : union-predicate-quot ( members -- quot )
-    dup empty? [
-        drop [ drop f ]
+    [
+        [ drop f ]
     ] [
         unclip "predicate" word-prop swap [
             "predicate" word-prop [ dup ] prepend
             [ drop t ]
         ] { } map>assoc alist>quot
-    ] if ;
+    ] if-empty ;
 
 : define-union-predicate ( class -- )
     dup members union-predicate-quot define-predicate ;

core/destructors/destructors.factor

@@ -21,7 +21,7 @@ M: object dispose
 : dispose-each ( seq -- )
     [
         [ [ dispose ] curry [ , ] recover ] each
-    ] { } make dup empty? [ drop ] [ peek rethrow ] if ;
+    ] { } make [ peek rethrow ] unless-empty ;
 
 : with-disposal ( object quot -- )
     over [ dispose ] curry [ ] cleanup ; inline

core/io/files/files.factor

@@ -59,7 +59,7 @@ HOOK: (file-appender) io-backend ( path -- stream )
 HOOK: root-directory? io-backend ( path -- ? )
 
 M: object root-directory? ( path -- ? )
-    dup empty? [ drop f ] [ [ path-separator? ] all? ] if ;
+    [ f ] [ [ path-separator? ] all? ] if-empty ;
 
 ERROR: no-parent-directory path ;
 
@@ -80,7 +80,7 @@ ERROR: no-parent-directory path ;
 
 : head-path-separator? ( path1 ? -- ?' )
     [
-        dup empty? [ drop t ] [ first path-separator? ] if
+        [ t ] [ first path-separator? ] if-empty
     ] [
         drop f
     ] if ;

core/io/streams/string/string.factor

@@ -18,7 +18,7 @@ M: growable stream-flush drop ;
     <string-writer> swap [ output-stream get ] compose with-output-stream*
     >string ; inline
 
-M: growable stream-read1 dup empty? [ drop f ] [ pop ] if ;
+M: growable stream-read1 [ f ] [ pop ] if-empty ;
 
 : harden-as ( seq growble-exemplar -- newseq )
     underlying>> like ;
@@ -39,13 +39,13 @@ M: growable stream-read-until
     ] if ;
 
 M: growable stream-read
-    dup empty? [
-        2drop f
+    [
+        drop f
     ] [
         [ length swap - 0 max ] keep
         [ swap growable-read-until ] 2keep
         set-length
-    ] if ;
+    ] if-empty ;
 
 M: growable stream-read-partial
     stream-read ;

core/sequences/sequences-docs.factor

@@ -335,6 +335,42 @@ HELP: if-empty
     "6"
 } ;
 
+HELP: when-empty
+{ $values
+     { "seq" sequence } { "quot1" "the first quotation of an " { $link if-empty } } }
+{ $description "Makes an implicit check if the sequence is empty. An empty sequence is dropped and the " { $snippet "quot1" } " is called." }
+{ $examples "This word is equivalent to " { $link if-empty } " with an empty second quotation:"
+    { $example
+    "USING: sequences prettyprint ;"
+    "{ } [ { 4 5 6 } ] [ ] if-empty ."
+    "{ 4 5 6 }"
+    }
+    { $example
+    "USING: sequences prettyprint ;"
+    "{ } [ { 4 5 6 } ] when-empty ."
+    "{ 4 5 6 }"
+    }
+} ;
+
+HELP: unless-empty
+{ $values
+     { "seq" sequence } { "quot2" "the second quotation of an " { $link if-empty } } }
+{ $description "Makes an implicit check if the sequence is empty. An empty sequence is dropped. Otherwise, the " { $snippet "quot2" } " is called on the sequence.." }
+{ $examples "This word is equivalent to " { $link if-empty } " with an empty first quotation:"
+    { $example
+    "USING: sequences prettyprint ;"
+    "{ 4 5 6 } [ ] [ sum ] if-empty ."
+    "15"
+    }
+    { $example
+    "USING: sequences prettyprint ;"
+    "{ 4 5 6 } [ sum ] unless-empty ."
+    "15"
+    }
+} ;
+
+{ if-empty when-empty unless-empty } related-words
+
 HELP: delete-all
 { $values { "seq" "a resizable sequence" } }
 { $description "Resizes the sequence to zero length, removing all elements. Not all sequences are resizable." }

core/sequences/sequences.factor

@@ -34,7 +34,7 @@ M: sequence shorten 2dup length < [ set-length ] [ 2drop ] if ;
 
 : when-empty ( seq quot1 -- ) [ ] if-empty ; inline
 
-: unless-empty ( seq quot1 -- ) [ ] swap if-empty ; inline
+: unless-empty ( seq quot2 -- ) [ ] swap if-empty ; inline
 
 : delete-all ( seq -- ) 0 swap set-length ;
 
@@ -91,7 +91,7 @@ M: sequence set-nth-unsafe set-nth ;
 ! The f object supports the sequence protocol trivially
 M: f length drop 0 ;
 M: f nth-unsafe nip ;
-M: f like drop dup empty? [ drop f ] when ;
+M: f like drop [ f ] when-empty ;
 
 INSTANCE: f immutable-sequence
 
@@ -630,14 +630,14 @@ M: slice equal? over slice? [ sequence= ] [ 2drop f ] if ;
     0 [ length + ] reduce ;
 
 : concat ( seq -- newseq )
-    dup empty? [
-        drop { }
+    [
+        { }
     ] [
         [ sum-lengths ] keep
         [ first new-resizable ] keep
         [ [ over push-all ] each ] keep
         first like
-    ] if ;
+    ] if-empty ;
 
 : joined-length ( seq glue -- n )
     >r dup sum-lengths swap length 1 [-] r> length * + ;

extra/backtrack/backtrack.factor

@@ -50,9 +50,8 @@ PRIVATE>
     [ amb-integer ] [ nth ] bi ;
 
 : amb ( seq -- elt )
-    dup empty?
-    [ drop fail f ]
-    [ unsafe-amb ] if ; inline
+    [ fail f ]
+    [ unsafe-amb ] if-empty ; inline
 
 MACRO: amb-execute ( seq -- quot )
     [ length 1 - ] [ <enum> [ 1quotation ] assoc-map ] bi

extra/cords/cords.factor

@@ -27,7 +27,7 @@ M: multi-cord virtual@
     [ first - ] [ second ] bi ;
 
 M: multi-cord virtual-seq
-    seqs>> dup empty? [ drop f ] [ first second ] if ;
+    seqs>> [ f ] [ first second ] if-empty ;
 
 : <cord> ( seqs -- cord )
     dup length 2 = [

extra/game-input/backend/iokit/iokit.factor

@@ -58,7 +58,7 @@ SINGLETON: iokit-game-input-backend
     buttons-matching-hash device-elements-matching length ;
 
 : ?axis ( device hash -- axis/f )
-    device-elements-matching dup empty? [ drop f ] [ first ] if ;
+    device-elements-matching [ f ] [ first ] if-empty ;
 
 : ?x-axis ( device -- ? )
     x-axis-matching-hash ?axis ;

extra/html/parser/parser.factor

@@ -103,11 +103,9 @@ SYMBOL: tagstack
     [ get-char CHAR: < = ] take-until ;
 
 : parse-text ( -- )
-    read-until-< dup empty? [
-        drop
-    ] [
+    read-until-< [
         make-text-tag push-tag
-    ] if ;
+    ] unless-empty ;
 
 : (parse-attributes) ( -- )
     read-whitespace*

extra/inverse/inverse.factor

@@ -34,9 +34,8 @@ M: no-inverse summary
     drop "The word cannot be used in pattern matching" ;
 
 : next ( revquot -- revquot* first )
-    dup empty?
     [ "Badly formed math inverse" throw ]
-    [ unclip-slice ] if ;
+    [ unclip-slice ] if-empty ;
 
 : constant-word? ( word -- ? )
     stack-effect
@@ -116,8 +115,7 @@ M: pop-inverse inverse
     "pop-inverse" word-prop compose call ;
 
 : (undo) ( revquot -- )
-    dup empty? [ drop ]
-    [ unclip-slice inverse % (undo) ] if ;
+    [ unclip-slice inverse % (undo) ] unless-empty ;
 
 : [undo] ( quot -- undo )
     flatten fold reverse [ (undo) ] [ ] make ;

extra/irc/ui/commandparser/commandparser.factor

@@ -8,7 +8,7 @@ IN: irc.ui.commandparser
 "irc.ui.commands" require
 
 : command ( string string -- string command )
-    dup empty? [ drop "say" ] when
+    [ "say" ] when-empty
     dup "irc.ui.commands" lookup
     [ nip ]
     [ " " append prepend "quote" "irc.ui.commands" lookup ] if* ;

extra/irc/ui/ui.factor

@@ -32,8 +32,8 @@ TUPLE: irc-tab < frame listener client window ;
 : dark-green T{ rgba f 0.0 0.5 0.0 1 } ;
 
 : dot-or-parens ( string -- string )
-    dup empty? [ drop "." ]
-    [ "(" prepend ")" append ] if ;
+    [ "." ]
+    [ "(" prepend ")" append ] if-empty ;
 
 GENERIC: write-irc ( irc-message -- )
 

extra/koszul/koszul.factor

@@ -115,8 +115,7 @@ DEFER: (d)
 : x.dy ( x y -- vec ) (d) wedge -1 alt*n ;
 
 : (d) ( product -- value )
-    dup empty?
-    [ drop H{ } ] [ unclip swap [ x.dy ] 2keep dx.y alt+ ] if ;
+    [ H{ } ] [ unclip swap [ x.dy ] 2keep dx.y alt+ ] if-empty ;
 
 : linear-op ( vec quot -- vec )
         [
@@ -211,7 +210,7 @@ DEFER: (d)
 : m'.m ( matrix -- matrix' ) dup flip swap m. ;
 
 : empty-matrix? ( matrix -- ? )
-    dup empty? [ drop t ] [ first empty? ] if ;
+    [ t ] [ first empty? ] if-empty ;
 
 : ?m+ ( m1 m2 -- m3 )
     over empty-matrix? [

extra/math/polynomials/polynomials.factor

@@ -15,7 +15,7 @@ IN: math.polynomials
 : 2pad-right ( p p n -- p p ) 0 [ pad-right swap ] 2keep pad-right swap ;
 : pextend ( p p -- p p ) 2dup [ length ] bi@ max 2pad-right ;
 : pextend-left ( p p -- p p ) 2dup [ length ] bi@ max 2pad-left ;
-: unempty ( seq -- seq ) dup empty? [ drop { 0 } ] when ;
+: unempty ( seq -- seq ) [ { 0 } ] when-empty ;
 : 2unempty ( seq seq -- seq seq ) [ unempty ] bi@ ;
 
 PRIVATE>

extra/math/primes/factors/factors.factor

@@ -10,11 +10,11 @@ IN: math.primes.factors
 
 : (count) ( n d -- n' )
     [ (factor) ] { } make
-    dup empty? [ drop ] [ [ first ] keep length 2array , ] if ;
+    [ [ first ] keep length 2array , ] unless-empty ;
 
 : (unique) ( n d -- n' )
     [ (factor) ] { } make
-    dup empty? [ drop ] [ first , ] if ;
+    [ first , ] unless-empty ;
 
 : (factors) ( quot list n -- )
     dup 1 > [ swap uncons swap >r pick call r> swap (factors) ] [ 3drop ] if ;

extra/math/text/english/english.factor

@@ -57,11 +57,9 @@ SYMBOL: and-needed?
 
 : text-with-scale ( index seq -- str )
     dupd nth 3digits>text swap
-    scale-numbers dup empty? [
-        drop
-    ] [
+    scale-numbers [
         " " swap 3append
-    ] if ;
+    ] unless-empty ;
 
 : append-with-conjunction ( str1 str2 -- newstr )
     over length zero? [

extra/money/money.factor

@@ -22,7 +22,7 @@ ERROR: not-a-decimal x ;
 : parse-decimal ( str -- ratio )
     "." split1
     >r dup "-" head? [ drop t "0" ] [ f swap ] if r>
-    [ dup empty? [ drop "0" ] when ] bi@
+    [ [ "0" ] when-empty ] bi@
     dup length
     >r [ dup string>number [ nip ] [ not-a-decimal ] if* ] bi@ r>
     10 swap ^ / + swap [ neg ] when ;

extra/multi-methods/multi-methods.factor

@@ -112,10 +112,10 @@ SYMBOL: total
     dup length <reversed>
     [ picker 2array ] 2map
     [ drop object eq? not ] assoc-filter
-    dup empty? [ drop [ t ] ] [
+    [ [ t ] ] [
         [ (multi-predicate) ] { } assoc>map
         unclip [ swap [ f ] \ if 3array append [ ] like ] reduce
-    ] if ;
+    ] if-empty ;
 
 : argument-count ( methods -- n )
     keys 0 [ length max ] reduce ;

extra/pack/pack.factor

@@ -84,7 +84,7 @@ M: string b, ( n string -- ) heap-size b, ;
     "\0" read-until [ drop f ] unless ;
 
 : read-c-string* ( n -- str/f )
-    read [ zero? ] trim-right dup empty? [ drop f ] when ;
+    read [ zero? ] trim-right [ f ] when-empty ;
 
 : (read-128-ber) ( n -- n )
     read1

extra/porter-stemmer/porter-stemmer.factor

@@ -163,11 +163,11 @@ USING: kernel math parser sequences combinators splitting ;
     } cond ;
 
 : -ion ( str -- newstr )
-    dup empty? [
-        drop "ion"
+    [
+        "ion"
     ] [
         dup "st" last-is? [ "ion" append ] unless
-    ] if ;
+    ] if-empty ;
 
 : step4 ( str -- newstr )
     dup {

extra/project-euler/079/079.factor

@@ -36,7 +36,7 @@ IN: project-euler.079
 
 : find-source ( seq -- elt )
     unzip diff prune
-    dup empty? [ "Topological sort failed" throw ] [ first ] if ;
+    [ "Topological sort failed" throw ] [ first ] if-empty ;
 
 : remove-source ( seq elt -- seq )
     [ swap member? not ] curry filter ;
@@ -45,7 +45,7 @@ IN: project-euler.079
     dup length 1 > [
         dup find-source dup , remove-source (topological-sort)
     ] [
-        dup empty? [ drop ] [ first [ , ] each ] if
+        [ first [ , ] each ] unless-empty
     ] if ;
 
 PRIVATE>

extra/reports/noise/noise.factor

@@ -155,11 +155,11 @@ M: lambda-word word-noise-factor
 : vocab-noise-factor ( vocab -- factor )
     words flatten-generics
     [ word-noise-factor dup 20 < [ drop 0 ] when ] map
-    dup empty? [ drop 0 ] [
+    [ 0 ] [
         [ [ sum ] [ length 5 max ] bi /i ]
         [ supremum ]
         bi +
-    ] if ;
+    ] if-empty ;
 
 : noisy-vocabs ( -- alist )
     vocabs [ dup vocab-noise-factor ] { } map>assoc

extra/sequences/lib/lib-docs.factor

@@ -18,23 +18,3 @@ HELP: each-withn
 "passed to the quotation given to each-withn for each element in the sequence."
 } 
 { $see-also map-withn } ;
-
-HELP: if-seq
-{ $values { "seq" sequence } { "quot1" quotation } { "quot2" quotation } }
-{ $description "Makes an implicit check if the sequence is empty.  If the sequence has any elements, " { $snippet "quot1" } " is called on it.  Otherwise, the empty sequence is dropped and " { $snippet "quot2" } " is called." }
-{ $example
-    "USING: kernel prettyprint sequences sequences.lib ;"
-    "{ 1 2 3 } [ sum ] [ \"empty sequence\" throw ] if-seq ."
-    "6"
-} ;
-
-HELP: if-empty
-{ $values { "seq" sequence } { "quot1" quotation } { "quot2" quotation } }
-{ $description "Makes an implicit check if the sequence is empty. An empty sequence is dropped and " { $snippet "quot1" } " is called. Otherwise, if the sequence has any elements, " { $snippet "quot2" } " is called on it." }
-{ $example
-    "USING: kernel prettyprint sequences sequences.lib ;"
-    "{ 1 2 3 } [ \"empty sequence\" ] [ sum ] if-empty ."
-    "6"
-} ;
-
-{ if-seq if-empty } related-words

extra/sequences/lib/lib-tests.factor

@@ -63,6 +63,3 @@ IN: sequences.lib.tests
 [ 1 2 { 3 4 } [ + + drop ] 2 each-withn  ] must-infer
 { 13 } [ 1 2 { 3 4 } [ + + ] 2 each-withn + ] unit-test
 [ { 910 911 912 } ] [ 10 900 3 [ + + ] map-with2 ] unit-test
-
-[ "empty" ] [ { } [ "not empty" ] [ "empty" ] if-seq ] unit-test
-[ { 1 } "not empty" ] [ { 1 } [ "not empty" ] [ "empty" ] if-seq ] unit-test

extra/sequences/lib/lib.factor

@@ -189,12 +189,3 @@ PRIVATE>
 
 : ?nth* ( n seq -- elt/f ? )
     2dup bounds-check? [ nth-unsafe t ] [ 2drop f f ] if ; flushable
-
-: if-seq ( seq quot1 quot2 -- ) [ f like ] 2dip if* ; inline
- 
-: if-empty ( seq quot1 quot2 -- ) swap if-seq ; inline
-
-: when-empty ( seq quot1 -- ) [ ] if-empty ; inline
-
-: unless-empty ( seq quot1 -- ) [ ] swap if-empty ; inline
-

extra/units/units.factor

@@ -19,8 +19,8 @@ M: dimensions-not-equal summary drop "Dimensions do not match" ;
     [ remove-one ] curry bi@ ;
 
 : symbolic-reduce ( seq seq -- seq seq )
-    2dup intersect dup empty?
-    [ drop ] [ first 2remove-one symbolic-reduce ] if ;
+    2dup intersect
+    [ first 2remove-one symbolic-reduce ] unless-empty ;
 
 : <dimensioned> ( n top bot -- obj )
     symbolic-reduce

extra/xml/syntax/syntax.factor

@@ -21,10 +21,10 @@ IN: xml.syntax
 DEFER: >>
 
 : attributes-parsed ( accum quot -- accum )
-    dup empty? [ drop f parsed ] [
+    [ f parsed ] [
         >r \ >r parsed r> parsed
         [ H{ } make-assoc r> swap ] [ parsed ] each
-    ] if ;
+    ] if-empty ;
 
 : <<
     parsed-name [