From ad890e8a31d572725fbadfb7ebbf71c505cf0a16 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sat, 6 Sep 2008 17:15:25 -0500 Subject: [PATCH] if-empty changes --- extra/backtrack/backtrack.factor | 5 ++--- extra/cords/cords.factor | 2 +- extra/game-input/backend/iokit/iokit.factor | 2 +- extra/html/parser/parser.factor | 6 ++---- extra/inverse/inverse.factor | 6 ++---- .../irc/ui/commandparser/commandparser.factor | 2 +- extra/irc/ui/ui.factor | 4 ++-- extra/koszul/koszul.factor | 5 ++--- extra/math/polynomials/polynomials.factor | 2 +- extra/math/primes/factors/factors.factor | 4 ++-- extra/math/text/english/english.factor | 6 ++---- extra/money/money.factor | 2 +- extra/multi-methods/multi-methods.factor | 4 ++-- extra/pack/pack.factor | 2 +- extra/porter-stemmer/porter-stemmer.factor | 6 +++--- extra/project-euler/079/079.factor | 4 ++-- extra/reports/noise/noise.factor | 4 ++-- extra/sequences/lib/lib-docs.factor | 20 ------------------- extra/sequences/lib/lib-tests.factor | 3 --- extra/sequences/lib/lib.factor | 9 --------- extra/units/units.factor | 4 ++-- extra/xml/syntax/syntax.factor | 4 ++-- 22 files changed, 33 insertions(+), 73 deletions(-) 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 [ -- 2.34.1