new accessors

diff --git a/basis/concurrency/locks/locks-tests.factor b/basis/concurrency/locks/locks-tests.factor
index 92dede1655ceabe3539da5ec6690ac75eddf99b9..67f9bbb15a241f5e71ceaf18b560cdb26c960222 100755 (executable)
--- a/basis/concurrency/locks/locks-tests.factor
+++ b/basis/concurrency/locks/locks-tests.factor
@@ -174,7 +174,7 @@ threads sequences calendar accessors ;
     ] ;\r
 \r
 [ lock-timeout-test ] [\r
-    linked-error-thread name>> "Lock timeout-er" =\r
+    thread>> name>> "Lock timeout-er" =\r
 ] must-fail-with\r
 \r
 :: read/write-test ( -- )\r

diff --git a/basis/concurrency/locks/locks.factor b/basis/concurrency/locks/locks.factor
index 95b6801db2df1dfe48ea0f1254210ddf428ea2a8..8c1392dbfb667cf84aa9d2621ddd98efc6c93787 100755 (executable)
--- a/basis/concurrency/locks/locks.factor
+++ b/basis/concurrency/locks/locks.factor
@@ -1,7 +1,7 @@
 ! Copyright (C) 2008 Slava Pestov.\r
 ! See http://factorcode.org/license.txt for BSD license.\r
 USING: deques dlists kernel threads continuations math\r
-concurrency.conditions ;\r
+concurrency.conditions combinators.short-circuit accessors ;\r
 IN: concurrency.locks\r
 \r
 ! Simple critical sections\r
@@ -16,13 +16,13 @@ TUPLE: lock threads owner reentrant? ;
 <PRIVATE\r
 \r
 : acquire-lock ( lock timeout -- )\r
-    over lock-owner\r
-    [ 2dup >r lock-threads r> "lock" wait ] when drop\r
-    self swap set-lock-owner ;\r
+    over owner>>\r
+    [ 2dup >r threads>> r> "lock" wait ] when drop\r
+    self >>owner drop ;\r
 \r
 : release-lock ( lock -- )\r
-    f over set-lock-owner\r
-    lock-threads notify-1 ;\r
+    f >>owner\r
+    threads>> notify-1 ;\r
 \r
 : do-lock ( lock timeout quot acquire release -- )\r
     >r >r pick rot r> call ! use up  timeout acquire\r
@@ -34,8 +34,8 @@ TUPLE: lock threads owner reentrant? ;
 PRIVATE>\r
 \r
 : with-lock-timeout ( lock timeout quot -- )\r
-    pick lock-reentrant? [\r
-        pick lock-owner self eq? [\r
+    pick reentrant?>> [\r
+        pick owner>> self eq? [\r
             2nip call\r
         ] [\r
             (with-lock)\r
@@ -56,44 +56,43 @@ TUPLE: rw-lock readers writers reader# writer ;
 <PRIVATE\r
 \r
 : add-reader ( lock -- )\r
-    dup rw-lock-reader# 1+ swap set-rw-lock-reader# ;\r
+    [ 1+ ] change-reader# drop ;\r
 \r
 : acquire-read-lock ( lock timeout -- )\r
-    over rw-lock-writer\r
-    [ 2dup >r rw-lock-readers r> "read lock" wait ] when drop\r
+    over writer>>\r
+    [ 2dup >r readers>> r> "read lock" wait ] when drop\r
     add-reader ;\r
 \r
 : notify-writer ( lock -- )\r
-    rw-lock-writers notify-1 ;\r
+    writers>> notify-1 ;\r
 \r
 : remove-reader ( lock -- )\r
-    dup rw-lock-reader# 1- swap set-rw-lock-reader# ;\r
+    [ 1- ] change-reader# drop ;\r
 \r
 : release-read-lock ( lock -- )\r
     dup remove-reader\r
-    dup rw-lock-reader# zero? [ notify-writer ] [ drop ] if ;\r
+    dup reader#>> zero? [ notify-writer ] [ drop ] if ;\r
 \r
 : acquire-write-lock ( lock timeout -- )\r
-    over rw-lock-writer pick rw-lock-reader# 0 > or\r
-    [ 2dup >r rw-lock-writers r> "write lock" wait ] when drop\r
-    self swap set-rw-lock-writer ;\r
+    over writer>> pick reader#>> 0 > or\r
+    [ 2dup >r writers>> r> "write lock" wait ] when drop\r
+    self >>writer drop ;\r
 \r
 : release-write-lock ( lock -- )\r
-    f over set-rw-lock-writer\r
-    dup rw-lock-readers deque-empty?\r
-    [ notify-writer ] [ rw-lock-readers notify-all ] if ;\r
+    f >>writer\r
+    dup readers>> deque-empty?\r
+    [ notify-writer ] [ readers>> notify-all ] if ;\r
 \r
 : reentrant-read-lock-ok? ( lock -- ? )\r
     #! If we already have a write lock, then we can grab a read\r
     #! lock too.\r
-    rw-lock-writer self eq? ;\r
+    writer>> self eq? ;\r
 \r
 : reentrant-write-lock-ok? ( lock -- ? )\r
     #! The only case where we have a writer and > 1 reader is\r
     #! write -> read re-entrancy, and in this case we prohibit\r
     #! a further write -> read -> write re-entrancy.\r
-    dup rw-lock-writer self eq?\r
-    swap rw-lock-reader# zero? and ;\r
+    { [ writer>> self eq? ] [ reader#>> zero? ] } 1&& ;\r
 \r
 PRIVATE>\r
 \r