blahwip-signal-improvements

1 files changed, 32 insertions, 14 deletions

diff --git a/sly/signal.scm b/sly/signal.scm
index 3f5972f..9dafff6 100644
--- a/sly/signal.scm
+++ b/sly/signal.scm
@@ -31,6 +31,7 @@
   #:export (signal?
             make-signal
             define-signal
+            signal unsignal
             signal-let signal-let*
             hook->signal
             add-signal-hook!
@@ -138,9 +139,20 @@ SIGNAL."
 SIGNAL-BOX-IN changes, the value will be propagated to SIGNAL-OUT."
   (hashq-set! (signal-outputs (signal-unbox signal-box-in)) signal-out #f))
 
+(define signal-graph-access? (make-parameter #t))
+
+(define-syntax-rule (without-signal-graph-access body ...)
+  "Evaluate BODY but throw an error if it attempts to apply 'signal-ref'
+or 'signal-set!'.  Protecting the signal graph in this way is intended
+to catch common newbie mistakes where impurities are introduced in
+procedures that are meant to be pure."
+  (parameterize ((signal-graph-access? #f)) body ...))
+
 (define (signal-ref signal)
   "Return the value stored within SIGNAL."
-  (%signal-ref (signal-unbox signal)))
+  (if (signal-graph-access?)
+      (%signal-ref (signal-unbox signal))
+      (error "Use of signal-ref is not allowed when computing the value of a signal")))
 
 (define (signal-ref-maybe object)
   "Return the value stored within OBJECT if OBJECT is a signal.
@@ -168,6 +180,8 @@ all output signals."
   "Change the contents of SIGNAL to VALUE.  This procedure should
 almost never be used, except to bootstrap a root node of a signal
 graph."
+  (unless (signal-graph-access?)
+    (error "Use of signal-set! is not allowed when computing the value of a signal"))
   (%signal-set! (signal-unbox signal) value))
 
 (define (splice-signals! to from)
@@ -186,6 +200,17 @@ already a signal."
       value
       (make-signal value)))
 
+(define-syntax signal
+  (syntax-rules (unsignal)
+    ((_ (unsignal arg ...))
+     (begin arg ...))
+    ((_ (proc arg ...))
+     (if (signal? proc)
+         (signal-call proc (signal arg) ...)
+         (signal-map proc (signal arg) ...)))
+    ((_ value)
+     (make-signal-maybe value))))
+
 (define-syntax define-signal
   (lambda (x)
     "Create a top-level signal variable.  If the named variable
@@ -193,26 +218,16 @@ already exists and has a signal value then its outputs will be spliced
 into the new signal.  If the given value is not a signal then it will
 be coerced into one."
     (syntax-case x ()
-      ((_ name (signal ...))
-       (defined? (syntax->datum #'name))
-       #'(let ((s (make-signal-maybe (signal ...))))
-           (if (signal? name)
-               (begin
-                 (splice-signals! name s)
-                 (signal-propagate! (signal-unbox name)))
-               (set! name s))))
       ((_ name value)
        (defined? (syntax->datum #'name))
-       #'(let ((s (make-signal-maybe value)))
+       #'(let ((s (signal value)))
            (if (signal? name)
                (begin
                  (splice-signals! name s)
                  (signal-propagate! (signal-unbox name)))
                (set! name s))))
-      ((_ name (signal ...))
-       #'(define name (make-signal-maybe (signal ...))))
       ((_ name value)
-       #'(define name (make-signal-maybe value))))))
+       #'(define name (signal value))))))
 
 ;; emacs: (put 'signal-let 'scheme-indent-function 1)
 
@@ -268,7 +283,10 @@ SIGNALS."
 or more SIGNALs."
   (let ((inputs (cons signal rest)))
     (define (current-value)
-      (apply proc (map signal-ref inputs)))
+      (let ((args (map signal-ref inputs)))
+        (without-signal-graph-access
+         (apply proc args))))
+
     (make-boxed-signal (current-value)
                        (lambda (self value)
                          (%signal-set! self (current-value)))