diff --git a/basis/channels/remote/remote.factor b/basis/channels/remote/remote.factor index 1b75def6cd..8b30a5236c 100644 --- a/basis/channels/remote/remote.factor +++ b/basis/channels/remote/remote.factor @@ -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 diff --git a/basis/compiler/cfg/copy-prop/copy-prop.factor b/basis/compiler/cfg/copy-prop/copy-prop.factor index 2dab52fe4a..50da49adb7 100644 --- a/basis/compiler/cfg/copy-prop/copy-prop.factor +++ b/basis/compiler/cfg/copy-prop/copy-prop.factor @@ -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 ; diff --git a/basis/compiler/tree/dead-code/branches/branches.factor b/basis/compiler/tree/dead-code/branches/branches.factor index 2ca4ceaa08..a4c610f364 100644 --- a/basis/compiler/tree/dead-code/branches/branches.factor +++ b/basis/compiler/tree/dead-code/branches/branches.factor @@ -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 [ look-at-values ] [ 2drop ] if ; + [ index ] dip swap [ look-at-values ] [ drop ] if* ; M: #phi compute-live-values* #! If any of the outputs of a #phi are live, then the diff --git a/basis/furnace/actions/actions.factor b/basis/furnace/actions/actions.factor index 262a55e343..e5720636ff 100644 --- a/basis/furnace/actions/actions.factor +++ b/basis/furnace/actions/actions.factor @@ -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 diff --git a/basis/furnace/scopes/scopes.factor b/basis/furnace/scopes/scopes.factor index 4d005e8adc..8606c5ae38 100644 --- a/basis/furnace/scopes/scopes.factor +++ b/basis/furnace/scopes/scopes.factor @@ -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 ; diff --git a/basis/io/backend/unix/unix.factor b/basis/io/backend/unix/unix.factor index 3a4c31565b..2468c53e58 100755 --- a/basis/io/backend/unix/unix.factor +++ b/basis/io/backend/unix/unix.factor @@ -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 ; diff --git a/basis/io/directories/search/search.factor b/basis/io/directories/search/search.factor index 4357e5cd8c..e0df575bf0 100644 --- a/basis/io/directories/search/search.factor +++ b/basis/io/directories/search/search.factor @@ -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 ; diff --git a/basis/io/sockets/secure/unix/unix.factor b/basis/io/sockets/secure/unix/unix.factor index 125e442e61..084cd5ded9 100644 --- a/basis/io/sockets/secure/unix/unix.factor +++ b/basis/io/sockets/secure/unix/unix.factor @@ -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>> [ diff --git a/basis/locals/rewrite/point-free/point-free.factor b/basis/locals/rewrite/point-free/point-free.factor index f633cb50ce..283a3bbd5a 100644 --- a/basis/locals/rewrite/point-free/point-free.factor +++ b/basis/locals/rewrite/point-free/point-free.factor @@ -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 ; diff --git a/basis/math/matrices/elimination/elimination.factor b/basis/math/matrices/elimination/elimination.factor index 1d00a55dea..021e086745 100644 --- a/basis/math/matrices/elimination/elimination.factor +++ b/basis/math/matrices/elimination/elimination.factor @@ -81,7 +81,7 @@ SYMBOL: matrix [ rows iota [ 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 ; diff --git a/basis/mirrors/mirrors.factor b/basis/mirrors/mirrors.factor index b267621918..00c6232e76 100644 --- a/basis/mirrors/mirrors.factor +++ b/basis/mirrors/mirrors.factor @@ -14,7 +14,7 @@ C: 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 ; diff --git a/basis/stack-checker/branches/branches.factor b/basis/stack-checker/branches/branches.factor index 5eab8a11bc..af1d8d31a4 100644 --- a/basis/stack-checker/branches/branches.factor +++ b/basis/stack-checker/branches/branches.factor @@ -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+ ] dip append ] [ 3drop f ] if ; + [ [ - +top+ ] dip append ] [ 2drop f ] if* ; : pad-with-bottom ( seq -- newseq ) ! Terminated branches are padded with bottom values which diff --git a/basis/ui/backend/cocoa/views/views.factor b/basis/ui/backend/cocoa/views/views.factor index 0c0d37af94..e2ee2ba472 100644 --- a/basis/ui/backend/cocoa/views/views.factor +++ b/basis/ui/backend/cocoa/views/views.factor @@ -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 ] [ 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 ; diff --git a/basis/ui/gadgets/buttons/buttons.factor b/basis/ui/gadgets/buttons/buttons.factor index a8da106917..869fd35606 100644 --- a/basis/ui/gadgets/buttons/buttons.factor +++ b/basis/ui/gadgets/buttons/buttons.factor @@ -77,10 +77,10 @@ C: 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 [ diff --git a/basis/ui/tools/listener/listener.factor b/basis/ui/tools/listener/listener.factor index 64aa11253a..62bc9e0c55 100644 --- a/basis/ui/tools/listener/listener.factor +++ b/basis/ui/tools/listener/listener.factor @@ -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 { diff --git a/basis/unrolled-lists/unrolled-lists.factor b/basis/unrolled-lists/unrolled-lists.factor index 1a72b0f1ff..bfb8e07e4f 100644 --- a/basis/unrolled-lists/unrolled-lists.factor +++ b/basis/unrolled-lists/unrolled-lists.factor @@ -47,7 +47,7 @@ M: unrolled-list clear-deque unroll-factor 0 [ 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 [ set-first ] keep ] dip [ f node boa dup ] keep - dup [ next<< ] [ 2drop ] if ; inline + [ next<< ] [ drop ] if* ; inline : normalize-front ( list -- ) dup front>> [ diff --git a/basis/vocabs/hierarchy/hierarchy.factor b/basis/vocabs/hierarchy/hierarchy.factor index e431671022..b80d760b44 100644 --- a/basis/vocabs/hierarchy/hierarchy.factor +++ b/basis/vocabs/hierarchy/hierarchy.factor @@ -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 ; diff --git a/basis/xmode/marker/marker.factor b/basis/xmode/marker/marker.factor index 8f8776dc46..7e7d0b5ccf 100644 --- a/basis/xmode/marker/marker.factor +++ b/basis/xmode/marker/marker.factor @@ -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* ; diff --git a/core/classes/algebra/algebra.factor b/core/classes/algebra/algebra.factor index 5d8babd512..ad386c176e 100644 --- a/core/classes/algebra/algebra.factor +++ b/core/classes/algebra/algebra.factor @@ -132,7 +132,7 @@ SYMBOL: +incomparable+ > ] dip [ class<= ] curry all? ; diff --git a/core/classes/classes.factor b/core/classes/classes.factor index afba453144..290269242c 100644 --- a/core/classes/classes.factor +++ b/core/classes/classes.factor @@ -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? [ diff --git a/core/generic/generic.factor b/core/generic/generic.factor index 6f402bca7d..88ab8ef80e 100644 --- a/core/generic/generic.factor +++ b/core/generic/generic.factor @@ -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 ) diff --git a/core/vocabs/loader/loader.factor b/core/vocabs/loader/loader.factor index a024655b21..1de8ecabd5 100644 --- a/core/vocabs/loader/loader.factor +++ b/core/vocabs/loader/loader.factor @@ -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 : 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 ; diff --git a/extra/sequences/abbrev/abbrev.factor b/extra/sequences/abbrev/abbrev.factor index 2dc2247783..1a74079696 100644 --- a/extra/sequences/abbrev/abbrev.factor +++ b/extra/sequences/abbrev/abbrev.factor @@ -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> diff --git a/extra/smalltalk/compiler/lexenv/lexenv.factor b/extra/smalltalk/compiler/lexenv/lexenv.factor index 21fe1698e0..3a7d29e6da 100644 --- a/extra/smalltalk/compiler/lexenv/lexenv.factor +++ b/extra/smalltalk/compiler/lexenv/lexenv.factor @@ -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 )