 : notify-alarm-thread ( -- )
     alarm-thread get-global interrupt ;
 
-: check-alarm
-    dup duration? over not or [ "Not a duration" throw ] unless
-    over timestamp? [ "Not a timestamp" throw ] unless
-    pick callable? [ "Not a quotation" throw ] unless ; inline
+ERROR: bad-alarm-frequency frequency ;
+: check-alarm ( frequency/f -- frequency/f )
+    dup [ duration? ] [ not ] bi or [ bad-alarm-frequency ] unless ;
 
 : <alarm> ( quot time frequency -- alarm )
     check-alarm <box> alarm boa ;
 
 : register-alarm ( alarm -- )
-    dup dup alarm-time alarms get-global heap-push*
-    swap alarm-entry >box
+    dup dup time>> alarms get-global heap-push*
+    swap entry>> >box
     notify-alarm-thread ;
 
 : alarm-expired? ( alarm now -- ? )
-    >r alarm-time r> before=? ;
+    [ time>> ] dip before=? ;
 
 : reschedule-alarm ( alarm -- )
-    dup alarm-time over alarm-interval time+
-    over set-alarm-time
-    register-alarm ;
+    dup [ swap interval>> time+ ] change-time register-alarm ;
 
 : call-alarm ( alarm -- )
-    dup alarm-entry box> drop
-    dup alarm-quot "Alarm execution" spawn drop
-    dup alarm-interval [ reschedule-alarm ] [ drop ] if ;
+    [ entry>> box> drop ]
+    [ quot>> "Alarm execution" spawn drop ]
+    [ dup interval>> [ reschedule-alarm ] [ drop ] if ] tri ;
 
 : (trigger-alarms) ( alarms now -- )
     over heap-empty? [


: cancel-alarms ( alarms -- )
    [
        heap-pop-all [ nip alarm-entry box> drop ] assoc-each
    ] when* ;

: init-alarms ( -- )

! Copyright (C) 2005, 2008 Slava Pestov, Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays calendar combinators generic init
kernel math namespaces sequences heaps boxes threads debugger
quotations assocs math.order ;
IN: alarms

TUPLE: alarm
    { quot callable initial: [ ] }
    { time timestamp }
    interval
    { entry box } ;

<PRIVATE

