Add a restart-alarm word that doesn't spawn a new thread

diff --git a/basis/alarms/alarms-docs.factor b/basis/alarms/alarms-docs.factor
index d30ddb423b464897d145d41b14b15832ce805a07..3b70b43a2892782e994e731d564122a3d791044b 100644 (file)
--- a/basis/alarms/alarms-docs.factor
+++ b/basis/alarms/alarms-docs.factor
@@ -8,6 +8,10 @@ HELP: start-alarm
 { $values { "alarm" alarm } }\r
 { $description "Starts an alarm." } ;\r
 \r
+HELP: restart-alarm\r
+{ $values { "alarm" alarm } }\r
+{ $description "Starts or restarts an alarm. Restarting an alarm causes the a sleep of initial delay nanoseconds before looping. An alarm's parameters may be modified and restarted with this word." } ;\r
+\r
 HELP: stop-alarm\r
 { $values { "alarm" alarm } }\r
 { $description "Prevents an alarm from calling its quotation again. Has no effect on alarms that are not currently running." } ;\r
@@ -56,7 +60,7 @@ ARTICLE: "alarms" "Alarms"
 "Create an alarm before starting it:"\r
 { $subsections <alarm> }\r
 "Starting an alarm:"\r
-{ $subsections start-alarm }\r
+{ $subsections start-alarm restart-alarm }\r
 "Stopping an alarm:"\r
 { $subsections stop-alarm }\r
 \r

diff --git a/basis/alarms/alarms-tests.factor b/basis/alarms/alarms-tests.factor
index ffba05bccc4d55ccf8e8a9b46f99315e90ea69b2..ed1ab632aef62d152a320161b364b8df99f776f0 100644 (file)
--- a/basis/alarms/alarms-tests.factor
+++ b/basis/alarms/alarms-tests.factor
@@ -44,3 +44,24 @@ IN: alarms.tests
     2 seconds sleep stop-alarm\r
     1/2 seconds sleep\r
 ] unit-test\r
+\r
+[ { 0 } ] [\r
+    { 0 }\r
+    dup '[ 1 _ set-first ] 300 milliseconds later\r
+    150 milliseconds sleep\r
+    [ restart-alarm ] [ 200 milliseconds sleep stop-alarm ] bi\r
+] unit-test\r
+\r
+[ { 1 } ] [\r
+    { 0 }\r
+    dup '[ 0 _ [ 1 + ] change-nth ] 200 milliseconds later\r
+    100 milliseconds sleep restart-alarm 300 milliseconds sleep\r
+] unit-test\r
+\r
+[ { 4 } ] [\r
+    { 0 }\r
+    dup '[ 0 _ [ 1 + ] change-nth ] 300 milliseconds 300 milliseconds\r
+    <alarm> dup start-alarm\r
+    700 milliseconds sleep dup restart-alarm\r
+    700 milliseconds sleep stop-alarm 500 milliseconds sleep\r
+] unit-test\r

diff --git a/basis/alarms/alarms.factor b/basis/alarms/alarms.factor
index a82f367a13212953e7e5e78c096052e3348e9f5d..866a5573bf999c78323353d3a3ffb6de32e684e6 100644 (file)
--- a/basis/alarms/alarms.factor
+++ b/basis/alarms/alarms.factor
@@ -12,6 +12,7 @@ TUPLE: alarm
     interval-nanos
     iteration-start-nanos
     quotation-running?
+    restart?
     thread ;
 
 <PRIVATE
@@ -33,7 +34,7 @@ M: duration >nanoseconds duration>nanoseconds >integer ;
     >>iteration-start-nanos ;
 
 : stop-alarm? ( alarm -- ? )
-    thread>> self eq? not ;
+    { [ thread>> self eq? not ] [ restart?>> ] } 1|| ;
 
 DEFER: call-alarm-loop
 
@@ -60,6 +61,15 @@ DEFER: call-alarm-loop
         maybe-loop-alarm
     ] if ;
 
+: sleep-delay ( alarm -- )
+    nano-count >>start-nanos
+    delay-nanos>> [ sleep ] when* ;
+
+: alarm-loop ( alarm -- )
+    [ sleep-delay ]
+    [ nano-count >>iteration-start-nanos call-alarm-loop ]
+    [ dup restart?>> [ f >>restart? alarm-loop ] [ drop ] if ] tri ;
+
 PRIVATE>
 
 : <alarm> ( quot delay-duration/f interval-duration/f -- alarm )
@@ -70,11 +80,7 @@ PRIVATE>
 
 : start-alarm ( alarm -- )
     [
-        '[
-            _ nano-count >>start-nanos
-            [ delay-nanos>> [ sleep ] when* ]
-            [ nano-count >>iteration-start-nanos call-alarm-loop ] bi
-        ] "Alarm execution" spawn
+        '[ _ alarm-loop ] "Alarm execution" spawn
     ] keep thread<< ;
 
 : stop-alarm ( alarm -- )
@@ -84,6 +90,9 @@ PRIVATE>
         [ [ interrupt ] when* f ] change-thread drop
     ] if ;
 
+: restart-alarm ( alarm -- )
+    t >>restart? [ stop-alarm ] [ start-alarm ] bi ;
+
 <PRIVATE
 
 : (start-alarm) ( quot start-duration interval-duration -- alarm )