Delete empty unit tests files, remove 1- and 1+, reorder IN: lines in a lot of places...

[factor.git] / basis / concurrency / semaphores / semaphores.factor

diff --git a/basis/concurrency/semaphores/semaphores.factor b/basis/concurrency/semaphores/semaphores.factor
old mode 100755 (executable)
new mode 100644 (file)
index 8b88c54..dcd0ed9
--- a/basis/concurrency/semaphores/semaphores.factor
+++ b/basis/concurrency/semaphores/semaphores.factor
@@ -1,33 +1,38 @@
 ! Copyright (C) 2008 Slava Pestov.\r
 ! See http://factorcode.org/license.txt for BSD license.\r
 USING: dlists kernel threads math concurrency.conditions\r
-continuations ;\r
+continuations accessors summary locals fry ;\r
 IN: concurrency.semaphores\r
 \r
 TUPLE: semaphore count threads ;\r
 \r
+ERROR: negative-count-semaphore ;\r
+\r
+M: negative-count-semaphore summary\r
+    drop "Cannot have semaphore with negative count" ;\r
+\r
 : <semaphore> ( n -- semaphore )\r
-    dup 0 < [ "Cannot have semaphore with negative count" throw ] when\r
+    dup 0 < [ negative-count-semaphore ] when\r
     <dlist> semaphore boa ;\r
 \r
 : wait-to-acquire ( semaphore timeout -- )\r
-    >r semaphore-threads r> "semaphore" wait ;\r
+    [ threads>> ] dip "semaphore" wait ;\r
 \r
 : acquire-timeout ( semaphore timeout -- )\r
-    over semaphore-count zero?\r
+    over count>> zero?\r
     [ dupd wait-to-acquire ] [ drop ] if\r
-    dup semaphore-count 1- swap set-semaphore-count ;\r
+    [ 1 - ] change-count drop ;\r
 \r
 : acquire ( semaphore -- )\r
     f acquire-timeout ;\r
 \r
 : release ( semaphore -- )\r
-    dup semaphore-count 1+ over set-semaphore-count\r
-    semaphore-threads notify-1 ;\r
+    [ 1 + ] change-count\r
+    threads>> notify-1 ;\r
 \r
-: with-semaphore-timeout ( semaphore timeout quot -- )\r
-    pick rot acquire-timeout swap\r
-    [ release ] curry [ ] cleanup ; inline\r
+:: with-semaphore-timeout ( semaphore timeout quot -- )\r
+    semaphore timeout acquire-timeout\r
+    quot [ semaphore release ] [ ] cleanup ; inline\r
 \r
 : with-semaphore ( semaphore quot -- )\r
-    over acquire swap [ release ] curry [ ] cleanup ; inline\r
+    swap dup acquire '[ _ release ] [ ] cleanup ; inline\r