From 6dce834d91b5cb3992af7a772c249dd55a1b8b85 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sun, 30 Nov 2008 18:28:15 -0600 Subject: [PATCH] Get rid of some more >r/r> usages --- basis/cocoa/pasteboard/pasteboard.factor | 2 +- basis/cocoa/subclassing/subclassing.factor | 2 +- basis/cocoa/views/views.factor | 11 +++++---- basis/compiler/alien/alien.factor | 2 +- basis/compiler/codegen/codegen.factor | 16 ++++++------- basis/compiler/codegen/fixup/fixup.factor | 15 ++++++------ .../concurrency/conditions/conditions.factor | 17 ++++++++------ .../count-downs/count-downs.factor | 6 ++--- .../distributed/distributed-tests.factor | 2 +- .../concurrency/exchangers/exchangers.factor | 6 ++--- basis/concurrency/flags/flags-tests.factor | 8 +++---- basis/concurrency/flags/flags.factor | 2 +- basis/concurrency/futures/futures.factor | 4 ++-- basis/concurrency/locks/locks-tests.factor | 23 ++++--------------- basis/concurrency/locks/locks.factor | 15 ++++++------ basis/concurrency/mailboxes/mailboxes.factor | 10 ++++---- .../messaging/messaging-docs.factor | 2 +- basis/concurrency/messaging/messaging.factor | 15 ++++-------- basis/concurrency/promises/promises.factor | 2 +- .../concurrency/semaphores/semaphores.factor | 10 ++++---- basis/io/pipes/pipes.factor | 14 +++++------ 21 files changed, 84 insertions(+), 100 deletions(-) diff --git a/basis/cocoa/pasteboard/pasteboard.factor b/basis/cocoa/pasteboard/pasteboard.factor index d266c2452f..9302097adf 100644 --- a/basis/cocoa/pasteboard/pasteboard.factor +++ b/basis/cocoa/pasteboard/pasteboard.factor @@ -20,7 +20,7 @@ IN: cocoa.pasteboard : set-pasteboard-string ( str pasteboard -- ) NSStringPboardType dup 1array pick set-pasteboard-types - >r swap r> -> setString:forType: drop ; + [ swap ] dip -> setString:forType: drop ; : pasteboard-error ( error -- f ) "Pasteboard does not hold a string" diff --git a/basis/cocoa/subclassing/subclassing.factor b/basis/cocoa/subclassing/subclassing.factor index fd18c7fa89..40f21d25b8 100644 --- a/basis/cocoa/subclassing/subclassing.factor +++ b/basis/cocoa/subclassing/subclassing.factor @@ -36,7 +36,7 @@ IN: cocoa.subclassing ] map concat ; : prepare-method ( ret types quot -- type imp ) - >r [ encode-types ] 2keep r> [ + [ [ encode-types ] 2keep ] dip [ "cdecl" swap 4array % \ alien-callback , ] [ ] make define-temp ; diff --git a/basis/cocoa/views/views.factor b/basis/cocoa/views/views.factor index d03688b2be..cd113b5c64 100644 --- a/basis/cocoa/views/views.factor +++ b/basis/cocoa/views/views.factor @@ -74,7 +74,7 @@ PRIVATE> -> autorelease ; : ( class dim -- view ) - >r -> alloc 0 0 r> first2 + [ -> alloc 0 0 ] dip first2 -> initWithFrame:pixelFormat: dup 1 -> setPostsBoundsChangedNotifications: dup 1 -> setPostsFrameChangedNotifications: ; @@ -85,10 +85,11 @@ PRIVATE> swap NSRect-h >fixnum 2array ; : mouse-location ( view event -- loc ) - over >r - -> locationInWindow f -> convertPoint:fromView: - dup NSPoint-x swap NSPoint-y - r> -> frame NSRect-h swap - 2array ; + [ + -> locationInWindow f -> convertPoint:fromView: + [ NSPoint-x ] [ NSPoint-y ] bi + ] [ drop -> frame NSRect-h ] 2bi + swap - 2array ; USE: opengl.gl USE: alien.syntax diff --git a/basis/compiler/alien/alien.factor b/basis/compiler/alien/alien.factor index e414d6e29b..4a41014ab2 100644 --- a/basis/compiler/alien/alien.factor +++ b/basis/compiler/alien/alien.factor @@ -18,7 +18,7 @@ IN: compiler.alien dup c-type-stack-align? [ c-type-align ] [ drop cell ] if ; : parameter-align ( n type -- n delta ) - over >r c-type-stack-align align dup r> - ; + [ c-type-stack-align align dup ] [ drop ] 2bi - ; : parameter-sizes ( types -- total offsets ) #! Compute stack frame locations. diff --git a/basis/compiler/codegen/codegen.factor b/basis/compiler/codegen/codegen.factor index f0b8279cb4..2161c8b091 100644 --- a/basis/compiler/codegen/codegen.factor +++ b/basis/compiler/codegen/codegen.factor @@ -277,7 +277,7 @@ M: object reg-class-full? : spill-param ( reg-class -- n reg-class ) stack-params get - >r reg-size cell align stack-params +@ r> + [ reg-size cell align stack-params +@ ] dip stack-params ; : fastcall-param ( reg-class -- n reg-class ) @@ -313,10 +313,10 @@ M: long-long-type flatten-value-type ( type -- types ) ] { } make ; : each-parameter ( parameters quot -- ) - >r [ parameter-sizes nip ] keep r> 2each ; inline + [ [ parameter-sizes nip ] keep ] dip 2each ; inline : reverse-each-parameter ( parameters quot -- ) - >r [ parameter-sizes nip ] keep r> 2reverse-each ; inline + [ [ parameter-sizes nip ] keep ] dip 2reverse-each ; inline : reset-freg-counts ( -- ) { int-regs float-regs stack-params } [ 0 swap set ] each ; @@ -329,15 +329,13 @@ M: long-long-type flatten-value-type ( type -- types ) #! Moves values from C stack to registers (if word is #! %load-param-reg) and registers to C stack (if word is #! %save-param-reg). - >r - alien-parameters - flatten-value-types - r> '[ alloc-parameter _ execute ] each-parameter ; - inline + [ alien-parameters flatten-value-types ] + [ '[ alloc-parameter _ execute ] ] + bi* each-parameter ; inline : unbox-parameters ( offset node -- ) parameters>> [ - %prepare-unbox >r over + r> unbox-parameter + %prepare-unbox [ over + ] dip unbox-parameter ] reverse-each-parameter drop ; : prepare-box-struct ( node -- offset ) diff --git a/basis/compiler/codegen/fixup/fixup.factor b/basis/compiler/codegen/fixup/fixup.factor index 06abec5968..0302218652 100755 --- a/basis/compiler/codegen/fixup/fixup.factor +++ b/basis/compiler/codegen/fixup/fixup.factor @@ -46,28 +46,27 @@ M: integer fixup* , ; : indq ( elt seq -- n ) [ eq? ] with find drop ; : adjoin* ( obj table -- n ) - 2dup indq [ 2nip ] [ dup length >r push r> ] if* ; + 2dup indq [ 2nip ] [ dup length [ push ] dip ] if* ; SYMBOL: literal-table : add-literal ( obj -- n ) literal-table get adjoin* ; : add-dlsym-literals ( symbol dll -- ) - >r string>symbol r> 2array literal-table get push-all ; + [ string>symbol ] dip 2array literal-table get push-all ; : rel-dlsym ( name dll class -- ) - >r literal-table get length >r - add-dlsym-literals - r> r> rt-dlsym rel-fixup ; + [ literal-table get length [ add-dlsym-literals ] dip ] dip + rt-dlsym rel-fixup ; : rel-word ( word class -- ) - >r add-literal r> rt-xt rel-fixup ; + [ add-literal ] dip rt-xt rel-fixup ; : rel-primitive ( word class -- ) - >r def>> first r> rt-primitive rel-fixup ; + [ def>> first ] dip rt-primitive rel-fixup ; : rel-immediate ( literal class -- ) - >r add-literal r> rt-immediate rel-fixup ; + [ add-literal ] dip rt-immediate rel-fixup ; : rel-this ( class -- ) 0 swap rt-label rel-fixup ; diff --git a/basis/concurrency/conditions/conditions.factor b/basis/concurrency/conditions/conditions.factor index 43374d3127..11e624110c 100644 --- a/basis/concurrency/conditions/conditions.factor +++ b/basis/concurrency/conditions/conditions.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: deques threads kernel arrays sequences alarms ; +USING: deques threads kernel arrays sequences alarms fry ; IN: concurrency.conditions : notify-1 ( deque -- ) @@ -12,15 +12,18 @@ IN: concurrency.conditions : queue-timeout ( queue timeout -- alarm ) #! Add an alarm which removes the current thread from the #! queue, and resumes it, passing it a value of t. - >r [ self swap push-front* ] keep [ - [ delete-node ] [ drop node-value ] 2bi - t swap resume-with - ] 2curry r> later ; + [ + [ self swap push-front* ] keep '[ + _ _ + [ delete-node ] [ drop node-value ] 2bi + t swap resume-with + ] + ] dip later ; : wait ( queue timeout status -- ) over [ - >r queue-timeout [ drop ] r> suspend + [ queue-timeout [ drop ] ] dip suspend [ "Timeout" throw ] [ cancel-alarm ] if ] [ - >r drop [ push-front ] curry r> suspend drop + [ drop '[ _ push-front ] ] dip suspend drop ] if ; diff --git a/basis/concurrency/count-downs/count-downs.factor b/basis/concurrency/count-downs/count-downs.factor index c4bc92c688..d79cfbf1c9 100644 --- a/basis/concurrency/count-downs/count-downs.factor +++ b/basis/concurrency/count-downs/count-downs.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: dlists kernel math concurrency.promises -concurrency.mailboxes debugger accessors ; +concurrency.mailboxes debugger accessors fry ; IN: concurrency.count-downs ! http://java.sun.com/j2se/1.5.0/docs/api/java/util/concurrent/CountDownLatch.html @@ -26,12 +26,12 @@ ERROR: count-down-already-done ; [ 1- >>n count-down-check ] if ; : await-timeout ( count-down timeout -- ) - >r promise>> r> ?promise-timeout ?linked t assert= ; + [ promise>> ] dip ?promise-timeout ?linked t assert= ; : await ( count-down -- ) f await-timeout ; : spawn-stage ( quot count-down -- ) - [ [ count-down ] curry compose ] keep + [ '[ @ _ count-down ] ] keep "Count down stage" swap promise>> mailbox>> spawn-linked-to drop ; diff --git a/basis/concurrency/distributed/distributed-tests.factor b/basis/concurrency/distributed/distributed-tests.factor index 528e1956b8..1087823aa0 100644 --- a/basis/concurrency/distributed/distributed-tests.factor +++ b/basis/concurrency/distributed/distributed-tests.factor @@ -15,7 +15,7 @@ concurrency.messaging continuations accessors prettyprint ; [ ] [ [ - receive first2 >r 3 + r> send + receive first2 [ 3 + ] dip send "thread-a" unregister-process ] "Thread A" spawn "thread-a" swap register-process diff --git a/basis/concurrency/exchangers/exchangers.factor b/basis/concurrency/exchangers/exchangers.factor index 6b44886eda..97b3c14fe4 100644 --- a/basis/concurrency/exchangers/exchangers.factor +++ b/basis/concurrency/exchangers/exchangers.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: kernel threads boxes accessors ; +USING: kernel threads boxes accessors fry ; IN: concurrency.exchangers ! Motivated by @@ -14,8 +14,8 @@ TUPLE: exchanger thread object ; : exchange ( obj exchanger -- newobj ) dup thread>> occupied>> [ dup object>> box> - >r thread>> box> resume-with r> + [ thread>> box> resume-with ] dip ] [ [ object>> >box ] keep - [ thread>> >box ] curry "exchange" suspend + '[ _ thread>> >box ] "exchange" suspend ] if ; diff --git a/basis/concurrency/flags/flags-tests.factor b/basis/concurrency/flags/flags-tests.factor index 0f78183aba..a666293316 100644 --- a/basis/concurrency/flags/flags-tests.factor +++ b/basis/concurrency/flags/flags-tests.factor @@ -2,7 +2,7 @@ IN: concurrency.flags.tests USING: tools.test concurrency.flags concurrency.combinators kernel threads locals accessors calendar ; -:: flag-test-1 ( -- ) +:: flag-test-1 ( -- val ) [let | f [ ] | [ f raise-flag ] "Flag test" spawn drop f lower-flag @@ -20,7 +20,7 @@ kernel threads locals accessors calendar ; [ f ] [ flag-test-2 ] unit-test -:: flag-test-3 ( -- ) +:: flag-test-3 ( -- val ) [let | f [ ] | f raise-flag f value>> @@ -28,7 +28,7 @@ kernel threads locals accessors calendar ; [ t ] [ flag-test-3 ] unit-test -:: flag-test-4 ( -- ) +:: flag-test-4 ( -- val ) [let | f [ ] | [ f raise-flag ] "Flag test" spawn drop f wait-for-flag @@ -37,7 +37,7 @@ kernel threads locals accessors calendar ; [ t ] [ flag-test-4 ] unit-test -:: flag-test-5 ( -- ) +:: flag-test-5 ( -- val ) [let | f [ ] | [ 1 seconds sleep f raise-flag ] "Flag test" spawn drop f wait-for-flag diff --git a/basis/concurrency/flags/flags.factor b/basis/concurrency/flags/flags.factor index ec260961d0..c65171a3f0 100644 --- a/basis/concurrency/flags/flags.factor +++ b/basis/concurrency/flags/flags.factor @@ -11,7 +11,7 @@ TUPLE: flag value threads ; dup value>> [ drop ] [ t >>value threads>> notify-all ] if ; : wait-for-flag-timeout ( flag timeout -- ) - over value>> [ 2drop ] [ >r threads>> r> "flag" wait ] if ; + over value>> [ 2drop ] [ [ threads>> ] dip "flag" wait ] if ; : wait-for-flag ( flag -- ) f wait-for-flag-timeout ; diff --git a/basis/concurrency/futures/futures.factor b/basis/concurrency/futures/futures.factor index 132342aff1..a1f4f57af6 100644 --- a/basis/concurrency/futures/futures.factor +++ b/basis/concurrency/futures/futures.factor @@ -1,12 +1,12 @@ ! Copyright (C) 2005, 2008 Chris Double, Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: concurrency.promises concurrency.mailboxes kernel arrays -continuations accessors ; +continuations accessors fry ; IN: concurrency.futures : future ( quot -- future ) [ - [ [ >r call r> fulfill ] 2curry "Future" ] keep + [ '[ @ _ fulfill ] "Future" ] keep mailbox>> spawn-linked-to drop ] keep ; inline diff --git a/basis/concurrency/locks/locks-tests.factor b/basis/concurrency/locks/locks-tests.factor index 7696e6c1eb..8f82aa88ba 100644 --- a/basis/concurrency/locks/locks-tests.factor +++ b/basis/concurrency/locks/locks-tests.factor @@ -3,7 +3,7 @@ USING: tools.test concurrency.locks concurrency.count-downs concurrency.messaging concurrency.mailboxes locals kernel threads sequences calendar accessors ; -:: lock-test-0 ( -- ) +:: lock-test-0 ( -- v ) [let | v [ V{ } clone ] c [ 2 ] | @@ -27,7 +27,7 @@ threads sequences calendar accessors ; v ] ; -:: lock-test-1 ( -- ) +:: lock-test-1 ( -- v ) [let | v [ V{ } clone ] l [ ] c [ 2 ] | @@ -79,7 +79,7 @@ threads sequences calendar accessors ; [ ] [ dup [ [ ] with-read-lock ] with-write-lock ] unit-test -:: rw-lock-test-1 ( -- ) +:: rw-lock-test-1 ( -- v ) [let | l [ ] c [ 1 ] c' [ 1 ] @@ -129,7 +129,7 @@ threads sequences calendar accessors ; [ V{ 1 2 3 4 5 6 } ] [ rw-lock-test-1 ] unit-test -:: rw-lock-test-2 ( -- ) +:: rw-lock-test-2 ( -- v ) [let | l [ ] c [ 1 ] c' [ 2 ] @@ -160,7 +160,7 @@ threads sequences calendar accessors ; [ V{ 1 2 3 } ] [ rw-lock-test-2 ] unit-test ! Test lock timeouts -:: lock-timeout-test ( -- ) +:: lock-timeout-test ( -- v ) [let | l [ ] | [ l [ 1 seconds sleep ] with-lock @@ -177,19 +177,6 @@ threads sequences calendar accessors ; thread>> name>> "Lock timeout-er" = ] must-fail-with -:: read/write-test ( -- ) - [let | l [ ] | - [ - l [ 1 seconds sleep ] with-lock - ] "Lock holder" spawn drop - - [ - l 1/10 seconds [ ] with-lock-timeout - ] "Lock timeout-er" spawn-linked drop - - receive - ] ; - [ dup [ 1 seconds [ ] with-write-lock-timeout diff --git a/basis/concurrency/locks/locks.factor b/basis/concurrency/locks/locks.factor index 8c1392dbfb..0094f3323d 100644 --- a/basis/concurrency/locks/locks.factor +++ b/basis/concurrency/locks/locks.factor @@ -1,7 +1,8 @@ ! Copyright (C) 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: deques dlists kernel threads continuations math -concurrency.conditions combinators.short-circuit accessors ; +concurrency.conditions combinators.short-circuit accessors +locals ; IN: concurrency.locks ! Simple critical sections @@ -17,16 +18,16 @@ TUPLE: lock threads owner reentrant? ; : acquire-lock ( lock timeout -- ) over owner>> - [ 2dup >r threads>> r> "lock" wait ] when drop + [ 2dup [ threads>> ] dip "lock" wait ] when drop self >>owner drop ; : release-lock ( lock -- ) f >>owner threads>> notify-1 ; -: do-lock ( lock timeout quot acquire release -- ) - >r >r pick rot r> call ! use up timeout acquire - swap r> curry [ ] cleanup ; inline +:: do-lock ( lock timeout quot acquire release -- ) + lock timeout acquire call + quot lock release curry [ ] cleanup ; inline : (with-lock) ( lock timeout quot -- ) [ acquire-lock ] [ release-lock ] do-lock ; inline @@ -60,7 +61,7 @@ TUPLE: rw-lock readers writers reader# writer ; : acquire-read-lock ( lock timeout -- ) over writer>> - [ 2dup >r readers>> r> "read lock" wait ] when drop + [ 2dup [ readers>> ] dip "read lock" wait ] when drop add-reader ; : notify-writer ( lock -- ) @@ -75,7 +76,7 @@ TUPLE: rw-lock readers writers reader# writer ; : acquire-write-lock ( lock timeout -- ) over writer>> pick reader#>> 0 > or - [ 2dup >r writers>> r> "write lock" wait ] when drop + [ 2dup [ writers>> ] dip "write lock" wait ] when drop self >>writer drop ; : release-write-lock ( lock -- ) diff --git a/basis/concurrency/mailboxes/mailboxes.factor b/basis/concurrency/mailboxes/mailboxes.factor index 39b21e0943..63707041a2 100644 --- a/basis/concurrency/mailboxes/mailboxes.factor +++ b/basis/concurrency/mailboxes/mailboxes.factor @@ -4,7 +4,7 @@ IN: concurrency.mailboxes USING: dlists deques threads sequences continuations destructors namespaces math quotations words kernel arrays assocs init system concurrency.conditions accessors -debugger debugger.threads locals ; +debugger debugger.threads locals fry ; TUPLE: mailbox threads data disposed ; @@ -21,7 +21,7 @@ M: mailbox dispose* threads>> notify-all ; [ threads>> notify-all ] bi yield ; : wait-for-mailbox ( mailbox timeout -- ) - >r threads>> r> "mailbox" wait ; + [ threads>> ] dip "mailbox" wait ; :: block-unless-pred ( mailbox timeout pred: ( message -- ? ) -- ) mailbox check-disposed @@ -57,11 +57,11 @@ M: mailbox dispose* threads>> notify-all ; f mailbox-get-all-timeout ; : while-mailbox-empty ( mailbox quot -- ) - [ [ mailbox-empty? ] curry ] dip [ ] while ; inline + [ '[ _ mailbox-empty? ] ] dip [ ] while ; inline : mailbox-get-timeout? ( mailbox timeout pred -- obj ) [ block-unless-pred ] - [ nip >r data>> r> delete-node-if ] + [ [ drop data>> ] dip delete-node-if ] 3bi ; inline : mailbox-get? ( mailbox pred -- obj ) @@ -90,7 +90,7 @@ M: linked-thread error-in-thread [ ] [ supervisor>> ] bi mailbox-put ; : ( quot name mailbox -- thread' ) - >r linked-thread new-thread r> >>supervisor ; + [ linked-thread new-thread ] dip >>supervisor ; : spawn-linked-to ( quot name mailbox -- thread ) [ (spawn) ] keep ; diff --git a/basis/concurrency/messaging/messaging-docs.factor b/basis/concurrency/messaging/messaging-docs.factor index 6c9e530d9b..25538cd594 100644 --- a/basis/concurrency/messaging/messaging-docs.factor +++ b/basis/concurrency/messaging/messaging-docs.factor @@ -55,7 +55,7 @@ ARTICLE: { "concurrency" "synchronous-sends" } "Synchronous sends" { $example "USING: concurrency.messaging kernel threads ;" ": pong-server ( -- )" - " receive >r \"pong\" r> reply-synchronous ;" + " receive [ \"pong\" ] dip reply-synchronous ;" "[ pong-server t ] \"pong-server\" spawn-server" "\"ping\" swap send-synchronous ." "\"pong\"" diff --git a/basis/concurrency/messaging/messaging.factor b/basis/concurrency/messaging/messaging.factor index 9aeb24ed72..7a00f62e9e 100644 --- a/basis/concurrency/messaging/messaging.factor +++ b/basis/concurrency/messaging/messaging.factor @@ -1,10 +1,7 @@ ! Copyright (C) 2005, 2008 Chris Double, Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -! -! Concurrency library for Factor, based on Erlang/Termite style -! concurrency. USING: kernel threads concurrency.mailboxes continuations -namespaces assocs accessors summary ; +namespaces assocs accessors summary fry ; IN: concurrency.messaging GENERIC: send ( message thread -- ) @@ -32,7 +29,7 @@ M: thread send ( message thread -- ) my-mailbox -rot mailbox-get-timeout? ?linked ; inline : rethrow-linked ( error process supervisor -- ) - >r r> send ; + [ ] dip send ; : spawn-linked ( quot name -- thread ) my-mailbox spawn-linked-to ; @@ -48,9 +45,7 @@ TUPLE: reply data tag ; tag>> \ reply boa ; : synchronous-reply? ( response synchronous -- ? ) - over reply? - [ >r tag>> r> tag>> = ] - [ 2drop f ] if ; + over reply? [ [ tag>> ] bi@ = ] [ 2drop f ] if ; ERROR: cannot-send-synchronous-to-self message thread ; @@ -61,8 +56,8 @@ M: cannot-send-synchronous-to-self summary dup self eq? [ cannot-send-synchronous-to-self ] [ - >r dup r> send - [ synchronous-reply? ] curry receive-if + [ dup ] dip send + '[ _ synchronous-reply? ] receive-if data>> ] if ; diff --git a/basis/concurrency/promises/promises.factor b/basis/concurrency/promises/promises.factor index 382697e04f..2ff338c4e3 100644 --- a/basis/concurrency/promises/promises.factor +++ b/basis/concurrency/promises/promises.factor @@ -20,7 +20,7 @@ ERROR: promise-already-fulfilled promise ; ] if ; : ?promise-timeout ( promise timeout -- result ) - >r mailbox>> r> block-if-empty mailbox-peek ; + [ mailbox>> ] dip block-if-empty mailbox-peek ; : ?promise ( promise -- result ) f ?promise-timeout ; diff --git a/basis/concurrency/semaphores/semaphores.factor b/basis/concurrency/semaphores/semaphores.factor index 1b55c7afa5..59518f4c8d 100644 --- a/basis/concurrency/semaphores/semaphores.factor +++ b/basis/concurrency/semaphores/semaphores.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: dlists kernel threads math concurrency.conditions -continuations accessors summary ; +continuations accessors summary locals fry ; IN: concurrency.semaphores TUPLE: semaphore count threads ; @@ -30,9 +30,9 @@ M: negative-count-semaphore summary [ 1+ ] change-count threads>> notify-1 ; -: with-semaphore-timeout ( semaphore timeout quot -- ) - pick rot acquire-timeout swap - [ release ] curry [ ] cleanup ; inline +:: with-semaphore-timeout ( semaphore timeout quot -- ) + semaphore timeout acquire-timeout + quot [ semaphore release ] [ ] cleanup ; inline : with-semaphore ( semaphore quot -- ) - over acquire swap [ release ] curry [ ] cleanup ; inline + swap dup acquire '[ _ release ] [ ] cleanup ; inline diff --git a/basis/io/pipes/pipes.factor b/basis/io/pipes/pipes.factor index ca4046fe07..3a7fa5a2e0 100644 --- a/basis/io/pipes/pipes.factor +++ b/basis/io/pipes/pipes.factor @@ -15,9 +15,10 @@ HOOK: (pipe) io-backend ( -- pipe ) : ( encoding -- stream ) [ - >r (pipe) |dispose - [ in>> ] [ out>> ] bi - r> + [ + (pipe) |dispose + [ in>> ] [ out>> ] bi + ] dip ] with-destructors ; r [ ?reader ] [ ?writer ] bi* - r> with-streams* + [ [ ?reader ] [ ?writer ] bi* ] dip with-streams* ] with-destructors ; : ( n -- pipes ) @@ -48,8 +48,8 @@ PRIVATE> : run-pipeline ( seq -- results ) [ length dup zero? [ drop { } ] [ 1- ] if ] keep [ - >r [ first in>> ] [ second out>> ] bi - r> run-pipeline-element + [ [ first in>> ] [ second out>> ] bi ] dip + run-pipeline-element ] 2parallel-map ; {