signal: Add hook API for side-effects.

* sly/signal.scm (<signal>)[hook]: New field.
(signal-hook): New selector.
(add-signal-hook, remove-signal-hook, clear-signal-hook!): New
procedures.
(%make-signal): Create hook for the signal.
(signal-propagate!): Run hook.

1 files changed, 30 insertions, 6 deletions

diff --git a/sly/signal.scm b/sly/signal.scm
index e57e880..a35f042 100644
--- a/sly/signal.scm
+++ b/sly/signal.scm
@@ -33,6 +33,9 @@
             define-signal
             signal-let signal-let*
             hook->signal
+            add-signal-hook!
+            remove-signal-hook!
+            clear-signal-hook!
             signal-ref
             signal-ref-maybe
             signal-set!
@@ -66,12 +69,15 @@
 ;; programming. State mutation is hidden away and a functional,
 ;; declarative interface is exposed.
 (define-record-type <signal>
-  (%%make-signal value proc inputs outputs)
+  (%%make-signal value proc inputs outputs hook)
   %signal?
   (value %signal-ref %%signal-set!)
   (proc signal-proc)
   (inputs signal-inputs)
-  (outputs signal-outputs))
+  (outputs signal-outputs)
+  ;; Hook for escaping the signal graph to perform side-effects like
+  ;; file I/O, playing sounds, etc.
+  (hook signal-hook))
 
 (define-record-type <signal-box>
   (make-signal-box signal)
@@ -92,7 +98,9 @@
 
 (define (%make-signal init proc inputs)
   "Create a new signal with initial value INIT."
-  (let ((signal (%%make-signal init proc inputs (make-weak-key-hash-table))))
+  (let ((signal (%%make-signal init proc inputs
+                               (make-weak-key-hash-table)
+                               (make-hook 1))))
     (for-each (cut signal-connect! signal <>) inputs)
     signal))
 
@@ -105,6 +113,20 @@
 procedure PROC, and a list of INPUTS."
   (make-signal-box (%make-signal init proc inputs)))
 
+(define (add-signal-hook! signal proc)
+  "Add PROC, a procedure that accepts a single argument, to the hook
+associated with SIGNAL.  When SIGNAL receives a new value, PROC will
+be applied with that value."
+  (add-hook! (signal-hook (signal-unbox signal)) proc))
+
+(define (remove-signal-hook! signal proc)
+  "Remove the procedure PROC from the hook associated with SIGNAL."
+  (remove-hook! (signal-hook (signal-unbox signal)) proc))
+
+(define (clear-signal-hook! signal)
+  "Remove all hooks associated with SIGNAL."
+  (reset-hook! (signal-hook (signal-unbox signal))))
+
 (define (signal-connect! signal-out signal-box-in)
   "Attach SIGNAL-OUT to SIGNAL-BOX-IN.  When the signal within
 SIGNAL-BOX-IN changes, the value will be propagated to SIGNAL-OUT."
@@ -123,9 +145,11 @@ Otherwise, return OBJECT."
 
 (define (signal-propagate! signal)
   "Notify all output signals about the current value of SIGNAL."
-  (hash-for-each (lambda (output unused)
-                   ((signal-proc output) output (%signal-ref signal)))
-                 (signal-outputs signal)))
+  (let ((value (%signal-ref signal)))
+    (run-hook (signal-hook signal) value)
+    (hash-for-each (lambda (output unused)
+                     ((signal-proc output) output value))
+                   (signal-outputs signal))))
 
 (define (%signal-set! signal value)
   "Change the current value of SIGNAL to VALUE and propagate VALUE to