[
{
{ 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
M: ##copy visit-insn
[ dst>> ] [ src>> resolve ] bi
- dup [ record-copy ] [ 2drop ] if ;
+ [ record-copy ] [ drop ] if* ;
: useless-phi ( dst inputs -- ) first record-copy ;
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
] 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
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 ;
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 ;
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 ;
: (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>> [
: 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 ;
[
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 ;
dup first length identity-matrix [
[
dup leading drop
- dup [ basis-vector ] [ 2drop ] if
+ [ basis-vector ] [ drop ] if*
] each
] with-matrix flip nonzero-rows
] unless ;
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 ;
: 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
: 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
[ 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: ;
[ 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 ;
} 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
[
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 ;
: 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
{
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>> [
[
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>> [
! 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
: 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 ;
[
dup [ digit? ] all? [
current-rule-set digit-re>>
- dup [ dupd matches? ] [ drop f ] if
+ [ dupd matches? ] [ f ] if*
] unless*
]
} 0&& nip ;
: 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 )
: check-end-delegate ( -- ? )
context get parent>> [
in-rule>> [
- dup rule-end-matches? dup [
+ dup rule-end-matches? [
[
swap handle-rule-end
?end-rule
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* ;
<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? ;
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? [
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 )
] 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 ;
<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 -- )
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 ;
[ 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>
: 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 )
: 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 )