 ! Copyright (C) 2005, 2008 Slava Pestov, Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: arrays calendar combinators generic init kernel math
-namespaces sequences heaps boxes threads debugger quotations
-assocs math.order ;
+USING: accessors arrays calendar combinators generic init
+kernel math namespaces sequences heaps boxes threads debugger
+quotations assocs math.order ;
 IN: alarms
 
-TUPLE: alarm quot time interval entry ;
+TUPLE: alarm
+    { quot callable initial: [ ] }
+    { time timestamp }
+    interval
+    { entry box } ;
 
 <PRIVATE
 

: 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

: <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
    notify-alarm-thread ;

: alarm-expired? ( alarm now -- ? )
    >r alarm-time r> before=? ;

: reschedule-alarm ( alarm -- )
    dup alarm-time over alarm-interval time+
    over set-alarm-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 ;

: (trigger-alarms) ( alarms now -- )
    over heap-empty? [


: next-alarm ( alarms -- timestamp/f )
    dup heap-empty?
    [ drop f ] [ heap-peek drop time>> ] if ;

: alarm-thread-loop ( -- )
    alarms get-global
