From 8a921c791cf64e9bdcf5ea92b89e59e2c081380d Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sat, 6 Sep 2008 19:13:59 -0500 Subject: [PATCH] if-empty changes --- basis/base64/base64.factor | 2 +- basis/channels/channels.factor | 4 ++-- basis/checksums/sha1/sha1.factor | 2 +- .../generator/iterator/iterator.factor | 8 +++---- basis/compiler/tree/checker/checker.factor | 2 +- basis/compiler/tree/cleanup/cleanup.factor | 4 ++-- .../escape-analysis/branches/branches.factor | 4 ++-- .../tree/normalization/normalization.factor | 2 +- .../tree/propagation/info/info.factor | 5 ++-- basis/compiler/tree/tree.factor | 2 +- basis/db/postgresql/lib/lib.factor | 6 ++--- basis/db/types/types.factor | 2 +- basis/debugger/debugger.factor | 6 ++--- basis/fry/fry.factor | 10 ++++---- basis/furnace/actions/actions.factor | 10 ++++---- .../features/edit-profile/edit-profile.factor | 4 ++-- basis/furnace/furnace.factor | 3 +-- basis/help/help.factor | 9 +++---- basis/help/lint/lint.factor | 5 ++-- basis/help/markup/markup.factor | 6 ++--- basis/hints/hints.factor | 4 ++-- basis/html/streams/streams.factor | 12 +++++----- basis/inspector/inspector.factor | 6 ++--- basis/io/sockets/sockets.factor | 4 ++-- basis/lcs/diff2html/diff2html.factor | 4 ++-- basis/locals/locals.factor | 12 ++++------ basis/logging/insomniac/insomniac.factor | 4 ++-- basis/models/history/history.factor | 5 ++-- basis/prettyprint/prettyprint.factor | 6 ++--- basis/random/random.factor | 6 ++--- basis/stack-checker/backend/backend.factor | 10 ++++---- basis/stack-checker/branches/branches.factor | 8 +++---- basis/stack-checker/errors/errors.factor | 4 ++-- .../transforms/transforms.factor | 6 ++--- basis/tools/deploy/config/config.factor | 2 +- basis/tools/test/test.factor | 9 ++++--- basis/tools/vocabs/browser/browser.factor | 24 +++++++++---------- basis/tools/vocabs/vocabs.factor | 12 ++++------ basis/tools/walker/walker.factor | 2 +- basis/ui/gestures/gestures.factor | 4 ++-- basis/ui/tools/listener/listener.factor | 6 ++--- basis/unicode/breaks/breaks.factor | 4 ++-- basis/windows/com/wrapper/wrapper.factor | 2 +- basis/xml/tokenize/tokenize.factor | 2 +- basis/xml/writer/writer.factor | 2 +- 45 files changed, 119 insertions(+), 137 deletions(-) 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/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/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/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 -- )