diff --git a/basis/base64/base64.factor b/basis/base64/base64.factor index 3bf1a527ea..747cfa1128 100644 --- a/basis/base64/base64.factor +++ b/basis/base64/base64.factor @@ -36,7 +36,7 @@ PRIVATE> #! pad string with = when not enough bits dup length dup 3 mod - cut [ 3 [ encode3 ] map concat ] - [ dup empty? [ drop "" ] [ >base64-rem ] if ] + [ [ "" ] [ >base64-rem ] if-empty ] bi* append ; : base64> ( base64 -- str ) diff --git a/basis/channels/channels.factor b/basis/channels/channels.factor index 545d8a0e1d..9b8c418634 100755 --- a/basis/channels/channels.factor +++ b/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 ; diff --git a/basis/checksums/sha1/sha1.factor b/basis/checksums/sha1/sha1.factor index 0ddb429b28..6aa2cfa2eb 100755 --- a/basis/checksums/sha1/sha1.factor +++ b/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 } diff --git a/basis/compiler/generator/iterator/iterator.factor b/basis/compiler/generator/iterator/iterator.factor index 473d59c3e4..203216b1c0 100644 --- a/basis/compiler/generator/iterator/iterator.factor +++ b/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? ; diff --git a/basis/compiler/tree/checker/checker.factor b/basis/compiler/tree/checker/checker.factor index 0f81e3805a..b712a6e354 100644 --- a/basis/compiler/tree/checker/checker.factor +++ b/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> ; diff --git a/basis/compiler/tree/cleanup/cleanup.factor b/basis/compiler/tree/cleanup/cleanup.factor index cc5f0619cd..44a6a11802 100644 --- a/basis/compiler/tree/cleanup/cleanup.factor +++ b/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 diff --git a/basis/compiler/tree/escape-analysis/branches/branches.factor b/basis/compiler/tree/escape-analysis/branches/branches.factor index c44861e45f..b728e9a1ba 100644 --- a/basis/compiler/tree/escape-analysis/branches/branches.factor +++ b/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 -- ) diff --git a/basis/compiler/tree/normalization/normalization.factor b/basis/compiler/tree/normalization/normalization.factor index 08481726dc..587dd6938b 100644 --- a/basis/compiler/tree/normalization/normalization.factor +++ b/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 ; diff --git a/basis/compiler/tree/propagation/info/info.factor b/basis/compiler/tree/propagation/info/info.factor index 8f2220aaaf..0891a6629c 100644 --- a/basis/compiler/tree/propagation/info/info.factor +++ b/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 -- ? ) { diff --git a/basis/compiler/tree/tree.factor b/basis/compiler/tree/tree.factor index 2bb3fa0cfc..b6c798ca3c 100755 --- a/basis/compiler/tree/tree.factor +++ b/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, ; diff --git a/basis/db/postgresql/lib/lib.factor b/basis/db/postgresql/lib/lib.factor index eba7f69334..63284b28a3 100755 --- a/basis/db/postgresql/lib/lib.factor +++ b/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 ; diff --git a/basis/db/types/types.factor b/basis/db/types/types.factor index d3b99fcff3..c7fbcd859e 100755 --- a/basis/db/types/types.factor +++ b/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 -- ) diff --git a/basis/debugger/debugger.factor b/basis/debugger/debugger.factor index 06c410c0e4..4d01567131 100755 --- a/basis/debugger/debugger.factor +++ b/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 diff --git a/basis/farkup/farkup.factor b/basis/farkup/farkup.factor index baf2ccaba2..c029423714 100644 --- a/basis/farkup/farkup.factor +++ b/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 " - dup empty? [ drop ] [ " alt=\"" write write "\"" write ] if + [ " alt=\"" write write "\"" write ] unless-empty "/>" write ] if ; diff --git a/basis/fry/fry.factor b/basis/fry/fry.factor index e2feb3cc17..2b84d58d06 100755 --- a/basis/fry/fry.factor +++ b/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) ; diff --git a/basis/furnace/actions/actions.factor b/basis/furnace/actions/actions.factor index d42972c360..1370ae95b2 100755 --- a/basis/furnace/actions/actions.factor +++ b/basis/furnace/actions/actions.factor @@ -23,11 +23,11 @@ SYMBOL: rest : render-validation-messages ( -- ) form get errors>> - dup empty? [ drop ] [ + [ - ] 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 [ diff --git a/basis/furnace/auth/features/edit-profile/edit-profile.factor b/basis/furnace/auth/features/edit-profile/edit-profile.factor index fb4fbb898f..e6d85809b9 100644 --- a/basis/furnace/auth/features/edit-profile/edit-profile.factor +++ b/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 diff --git a/basis/furnace/furnace.factor b/basis/furnace/furnace.factor index fadd398882..9dfaa49028 100644 --- a/basis/furnace/furnace.factor +++ b/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 ] diff --git a/basis/help/help.factor b/basis/help/help.factor index 7535ba8c1a..b2fff22372 100755 --- a/basis/help/help.factor +++ b/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* ; diff --git a/basis/help/lint/lint.factor b/basis/help/lint/lint.factor index b12dcaa807..4ad9067457 100755 --- a/basis/help/lint/lint.factor +++ b/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. ; diff --git a/basis/help/markup/markup.factor b/basis/help/markup/markup.factor index d94b9c4b41..3077a93ed4 100755 --- a/basis/help/markup/markup.factor +++ b/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 -- ) [ diff --git a/basis/hints/hints.factor b/basis/hints/hints.factor index 28bce0ec42..da6ab96959 100644 --- a/basis/hints/hints.factor +++ b/basis/hints/hints.factor @@ -13,10 +13,10 @@ IN: hints dup length [ (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 [ diff --git a/basis/html/streams/streams.factor b/basis/html/streams/streams.factor index d21c743dcd..6a15b76bd3 100755 --- a/basis/html/streams/streams.factor +++ b/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 ] [ call - ] 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 ] [
call
- ] if ; inline + ] if-empty ; inline : format-html-div ( string style stream -- ) stream>> [ diff --git a/basis/inspector/inspector.factor b/basis/inspector/inspector.factor index c8fb7d365a..7b451d5266 100755 --- a/basis/inspector/inspector.factor +++ b/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* ; diff --git a/basis/io/sockets/sockets.factor b/basis/io/sockets/sockets.factor index 79a1abd49c..8c9f26b1dd 100755 --- a/basis/io/sockets/sockets.factor +++ b/basis/io/sockets/sockets.factor @@ -95,11 +95,11 @@ M: invalid-inet6 summary drop "Invalid IPv6 address" ; [ "Component not a number" throw ] unless* ] B{ } map-as - ] if ; + ] if-empty ; : pad-inet6 ( string1 string2 -- seq ) 2dup [ length ] bi@ + 8 swap - diff --git a/basis/lcs/diff2html/diff2html.factor b/basis/lcs/diff2html/diff2html.factor index 754e69a476..b92eeb1250 100644 --- a/basis/lcs/diff2html/diff2html.factor +++ b/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 diff --git a/basis/locals/locals.factor b/basis/locals/locals.factor index 3ba52ea391..5f237dd86b 100755 --- a/basis/locals/locals.factor +++ b/basis/locals/locals.factor @@ -98,8 +98,8 @@ C: quote UNION: special local quote local-word local-reader local-writer ; : load-locals-quot ( args -- quot ) - dup empty? [ - drop [ ] + [ + [ ] ] [ dup [ local-reader? ] contains? [ [ @@ -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 ; diff --git a/basis/logging/insomniac/insomniac.factor b/basis/logging/insomniac/insomniac.factor index 7810a4afad..79d9410994 100755 --- a/basis/logging/insomniac/insomniac.factor +++ b/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 ] [ 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 diff --git a/basis/models/history/history.factor b/basis/models/history/history.factor index fc90ada35a..caf6f39d5c 100755 --- a/basis/models/history/history.factor +++ b/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 ; diff --git a/basis/multiline/multiline.factor b/basis/multiline/multiline.factor index 561af504c6..856b9ad456 100755 --- a/basis/multiline/multiline.factor +++ b/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 diff --git a/basis/prettyprint/prettyprint.factor b/basis/prettyprint/prettyprint.factor index c52ab18027..3b9d034378 100755 --- a/basis/prettyprint/prettyprint.factor +++ b/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 ) [ diff --git a/basis/random/random.factor b/basis/random/random.factor index d37e2fc2b7..133bf93b61 100755 --- a/basis/random/random.factor +++ b/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 ; diff --git a/basis/stack-checker/backend/backend.factor b/basis/stack-checker/backend/backend.factor index 4d0fd6d8aa..8a268b79eb 100755 --- a/basis/stack-checker/backend/backend.factor +++ b/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 dup 1array #introduce, d-in inc - ] [ pop ] if ; + meta-d get [ + 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 -- ) diff --git a/basis/stack-checker/branches/branches.factor b/basis/stack-checker/branches/branches.factor index 015e00ef46..4685483103 100644 --- a/basis/stack-checker/branches/branches.factor +++ b/basis/stack-checker/branches/branches.factor @@ -31,10 +31,10 @@ SYMBOL: +bottom+ : unify-values ( values -- phi-out ) remove-bottom - dup empty? [ drop ] [ + [ ] [ [ known ] map dup all-eq? [ first make-known ] [ drop ] 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 ; diff --git a/basis/stack-checker/errors/errors.factor b/basis/stack-checker/errors/errors.factor index ade47d8e91..2d962d5fad 100644 --- a/basis/stack-checker/errors/errors.factor +++ b/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 ; diff --git a/basis/stack-checker/transforms/transforms.factor b/basis/stack-checker/transforms/transforms.factor index 2773b8b4e4..d60565e849 100755 --- a/basis/stack-checker/transforms/transforms.factor +++ b/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 diff --git a/basis/tools/deploy/config/config.factor b/basis/tools/deploy/config/config.factor index 065db4d8c1..0ebda89b15 100755 --- a/basis/tools/deploy/config/config.factor +++ b/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> diff --git a/basis/tools/scaffold/scaffold.factor b/basis/tools/scaffold/scaffold.factor index 8bc9f93bd2..c4cca565c7 100644 --- a/basis/tools/scaffold/scaffold.factor +++ b/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 ; diff --git a/basis/tools/test/test.factor b/basis/tools/test/test.factor index b2b13a82a8..d3304bbdb1 100755 --- a/basis/tools/test/test.factor +++ b/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. ; diff --git a/basis/tools/vocabs/browser/browser.factor b/basis/tools/vocabs/browser/browser.factor index a771a35735..c3296df280 100755 --- a/basis/tools/vocabs/browser/browser.factor +++ b/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 ] 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-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 diff --git a/basis/tools/vocabs/vocabs.factor b/basis/tools/vocabs/vocabs.factor index cc49d283b4..1c7e8d28d2 100755 --- a/basis/tools/vocabs/vocabs.factor +++ b/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) [ diff --git a/basis/tools/walker/walker.factor b/basis/tools/walker/walker.factor index 9c6b87b439..c1073eda8c 100755 --- a/basis/tools/walker/walker.factor +++ b/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 diff --git a/basis/ui/gestures/gestures.factor b/basis/ui/gestures/gestures.factor index 6b53d25ea1..1170ea3fd1 100755 --- a/basis/ui/gestures/gestures.factor +++ b/basis/ui/gestures/gestures.factor @@ -108,7 +108,7 @@ SYMBOL: double-click-timeout : drag-gesture ( -- ) hand-buttons get-global - dup empty? [ drop ] [ first button-gesture ] if ; + [ first 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 prune dup empty? [ drop f ] [ >array ] if ; + 0 prune [ f ] [ >array ] if-empty ; : drag-loc ( -- loc ) hand-loc get-global hand-click-loc get-global v- ; diff --git a/basis/ui/tools/listener/listener.factor b/basis/ui/tools/listener/listener.factor index 683eff9457..4c20abca87 100755 --- a/basis/ui/tools/listener/listener.factor +++ b/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 ; diff --git a/basis/unicode/breaks/breaks.factor b/basis/unicode/breaks/breaks.factor index fe19685b53..e4018e4d20 100755 --- a/basis/unicode/breaks/breaks.factor +++ b/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 ; diff --git a/basis/windows/com/wrapper/wrapper.factor b/basis/windows/com/wrapper/wrapper.factor index 782ebae516..59b616ecc7 100755 --- a/basis/windows/com/wrapper/wrapper.factor +++ b/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 ) diff --git a/basis/xml/tokenize/tokenize.factor b/basis/xml/tokenize/tokenize.factor index 2e91c23f60..0c3ef2c1df 100644 --- a/basis/xml/tokenize/tokenize.factor +++ b/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 ] [ throw ] if ; + [ throw ] unless-empty ; : good-version ( version -- version ) dup { "1.0" "1.1" } member? [ throw ] unless ; diff --git a/basis/xml/writer/writer.factor b/basis/xml/writer/writer.factor index 8bda10102d..0c98e9a48e 100644 --- a/basis/xml/writer/writer.factor +++ b/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 -- ) diff --git a/core/classes/algebra/algebra.factor b/core/classes/algebra/algebra.factor index 0f419678d1..b32bac3a18 100755 --- a/core/classes/algebra/algebra.factor +++ b/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 -- ) diff --git a/core/classes/builtin/builtin.factor b/core/classes/builtin/builtin.factor index b0e4754682..ee687c2939 100644 --- a/core/classes/builtin/builtin.factor +++ b/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 ; diff --git a/core/classes/intersection/intersection.factor b/core/classes/intersection/intersection.factor index bb7e0adc62..55831fcdb4 100644 --- a/core/classes/intersection/intersection.factor +++ b/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 ; diff --git a/core/classes/tuple/parser/parser.factor b/core/classes/tuple/parser/parser.factor index 0865de16c3..531658a5e0 100644 --- a/core/classes/tuple/parser/parser.factor +++ b/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 ; diff --git a/core/classes/union/union.factor b/core/classes/union/union.factor index fbb1925363..81a0db52be 100755 --- a/core/classes/union/union.factor +++ b/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 ; diff --git a/core/destructors/destructors.factor b/core/destructors/destructors.factor index bed1c16bcf..154e1c30ac 100755 --- a/core/destructors/destructors.factor +++ b/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 diff --git a/core/io/files/files.factor b/core/io/files/files.factor index 93405fe7c0..e52799d10a 100755 --- a/core/io/files/files.factor +++ b/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 ; diff --git a/core/io/streams/string/string.factor b/core/io/streams/string/string.factor index 607076b809..b2b75509e9 100755 --- a/core/io/streams/string/string.factor +++ b/core/io/streams/string/string.factor @@ -18,7 +18,7 @@ M: growable stream-flush drop ; 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 ; diff --git a/core/sequences/sequences-docs.factor b/core/sequences/sequences-docs.factor index 4ada1ece9a..f9b4abaada 100755 --- a/core/sequences/sequences-docs.factor +++ b/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." } diff --git a/core/sequences/sequences.factor b/core/sequences/sequences.factor index b7f36eb071..18291aaa70 100755 --- a/core/sequences/sequences.factor +++ b/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 * + ; diff --git a/extra/backtrack/backtrack.factor b/extra/backtrack/backtrack.factor index db2c50173c..df397025f6 100755 --- a/extra/backtrack/backtrack.factor +++ b/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 - ] [ [ 1quotation ] assoc-map ] bi diff --git a/extra/cords/cords.factor b/extra/cords/cords.factor index 52cb9914b4..915744491f 100644 --- a/extra/cords/cords.factor +++ b/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 ; : ( seqs -- cord ) dup length 2 = [ diff --git a/extra/game-input/backend/iokit/iokit.factor b/extra/game-input/backend/iokit/iokit.factor index 4a7d251425..5267dd6d6e 100755 --- a/extra/game-input/backend/iokit/iokit.factor +++ b/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 ; diff --git a/extra/html/parser/parser.factor b/extra/html/parser/parser.factor index 94a50196a6..ccd225e6e0 100644 --- a/extra/html/parser/parser.factor +++ b/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* diff --git a/extra/inverse/inverse.factor b/extra/inverse/inverse.factor index c7925b94be..b843c73983 100755 --- a/extra/inverse/inverse.factor +++ b/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 ; diff --git a/extra/irc/ui/commandparser/commandparser.factor b/extra/irc/ui/commandparser/commandparser.factor index 2835023c0d..163517698a 100755 --- a/extra/irc/ui/commandparser/commandparser.factor +++ b/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* ; diff --git a/extra/irc/ui/ui.factor b/extra/irc/ui/ui.factor index 1aebfcbfcb..457a984820 100755 --- a/extra/irc/ui/ui.factor +++ b/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 -- ) diff --git a/extra/koszul/koszul.factor b/extra/koszul/koszul.factor index 2b67a3755e..5bd679d92a 100755 --- a/extra/koszul/koszul.factor +++ b/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? [ diff --git a/extra/math/polynomials/polynomials.factor b/extra/math/polynomials/polynomials.factor index 1883f56929..018b041afd 100644 --- a/extra/math/polynomials/polynomials.factor +++ b/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> diff --git a/extra/math/primes/factors/factors.factor b/extra/math/primes/factors/factors.factor index aba7e90bc9..83d53c4215 100644 --- a/extra/math/primes/factors/factors.factor +++ b/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 ; diff --git a/extra/math/text/english/english.factor b/extra/math/text/english/english.factor index b8256533bf..387be4d791 100755 --- a/extra/math/text/english/english.factor +++ b/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? [ diff --git a/extra/money/money.factor b/extra/money/money.factor index bf9f4d3a67..fb743e15af 100644 --- a/extra/money/money.factor +++ b/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 ; diff --git a/extra/multi-methods/multi-methods.factor b/extra/multi-methods/multi-methods.factor index 8859f07340..a8025828f1 100755 --- a/extra/multi-methods/multi-methods.factor +++ b/extra/multi-methods/multi-methods.factor @@ -112,10 +112,10 @@ SYMBOL: total dup length [ 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 ; diff --git a/extra/pack/pack.factor b/extra/pack/pack.factor index b487b385b9..a5d4b36c0b 100755 --- a/extra/pack/pack.factor +++ b/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 diff --git a/extra/porter-stemmer/porter-stemmer.factor b/extra/porter-stemmer/porter-stemmer.factor index 9a2a08bcbe..7ae273f20a 100644 --- a/extra/porter-stemmer/porter-stemmer.factor +++ b/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 { diff --git a/extra/project-euler/079/079.factor b/extra/project-euler/079/079.factor index f64c345694..1e6a2fb0b4 100644 --- a/extra/project-euler/079/079.factor +++ b/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> diff --git a/extra/reports/noise/noise.factor b/extra/reports/noise/noise.factor index 4a36121046..78ede32801 100755 --- a/extra/reports/noise/noise.factor +++ b/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 diff --git a/extra/sequences/lib/lib-docs.factor b/extra/sequences/lib/lib-docs.factor index b2e805304e..9975da00db 100755 --- a/extra/sequences/lib/lib-docs.factor +++ b/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 diff --git a/extra/sequences/lib/lib-tests.factor b/extra/sequences/lib/lib-tests.factor index 76f3bb4f5b..12bdd45c46 100755 --- a/extra/sequences/lib/lib-tests.factor +++ b/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 diff --git a/extra/sequences/lib/lib.factor b/extra/sequences/lib/lib.factor index 2eb3c44b42..225b3b7d9e 100755 --- a/extra/sequences/lib/lib.factor +++ b/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 - diff --git a/extra/units/units.factor b/extra/units/units.factor index 7604108b82..02005fcd1f 100755 --- a/extra/units/units.factor +++ b/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 ; : ( n top bot -- obj ) symbolic-reduce diff --git a/extra/xml/syntax/syntax.factor b/extra/xml/syntax/syntax.factor index 283efa8412..6b765461e5 100644 --- a/extra/xml/syntax/syntax.factor +++ b/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 [