diff --git a/basis/alien/c-types/c-types.factor b/basis/alien/c-types/c-types.factor index 7a20632ca4..de8d36521e 100644 --- a/basis/alien/c-types/c-types.factor +++ b/basis/alien/c-types/c-types.factor @@ -201,10 +201,10 @@ M: byte-array byte-length length ; 1 swap malloc-array ; inline : malloc-byte-array ( byte-array -- alien ) - dup length dup malloc [ -rot memcpy ] keep ; + dup length [ nip malloc dup ] 2keep memcpy ; : memory>byte-array ( alien len -- byte-array ) - dup [ -rot memcpy ] keep ; + [ nip dup ] 2keep memcpy ; : byte-array>memory ( byte-array base -- ) swap dup length memcpy ; diff --git a/basis/alien/structs/structs-tests.factor b/basis/alien/structs/structs-tests.factor index 8c7d9f9b29..ec0c01c2e7 100644 --- a/basis/alien/structs/structs-tests.factor +++ b/basis/alien/structs/structs-tests.factor @@ -38,7 +38,7 @@ C-UNION: barx [ 120 ] [ "barx" heap-size ] unit-test "help" vocab [ - "help" "help" lookup "help" set + "print-topic" "help" lookup "help" set [ ] [ \ foox-x "help" get execute ] unit-test [ ] [ \ set-foox-x "help" get execute ] unit-test ] when diff --git a/basis/cocoa/dialogs/dialogs.factor b/basis/cocoa/dialogs/dialogs.factor index 662b4a7bae..2b01c5d751 100644 --- a/basis/cocoa/dialogs/dialogs.factor +++ b/basis/cocoa/dialogs/dialogs.factor @@ -1,4 +1,4 @@ -! Copyright (C) 2006, 2007 Slava Pestov +! Copyright (C) 2006, 2008 Slava Pestov ! See http://factorcode.org/license.txt for BSD license. USING: kernel cocoa cocoa.messages cocoa.classes cocoa.application sequences splitting core-foundation ; @@ -29,6 +29,6 @@ IN: cocoa.dialogs "/" split1-last [ ] bi@ ; : save-panel ( path -- paths ) - dup - rot split-path -> runModalForDirectory:file: NSOKButton = + [ dup ] dip + split-path -> runModalForDirectory:file: NSOKButton = [ -> filename CF>string ] [ drop f ] if ; diff --git a/basis/cocoa/messages/messages.factor b/basis/cocoa/messages/messages.factor index 4dedd8455a..5bcd6d6f60 100644 --- a/basis/cocoa/messages/messages.factor +++ b/basis/cocoa/messages/messages.factor @@ -160,7 +160,7 @@ objc>alien-types get [ swap ] assoc-map assoc-union alien>objc-types set-global : objc-struct-type ( i string -- ctype ) - 2dup CHAR: = -rot index-from swap subseq + [ CHAR: = ] 2keep index-from swap subseq dup c-types get key? [ "Warning: no such C type: " write dup print drop "void*" diff --git a/basis/cocoa/windows/windows.factor b/basis/cocoa/windows/windows.factor index dd2d1bfd41..3a53a1cc3c 100644 --- a/basis/cocoa/windows/windows.factor +++ b/basis/cocoa/windows/windows.factor @@ -34,5 +34,6 @@ IN: cocoa.windows dup 0 -> setReleasedWhenClosed: ; : window-content-rect ( window -- rect ) - NSWindow over -> frame rot -> styleMask + [ NSWindow ] dip + [ -> frame ] [ -> styleMask ] bi -> contentRectForFrameRect:styleMask: ; diff --git a/basis/core-foundation/fsevents/fsevents.factor b/basis/core-foundation/fsevents/fsevents.factor index 6bec4b23c0..80678ec3da 100644 --- a/basis/core-foundation/fsevents/fsevents.factor +++ b/basis/core-foundation/fsevents/fsevents.factor @@ -4,7 +4,7 @@ USING: alien alien.c-types alien.strings alien.syntax kernel math sequences namespaces make assocs init accessors continuations combinators core-foundation core-foundation.run-loop core-foundation.run-loop.thread -io.encodings.utf8 destructors ; +io.encodings.utf8 destructors locals arrays ; IN: core-foundation.fsevents : kFSEventStreamCreateFlagUseCFTypes 2 ; inline @@ -105,15 +105,14 @@ FUNCTION: CFStringRef FSEventStreamCopyDescription ( FSEventStreamRef streamRef "FSEventStreamContext" [ set-FSEventStreamContext-info ] keep ; -: ( callback info paths latency flags -- event-stream ) - >r >r >r >r >r +:: ( callback info paths latency flags -- event-stream ) f ! allocator - r> ! callback - r> make-FSEventStreamContext - r> ! paths + callback + info make-FSEventStreamContext + paths FSEventStreamEventIdSinceNow ! sinceWhen - r> ! latency - r> ! flags + latency + flags FSEventStreamCreate ; : kCFRunLoopCommonModes ( -- string ) @@ -161,13 +160,11 @@ SYMBOL: event-stream-callbacks : remove-event-source-callback ( id -- ) event-stream-callbacks get delete-at ; -: >event-triple ( n eventPaths eventFlags eventIds -- triple ) - [ - >r >r >r dup dup - r> void*-nth utf8 alien>string , - r> int-nth , - r> longlong-nth , - ] { } make ; +:: >event-triple ( n eventPaths eventFlags eventIds -- triple ) + n eventPaths void*-nth utf8 alien>string + n eventFlags int-nth + n eventIds longlong-nth + 3array ; : master-event-source-callback ( -- alien ) "void" diff --git a/basis/delegate/delegate.factor b/basis/delegate/delegate.factor index 3a7cecb800..e7ea370b8d 100644 --- a/basis/delegate/delegate.factor +++ b/basis/delegate/delegate.factor @@ -36,7 +36,7 @@ M: tuple-class group-words : define-consult ( group class quot -- ) [ register-protocol ] - [ rot group-words -rot [ consult-method ] 2curry each ] + [ [ group-words ] 2dip [ consult-method ] 2curry each ] 3bi ; : CONSULT: diff --git a/basis/inspector/inspector.factor b/basis/inspector/inspector.factor index 7b451d5266..b47426f5bb 100644 --- a/basis/inspector/inspector.factor +++ b/basis/inspector/inspector.factor @@ -49,10 +49,8 @@ SYMBOL: +editable+ ] [ keys ] if ; : describe* ( obj mirror keys -- ) - rot summary. - [ - drop - ] [ + [ summary. ] 2dip + [ drop ] [ dup enum? [ +sequence+ on ] when standard-table-style [ swap [ -rot describe-row ] curry each-index diff --git a/basis/io/unix/select/select.factor b/basis/io/unix/select/select.factor index 530dfe7ab3..1dd1d51e87 100644 --- a/basis/io/unix/select/select.factor +++ b/basis/io/unix/select/select.factor @@ -19,7 +19,7 @@ TUPLE: select-mx < mx read-fdset write-fdset ; FD_SETSIZE 8 * >>write-fdset ; : clear-nth ( n seq -- ? ) - [ nth ] [ f -rot set-nth ] 2bi ; + [ nth ] [ [ f ] 2dip set-nth ] 2bi ; :: check-fd ( fd fdset mx quot -- ) fd munge fdset clear-nth [ fd mx quot call ] when ; inline diff --git a/basis/io/unix/sockets/sockets.factor b/basis/io/unix/sockets/sockets.factor index 8f9ff4f066..a98432b84d 100644 --- a/basis/io/unix/sockets/sockets.factor +++ b/basis/io/unix/sockets/sockets.factor @@ -114,7 +114,7 @@ SYMBOL: receive-buffer ] call ; M: unix (receive) ( datagram -- packet sockaddr ) - dup do-receive dup [ rot drop ] [ + dup do-receive dup [ [ drop ] 2dip ] [ 2drop [ +input+ wait-for-port ] [ (receive) ] bi ] if ; diff --git a/basis/math/complex/complex.factor b/basis/math/complex/complex.factor index acc8a9d6d6..c228684e32 100644 --- a/basis/math/complex/complex.factor +++ b/basis/math/complex/complex.factor @@ -14,8 +14,8 @@ M: complex imaginary-part imaginary>> ; M: complex absq >rect [ sq ] bi@ + ; : 2>rect ( x y -- xr yr xi yi ) - [ [ real-part ] bi@ ] 2keep - [ imaginary-part ] bi@ ; inline + [ [ real-part ] bi@ ] + [ [ imaginary-part ] bi@ ] 2bi ; inline M: complex hashcode* nip >rect [ hashcode ] bi@ bitxor ; @@ -28,21 +28,21 @@ M: complex equal? M: complex number= 2>rect number= [ number= ] [ 2drop f ] if ; -: *re ( x y -- xr*yr xi*ri ) 2>rect * >r * r> ; inline -: *im ( x y -- xi*yr xr*yi ) 2>rect >r * swap r> * ; inline +: *re ( x y -- xr*yr xi*ri ) 2>rect [ * ] 2bi@ ; inline +: *im ( x y -- xi*yr xr*yi ) 2>rect [ * swap ] dip * ; inline -M: complex + 2>rect + >r + r> (rect>) ; -M: complex - 2>rect - >r - r> (rect>) ; -M: complex * 2dup *re - -rot *im + (rect>) ; +M: complex + 2>rect [ + ] 2bi@ (rect>) ; +M: complex - 2>rect [ - ] 2bi@ (rect>) ; +M: complex * [ *re - ] [ *im + ] 2bi (rect>) ; : complex/ ( x y -- r i m ) - dup absq >r 2dup *re + -rot *im - r> ; inline + [ [ *re + ] [ *im - ] 2bi ] keep absq ; inline -M: complex / complex/ tuck / >r / r> (rect>) ; +M: complex / complex/ tuck [ / ] 2bi@ (rect>) ; M: complex abs absq >float fsqrt ; -M: complex sqrt >polar swap fsqrt swap 2.0 / polar> ; +M: complex sqrt >polar [ fsqrt ] [ 2.0 / ] bi* polar> ; IN: syntax diff --git a/basis/math/functions/functions.factor b/basis/math/functions/functions.factor index 1cea0a74dd..8411baf94c 100644 --- a/basis/math/functions/functions.factor +++ b/basis/math/functions/functions.factor @@ -92,16 +92,6 @@ PRIVATE> : 0^ ( x -- z ) dup zero? [ drop 0./0. ] [ 0 < 1./0. 0 ? ] if ; inline -PRIVATE> - -: ^ ( x y -- z ) - { - { [ over zero? ] [ nip 0^ ] } - { [ dup integer? ] [ integer^ ] } - { [ 2dup real^? ] [ fpow ] } - [ ^complex ] - } cond ; inline - : (^mod) ( n x y -- z ) 1 swap [ [ dupd * pick mod ] when [ sq over mod ] dip @@ -114,6 +104,16 @@ PRIVATE> swap [ /mod [ over * swapd - ] dip ] keep (gcd) ] if ; +PRIVATE> + +: ^ ( x y -- z ) + { + { [ over zero? ] [ nip 0^ ] } + { [ dup integer? ] [ integer^ ] } + { [ 2dup real^? ] [ fpow ] } + [ ^complex ] + } cond ; inline + : gcd ( x y -- a d ) [ 0 1 ] 2dip (gcd) dup 0 < [ neg ] when ; foldable @@ -177,9 +177,9 @@ M: complex log >polar swap flog swap rect> ; GENERIC: cos ( x -- y ) foldable M: complex cos - >float-rect 2dup - fcosh swap fcos * -rot - fsinh swap fsin neg * rect> ; + >float-rect + [ [ fcos ] [ fcosh ] bi* * ] + [ [ fsin neg ] [ fsinh ] bi* * ] 2bi rect> ; M: real cos fcos ; @@ -188,9 +188,9 @@ M: real cos fcos ; GENERIC: cosh ( x -- y ) foldable M: complex cosh - >float-rect 2dup - fcos swap fcosh * -rot - fsin swap fsinh * rect> ; + >float-rect + [ [ fcosh ] [ fcos ] bi* * ] + [ [ fsinh ] [ fsin ] bi* * ] 2bi rect> ; M: real cosh fcosh ; @@ -199,9 +199,9 @@ M: real cosh fcosh ; GENERIC: sin ( x -- y ) foldable M: complex sin - >float-rect 2dup - fcosh swap fsin * -rot - fsinh swap fcos * rect> ; + >float-rect + [ [ fsin ] [ fcosh ] bi* * ] + [ [ fcos ] [ fsinh ] bi* * ] 2bi rect> ; M: real sin fsin ; @@ -210,9 +210,9 @@ M: real sin fsin ; GENERIC: sinh ( x -- y ) foldable M: complex sinh - >float-rect 2dup - fcos swap fsinh * -rot - fsin swap fcosh * rect> ; + >float-rect + [ [ fsinh ] [ fcos ] bi* * ] + [ [ fcosh ] [ fsin ] bi* * ] 2bi rect> ; M: real sinh fsinh ; diff --git a/basis/math/ranges/ranges.factor b/basis/math/ranges/ranges.factor index 388d117959..f7b3b37e25 100644 --- a/basis/math/ranges/ranges.factor +++ b/basis/math/ranges/ranges.factor @@ -22,9 +22,9 @@ INSTANCE: range immutable-sequence : twiddle 2dup > -1 1 ? ; inline -: (a, dup roll + -rot ; inline +: (a, dup [ + ] curry 2dip ; inline -: ,b) dup neg rot + swap ; inline +: ,b) dup [ - ] curry dip ; inline : [a,b] ( a b -- range ) twiddle ; inline diff --git a/core/assocs/assocs.factor b/core/assocs/assocs.factor index 953cc38c56..a0d16084b1 100644 --- a/core/assocs/assocs.factor +++ b/core/assocs/assocs.factor @@ -110,8 +110,8 @@ M: assoc assoc-clone-like ( assoc exemplar -- newassoc ) swap [ swapd set-at ] curry assoc-each ; : assoc-union ( assoc1 assoc2 -- union ) - 2dup [ assoc-size ] bi@ + pick new-assoc - [ rot update ] keep [ swap update ] keep ; + [ [ [ assoc-size ] bi@ + ] [ drop ] 2bi new-assoc ] 2keep + [ dupd update ] bi@ ; : assoc-combine ( seq -- union ) H{ } clone [ dupd update ] reduce ; diff --git a/core/classes/intersection/intersection.factor b/core/classes/intersection/intersection.factor index 55831fcdb4..fffb172204 100644 --- a/core/classes/intersection/intersection.factor +++ b/core/classes/intersection/intersection.factor @@ -23,7 +23,7 @@ PREDICATE: intersection-class < class M: intersection-class update-class define-intersection-predicate ; : define-intersection-class ( class participants -- ) - [ f f rot intersection-class define-class ] + [ [ f f ] dip intersection-class define-class ] [ drop update-classes ] 2bi ; diff --git a/core/classes/tuple/tuple.factor b/core/classes/tuple/tuple.factor index b6b277a32f..6f8021f733 100644 --- a/core/classes/tuple/tuple.factor +++ b/core/classes/tuple/tuple.factor @@ -248,7 +248,9 @@ M: tuple-class update-class 3bi ; : tuple-class-unchanged? ( class superclass slots -- ? ) - rot tuck [ superclass = ] [ "slots" word-prop = ] 2bi* and ; + [ over ] dip + [ [ superclass ] dip = ] + [ [ "slots" word-prop ] dip = ] 2bi* and ; : valid-superclass? ( class -- ? ) [ tuple-class? ] [ tuple eq? ] bi or ; diff --git a/core/words/words.factor b/core/words/words.factor index 929161c5d6..618e04ffb4 100644 --- a/core/words/words.factor +++ b/core/words/words.factor @@ -221,7 +221,7 @@ M: word subwords drop f ; "( gensym )" f ; : define-temp ( quot -- word ) - gensym dup rot define ; + [ gensym dup ] dip define ; : reveal ( word -- ) dup [ name>> ] [ vocabulary>> ] bi dup vocab-words