]> gitweb.factorcode.org Git - factor.git/commitdiff
use ``if*`` instead of ``dup [ ] [ drop ] if``.
authorJohn Benediktsson <mrjbq7@gmail.com>
Tue, 21 Jul 2015 05:24:30 +0000 (22:24 -0700)
committerJohn Benediktsson <mrjbq7@gmail.com>
Tue, 21 Jul 2015 05:24:30 +0000 (22:24 -0700)
25 files changed:
basis/channels/remote/remote.factor
basis/compiler/cfg/copy-prop/copy-prop.factor
basis/compiler/tree/dead-code/branches/branches.factor
basis/furnace/actions/actions.factor
basis/furnace/scopes/scopes.factor
basis/io/backend/unix/unix.factor
basis/io/directories/search/search.factor
basis/io/sockets/secure/unix/unix.factor
basis/locals/rewrite/point-free/point-free.factor
basis/math/matrices/elimination/elimination.factor
basis/mirrors/mirrors.factor
basis/stack-checker/branches/branches.factor
basis/ui/backend/cocoa/views/views.factor
basis/ui/gadgets/buttons/buttons.factor
basis/ui/tools/listener/listener.factor
basis/unrolled-lists/unrolled-lists.factor
basis/vocabs/hierarchy/hierarchy.factor
basis/xmode/marker/marker.factor
core/classes/algebra/algebra.factor
core/classes/classes.factor
core/generic/generic.factor
core/vocabs/loader/loader.factor
core/vocabs/parser/parser.factor
extra/sequences/abbrev/abbrev.factor
extra/smalltalk/compiler/lexenv/lexenv.factor

index 1b75def6cd5d3d8ebe716ab9f4dc6951d9868bfa..8b30a5236c6b5ffde5a9cf68679ee37133e90f25 100644 (file)
@@ -34,7 +34,7 @@ TUPLE: from-message id ;
     [
         {
             { T{ to-message f ?id ?value  }
-            [ ?value ?id get-channel dup [ to f ] [ 2drop no-channel ] if ] }
+            [ ?value ?id get-channel [ to f ] [ drop no-channel ] if* ] }
             { T{ from-message f ?id }
             [ ?id get-channel [ from ] [ no-channel ] if* ] }
         } match-cond
index 2dab52fe4af11515fef5bad2498a46a9e919be64..50da49adb761bfc83f3d09f5f60c063942b165af 100644 (file)
@@ -33,7 +33,7 @@ GENERIC: visit-insn ( insn -- )
 
 M: ##copy visit-insn
     [ dst>> ] [ src>> resolve ] bi
-    dup [ record-copy ] [ 2drop ] if ;
+    [ record-copy ] [ drop ] if* ;
 
 : useless-phi ( dst inputs -- ) first record-copy ;
 
index 2ca4ceaa088e941ae83a90736f9605540bbdb7f9..a4c610f36431341115e09535ba64b496d114c586 100644 (file)
@@ -12,7 +12,7 @@ M: #if mark-live-values* look-at-inputs ;
 M: #dispatch mark-live-values* look-at-inputs ;
 
 : look-at-phi ( value outputs inputs -- )
-    [ index ] dip swap dup [ <column> look-at-values ] [ 2drop ] if ;
+    [ index ] dip swap [ <column> look-at-values ] [ drop ] if* ;
 
 M: #phi compute-live-values*
     #! If any of the outputs of a #phi are live, then the
index 262a55e343dd478a3954f935367e3ddd47902ae2..e5720636ff470e42d228d3ee535a48a0cefa244e 100644 (file)
@@ -84,7 +84,7 @@ CONSTANT: revalidate-url-key "__u"
     ] with-exit-continuation ;
 
 : handle-rest ( path action -- )
-    rest>> dup [ [ "/" join ] dip set-param ] [ 2drop ] if ;
+    rest>> [ [ "/" join ] dip set-param ] [ drop ] if* ;
 
 : init-action ( path action -- )
     begin-form
index 4d005e8adc52be40d3be3c8240057fd75879ccbf..8606c5ae38191c68ad3e095cecb83dc8679f3cf7 100644 (file)
@@ -20,7 +20,7 @@ scope f
     t >>changed? drop ;
 
 : scope-get ( key scope -- value )
-    dup [ namespace>> at ] [ 2drop f ] if ;
+    [ namespace>> at ] [ drop f ] if* ;
 
 : scope-set ( value key scope -- )
     [ namespace>> set-at ] [ scope-changed ] bi ;
index 3a4c31565b5379b6fec6e860ccce86aef23803fd..2468c53e58addad7154f3ee3009e16dc27bcaab4 100755 (executable)
@@ -124,7 +124,7 @@ M: fd drain
 M: unix (wait-to-write) ( port -- )
     dup
     dup handle>> check-disposed drain
-    dup [ wait-for-port ] [ 2drop ] if ;
+    [ wait-for-port ] [ drop ] if* ;
 
 M: unix io-multiplex ( nanos -- )
     mx get-global wait-for-events ;
index 4357e5cd8c24b8f4be2e189a00c024189f0b3c5e..e0df575bf0bf124042c40addceabf96cce984d92 100644 (file)
@@ -103,7 +103,7 @@ PRIVATE>
 ERROR: file-not-found path bfs? quot ;
 
 : find-file-throws ( path bfs? quot -- path )
-    3dup find-file dup [ 2nip nip ] [ drop file-not-found ] if ; inline
+    3dup find-file [ 2nip nip ] [ file-not-found ] if* ; inline
 
 ERROR: sequence-expected obj ;
 
index 125e442e61f8116a6da8d56dce8cb26e58ec38c7..084cd5ded9f5739cfb000f9b77f357e249e951f6 100644 (file)
@@ -47,7 +47,7 @@ M: secure (accept)
 
 : (shutdown) ( handle -- )
     dup dup handle>> SSL_shutdown check-shutdown-response
-    dup [ dupd wait-for-fd (shutdown) ] [ 2drop ] if ;
+    [ dupd wait-for-fd (shutdown) ] [ drop ] if* ;
 
 M: ssl-handle shutdown
     dup connected>> [
index f633cb50ce1c664111ae67f8cf65434645b6d3fe..283a3bbd5a112ab602d69575759cfe5c9f530a35 100644 (file)
@@ -10,7 +10,7 @@ IN: locals.rewrite.point-free
 
 : local-index ( args obj -- n )
     2dup '[ unquote _ eq? ] find drop
-    dup [ 2nip ] [ drop bad-local ] if ;
+    [ 2nip ] [ bad-local ] if* ;
 
 : read-local-quot ( args obj -- quot )
     local-index neg [ get-local ] curry ;
index 1d00a55dea53ab0379cac3bd0d91914179acd95e..021e0867459d200b969ca63d6e5de34e7eef8602 100644 (file)
@@ -81,7 +81,7 @@ SYMBOL: matrix
     [
         rows iota <reversed> [
             dup nth-row leading drop
-            dup [ swap dup iota clear-col ] [ 2drop ] if
+            [ swap dup iota clear-col ] [ drop ] if*
         ] each
     ] with-matrix ;
 
@@ -96,7 +96,7 @@ SYMBOL: matrix
         dup first length identity-matrix [
             [
                 dup leading drop
-                dup [ basis-vector ] [ 2drop ] if
+                [ basis-vector ] [ drop ] if*
             ] each
         ] with-matrix flip nonzero-rows
     ] unless ;
index b267621918d863947a251aa75f974e9587d36397..00c6232e76bcadde28173dbfe2d8319ba190baad 100644 (file)
@@ -14,7 +14,7 @@ C: <mirror> mirror
 
 M: mirror at*
     [ nip object>> ] [ object-slots slot-named ] 2bi
-    dup [ offset>> slot t ] [ 2drop f f ] if ;
+    [ offset>> slot t ] [ drop f f ] if* ;
 
 ERROR: no-such-slot slot ;
 ERROR: read-only-slot slot ;
index 5eab8a11bc5a4cc7bfb8375e367358f2b5c977ea..af1d8d31a4499d37f026d644927f489016eae01e 100644 (file)
@@ -15,7 +15,7 @@ SYMBOLS: +bottom+ +top+ ;
 : unify-inputs ( max-input-count input-count meta-d -- new-meta-d )
     ! Introduced values can be anything, and don't unify with
     ! literals.
-    dup [ [ - +top+ <repetition> ] dip append ] [ 3drop f ] if ;
+    [ [ - +top+ <repetition> ] dip append ] [ 2drop f ] if* ;
 
 : pad-with-bottom ( seq -- newseq )
     ! Terminated branches are padded with bottom values which
index 0c0d37af94e8e6f812e3a4aa10e37ad0775fc8e5..e2ee2ba472de51a6cbe737574bea7645365ed934 100644 (file)
@@ -12,7 +12,7 @@ IN: ui.backend.cocoa.views
 
 : send-mouse-moved ( view event -- )
     [ mouse-location ] [ drop window ] 2bi
-    dup [ move-hand fire-motion yield ] [ 2drop ] if ;
+    [ move-hand fire-motion yield ] [ drop ] if* ;
 
 : button ( event -- n )
     #! Cocoa -> Factor UI button mapping
@@ -68,7 +68,7 @@ CONSTANT: key-codes
     [ event-modifiers ] [ key-code ] bi ;
 
 : send-key-event ( view gesture -- )
-    swap window dup [ propagate-key-gesture ] [ 2drop ] if ;
+    swap window [ propagate-key-gesture ] [ drop ] if* ;
 
 : interpret-key-event ( view event -- )
     NSArray swap -> arrayWithObject: -> interpretKeyEvents: ;
@@ -89,21 +89,21 @@ CONSTANT: key-codes
     [ mouse-location ]
     [ drop window ]
     2tri
-    dup [ send-button-down ] [ 3drop ] if ;
+    [ send-button-down ] [ 2drop ] if* ;
 
 : send-button-up$ ( view event -- )
     [ nip mouse-event>gesture <button-up> ]
     [ mouse-location ]
     [ drop window ]
     2tri
-    dup [ send-button-up ] [ 3drop ] if ;
+    [ send-button-up ] [ 2drop ] if* ;
 
 : send-scroll$ ( view event -- )
     [ nip [ -> deltaX ] [ -> deltaY ] bi [ neg ] bi@ 2array ]
     [ mouse-location ]
     [ drop window ]
     2tri
-    dup [ send-scroll ] [ 3drop ] if ;
+    [ send-scroll ] [ 2drop ] if* ;
 
 : send-action$ ( view event gesture -- )
     [ drop window ] dip over [ send-action ] [ 2drop ] if ;
index a8da106917338cf5bfac4bf090f1e1c4fe0dd8b0..869fd356065c99ee9890ef63b46fe13ce4ba5045 100644 (file)
@@ -77,10 +77,10 @@ C: <button-pen> button-pen
     } cond ;
 
 M: button-pen draw-interior
-    lookup-button-pen dup [ draw-interior ] [ 2drop ] if ;
+    lookup-button-pen [ draw-interior ] [ drop ] if* ;
 
 M: button-pen draw-boundary
-    lookup-button-pen dup [ draw-boundary ] [ 2drop ] if ;
+    lookup-button-pen [ draw-boundary ] [ drop ] if* ;
 
 M: button-pen pen-pref-dim
     [
index 64aa11253a6107ca0ffe4dd04b17413ac557057e..62bc9e0c551f48879368b43a7144a7720b68db7a 100644 (file)
@@ -56,9 +56,9 @@ M: vocab-completion (word-at-caret)
     drop dup vocab-exists? [ >vocab-link ] [ drop f ] if ;
 
 M: word-completion (word-at-caret)
-    manifest>> dup [
+    manifest>> [
         '[ _ _ search-manifest ] [ drop f ] recover
-    ] [ 2drop f ] if ;
+    ] [ drop f ] if* ;
 
 M: char-completion (word-at-caret) 2drop f ;
 
@@ -368,7 +368,7 @@ M: interactor stream-read-quot
 : interactor-operation ( gesture interactor -- ? )
     [ token-model>> value>> ] keep word-at-caret
     [ nip ] [ gesture>operation ] 2bi
-    dup [ invoke-command f ] [ 2drop t ] if ;
+    [ invoke-command f ] [ drop t ] if* ;
 
 M: interactor handle-gesture
     {
index 1a72b0f1ff686cf3e153de7d42c69eaf751f72e9..bfb8e07e4f3b525bd7473dd054716a0492a66d65 100644 (file)
@@ -47,7 +47,7 @@ M: unrolled-list clear-deque
         unroll-factor 0 <array>
         [ unroll-factor 1 - swap set-nth ] keep f
     ] dip [ node boa dup ] keep
-    dup [ prev<< ] [ 2drop ] if ; inline
+    [ prev<< ] [ drop ] if* ; inline
 
 : normalize-back ( list -- )
     dup back>> [
@@ -93,7 +93,7 @@ M: unrolled-list pop-front*
     [
         unroll-factor 0 <array> [ set-first ] keep
     ] dip [ f node boa dup ] keep
-    dup [ next<< ] [ 2drop ] if ; inline
+    [ next<< ] [ drop ] if* ; inline
 
 : normalize-front ( list -- )
     dup front>> [
index e4316710226765ade284ec35647aa66d140c279c..b80d760b44e641419ceba6c5c13561585a96bf01 100644 (file)
@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors arrays assocs combinators.short-circuit fry
 io.directories io.files io.files.types io.pathnames kernel make
-memoize namespaces sequences sorting splitting vocabs sets
+memoize namespaces sequences sets sorting splitting vocabs
 vocabs.loader vocabs.metadata ;
 IN: vocabs.hierarchy
 
@@ -153,6 +153,8 @@ PRIVATE>
 : load-all ( -- )
     "" load ;
 
-MEMO: all-tags ( -- seq ) [ vocab-tags ] collect-vocabs ;
+MEMO: all-tags ( -- seq )
+    [ vocab-tags ] collect-vocabs ;
 
-MEMO: all-authors ( -- seq ) [ vocab-authors ] collect-vocabs ;
+MEMO: all-authors ( -- seq )
+    [ vocab-authors ] collect-vocabs ;
index 8f8776dc466e97c68d1d8563dc58541f9a1be323..7e7d0b5ccf08a24fb46d9012a5e5696beec299d2 100644 (file)
@@ -33,7 +33,7 @@ IN: xmode.marker
         [
             dup [ digit? ] all? [
                 current-rule-set digit-re>>
-                dup [ dupd matches? ] [ drop f ] if
+                [ dupd matches? ] [ f ] if*
             ] unless*
         ]
     } 0&& nip ;
@@ -130,25 +130,25 @@ GENERIC: handle-rule-end ( match-count rule -- )
 : check-escape-rule ( rule -- ? )
     no-escape?>> [ f ] [
         find-escape-rule dup [
-            dup rule-start-matches? dup [
+            dup rule-start-matches? [
                 swap handle-rule-start
                 delegate-end-escaped? toggle
                 t
             ] [
-                2drop f
-            ] if
+                drop f
+            ] if*
         ] when
     ] if ;
 
 : check-every-rule ( -- ? )
     current-char current-rule-set get-rules
     [ rule-start-matches? ] map-find
-    dup [ handle-rule-start t ] [ 2drop f ] if ;
+    [ handle-rule-start t ] [ drop f ] if* ;
 
 : ?end-rule ( -- )
     current-rule [
         dup rule-end-matches?
-        dup [ swap handle-rule-end ] [ 2drop ] if
+        [ swap handle-rule-end ] [ drop ] if*
     ] when* ;
 
 : rule-match-token* ( rule -- id )
@@ -213,7 +213,7 @@ M: mark-previous-rule handle-rule-start
 : check-end-delegate ( -- ? )
     context get parent>> [
         in-rule>> [
-            dup rule-end-matches? dup [
+            dup rule-end-matches? [
                 [
                     swap handle-rule-end
                     ?end-rule
@@ -223,7 +223,7 @@ M: mark-previous-rule handle-rule-start
                 rule-match-token* next-token,
                 pop-context
                 seen-whitespace-end? on t
-            ] [ drop check-escape-rule ] if
+            ] [ check-escape-rule ] if*
         ] [ f ] if*
     ] [ f ] if* ;
 
index 5d8babd5126d41127b8a90beb145c80ad429db56..ad386c176e0b20d3c3c2541a2ce24dde54184128 100644 (file)
@@ -132,7 +132,7 @@ SYMBOL: +incomparable+
 <PRIVATE
 
 : superclass<= ( first second -- ? )
-    swap superclass-of dup [ swap class<= ] [ 2drop f ] if ;
+    swap superclass-of [ swap class<= ] [ drop f ] if* ;
 
 : left-anonymous-union<= ( first second -- ? )
     [ members>> ] dip [ class<= ] curry all? ;
index afba45314463d78b9623617da1372eaab53bf1ae..290269242c2db0efecce88e22818dd150276d6fe 100644 (file)
@@ -184,7 +184,7 @@ M: sequence implementors [ implementors ] gather ;
 GENERIC: metaclass-changed ( use class -- )
 
 : ?metaclass-changed ( class usages/f -- )
-    dup [ [ metaclass-changed ] with each ] [ 2drop ] if ;
+    [ [ metaclass-changed ] with each ] [ drop ] if* ;
 
 : check-metaclass ( class metaclass -- usages/f )
     over class? [
index 6f402bca7d1652b8dc12ec6090ac413b9ceb1fa8..88ab8ef80eb0ef1bd0ea1155b5356d9f5a2c0f10 100644 (file)
@@ -60,7 +60,8 @@ PRIVATE>
     method-classes interesting-classes smallest-class ;
 
 : method-for-class ( class generic -- method/f )
-    [ nip ] [ nearest-class ] 2bi dup [ swap ?lookup-method ] [ 2drop f ] if ;
+    [ nip ] [ nearest-class ] 2bi
+    [ swap ?lookup-method ] [ drop f ] if* ;
 
 GENERIC: effective-method ( generic -- method )
 
index a024655b214d7eddae83606db0e6159020bc1363..1de8ecabd5f974952607030b6608a0f8e8851e5f 100644 (file)
@@ -56,7 +56,7 @@ PRIVATE>
     ] cache ;
 
 : vocab-append-path ( vocab path -- newpath )
-    swap find-vocab-root dup [ prepend-path ] [ 2drop f ] if ;
+    swap find-vocab-root [ prepend-path ] [ drop f ] if* ;
 
 : vocab-source-path ( vocab -- path/f )
     dup ".factor" append-vocab-dir vocab-append-path ;
@@ -139,7 +139,7 @@ SYMBOL: blacklist
 <PRIVATE
 
 : add-to-blacklist ( error vocab -- )
-    vocab-name blacklist get dup [ set-at ] [ 3drop ] if ;
+    vocab-name blacklist get [ set-at ] [ 2drop ] if* ;
 
 GENERIC: (require) ( name -- )
 
index 3751db3fba33f654b6652703263a06294ecd9ef9..5cf59fdaf5ed59b037595d56f13461dff4c43d72 100644 (file)
@@ -201,7 +201,7 @@ TUPLE: ambiguous-use-error words ;
 PRIVATE>
 
 : search-manifest ( name manifest -- word/f )
-    2dup qualified-search dup [ 2nip ] [ drop vocab-search ] if ;
+    2dup qualified-search [ 2nip ] [ vocab-search ] if* ;
 
 : search ( name -- word/f )
     manifest get search-manifest ;
index 2dc22477838594feadc25add3c85cfe4ad39741a..1a74079696f0d9c53de50feb6d885a04dc5ad0c7 100644 (file)
@@ -12,7 +12,7 @@ IN: sequences.abbrev
     [ prefixes ] keep 1array '[ _ ] H{ } map>assoc ;
 
 : assoc-merge ( assoc1 assoc2 -- assoc3 )
-    [ '[ over _ at dup [ append ] [ drop ] if ] assoc-map ] keep swap assoc-union ;
+    [ '[ over _ at [ append ] when* ] assoc-map ] keep swap assoc-union ;
 
 PRIVATE>
 
index 21fe1698e0956c8370a96010c1454bae41010a7e..3a7d29e6dac5728e6b25e7d7546853b000ab813d 100644 (file)
@@ -32,7 +32,7 @@ CONSTANT: empty-lexenv T{ lexenv }
 : ivar-reader ( name lexenv -- quot/f )
     dup class>> [
         [ class>> "slots" word-prop slot-named ] [ self>> ] bi
-        swap dup [ name>> reader-word [ ] 2sequence ] [ 2drop f ] if
+        swap [ name>> reader-word [ ] 2sequence ] [ drop f ] if*
     ] [ 2drop f ] if ;
 
 : class-name ( name -- quot/f )
@@ -56,7 +56,7 @@ M: bad-identifier summary drop "Unknown identifier" ;
 : ivar-writer ( name lexenv -- quot/f )
     dup class>> [
         [ class>> "slots" word-prop slot-named ] [ self>> ] bi
-        swap dup [ name>> writer-word [ ] 2sequence ] [ 2drop f ] if
+        swap [ name>> writer-word [ ] 2sequence ] [ drop f ] if*
     ] [ 2drop f ] if ;
 
 : lookup-writer ( name lexenv -- writer-quot )