summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorDavid Thompson <dthompson2@worcester.edu>2013-12-15 19:31:52 -0500
committerDavid Thompson <dthompson2@worcester.edu>2013-12-15 19:31:52 -0500
commitb95fc6aa722d30fffcf85f11419d275227181c4a (patch)
tree1fb438a6d7d401fb22d19ae50aed989636054700
parent55881c47deebbe65f0507113a8c2c843064846c0 (diff)
Rewrite signals module.
* 2d/signals.scm: Rewrite module.
-rw-r--r--2d/signals.scm327
1 files changed, 134 insertions, 193 deletions
diff --git a/2d/signals.scm b/2d/signals.scm
index 9a0c3c5..eb9f51a 100644
--- a/2d/signals.scm
+++ b/2d/signals.scm
@@ -25,33 +25,29 @@
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-9)
#:use-module (srfi srfi-26)
- #:use-module (2d coroutine)
#:export (<signal>
signal?
+ root-signal?
make-signal
+ make-root-signal
signal-ref
signal-ref-maybe
- signal-transformer
- signal-filter
- signal-connectors
+ signal-receiver
+ signal-connections
signal-connect!
signal-disconnect!
signal-clear!
signal-set!
- signal-constant
- signal-lift
- signal-lift2
- signal-lift3
- signal-lift4
- signal-liftn
signal-merge
signal-combine
+ signal-do
+ signal-map
+ signal-fold
+ signal-filter
+ signal-reject
signal-fold
- signal-count
- signal-if
- signal-when
- signal-unless
- signal-do))
+ signal-constant
+ signal-count))
;;;
;;; Signals
@@ -63,210 +59,155 @@
;; programming. State mutation is hidden away and a functional,
;; declarative interface is exposed.
(define-record-type <signal>
- (%make-signal value transformer filter connectors)
+ (%make-signal value receiver connections)
signal?
(value signal-ref %signal-set!)
- (transformer signal-transformer)
- (filter signal-filter)
- (connectors signal-connectors %set-signal-connectors!))
-
-(define (identity-transform value old from)
- "Return VALUE unchanged."
- value)
+ (receiver signal-receiver)
+ (connections signal-connections %set-signal-connections!))
+
+(define (make-signal init receiver . connections)
+ "Create a new signal with initial value INIT, a procedure RECEIVER
+to transform incoming signal values and zero or more signals to
+connect to."
+ (let ((signal (%make-signal init receiver '())))
+ (for-each (cut signal-connect! <> signal) connections)
+ signal))
-(define (keep-all value old from)
- "Keep all values."
- #t)
+(define (make-root-signal init)
+ "Create a new root level signal with initial value INIT."
+ (%make-signal init #f '()))
-(define* (make-signal #:optional init #:key
- (transformer identity-transform)
- (filter keep-all)
- (connectors '()))
- "Create a new signal with initial value INIT that uses the given
-TRANSFORMER procedure to process incoming values from another
-signal. Additionally, the signal will be connected to all of the
-signals in the list CONNECTORS."
- (let ((signal (%make-signal init transformer filter '())))
- (for-each (cut signal-connect! <> signal) connectors)
- signal))
+(define (root-signal? signal)
+ "Returns true if a signal has no receiver procedure or false
+otherwise."
+ (not (signal-receiver signal)))
(define (signal-ref-maybe object)
- "Dereferences OBJECT if it is a signal and returns OBJECT
-otherwise."
+ "Retrieves the signal value from OBJECT if it is a signal and or
+simply returns OBJECT otherwise."
(if (signal? object)
(signal-ref object)
object))
-(define (%signal-transform signal value from)
- "Call the transform procedure for SIGNAL with VALUE."
- ((signal-transformer signal) value (signal-ref signal) from))
-
-(define (signal-connect! signal listener)
- "Attach LISTENER to SIGNAL. When the value of SIGNAL changes, the
-value will be propagated to LISTENER."
- (%set-signal-connectors!
- signal
- (cons listener (signal-connectors signal)))
- (signal-receive! listener (signal-ref signal) signal))
-
-(define (signal-disconnect! signal listener)
- "Detach LISTENER from SIGNAL."
- (%set-signal-connectors!
- signal
- (delete listener (signal-connectors signal) eq?)))
+(define (signal-connect! signal-in signal-out)
+ "Attach SIGNAL-OUT to SIGNAL-IN. When the value of SIGNAL-IN changes, the
+value will be propagated to SIGNAL-OUT."
+ (if (root-signal? signal-out)
+ (error 'root-signal-error
+ "Cannot connect to a root signal"
+ signal-out)
+ (%set-signal-connections!
+ signal-in
+ (cons signal-out (signal-connections signal-in)))))
+
+(define (signal-disconnect! signal-in signal-out)
+ "Detach SIGNAL-OUT from SIGNAL-IN."
+ (%set-signal-connections!
+ signal-in
+ (delete signal-out (signal-connections signal-in) eq?)))
(define (signal-clear! signal)
- "Detach all connectors from SIGNAL."
- (%set-signal-connectors! signal '()))
+ "Disconnect all connections from SIGNAL."
+ (%set-signal-connections! signal '()))
-(define* (signal-set! signal value #:optional (from #f))
- "Set VALUE for SIGNAL from the connected signal FROM and
-propagate VALUE to all connected signals. "
- (let ((value (%signal-transform signal value from)))
- (%signal-set! signal value)
- (for-each (cut signal-receive! <> value signal)
- (signal-connectors signal))))
+(define (signal-receive to from)
+ "Evaluate the receiver procedure for the signal TO with the signal
+FROM."
+ ((signal-receiver to) to from))
-(define (signal-keep? signal value from)
- "Call the filter procedure for SIGNAL with VALUE."
- ((signal-filter signal) value (signal-ref signal) from))
+(define (signal-propagate signal)
+ "Notify all connected signals about the current value of SIGNAL."
+ (for-each (cut signal-receive <> signal)
+ (signal-connections signal)))
-(codefine (signal-receive! signal value from)
- "Receive VALUE for SIGNAL from the connected signal FROM. VALUE
-will be set if it passes through the filter."
- (when (signal-keep? signal value from)
- (signal-set! signal value from)))
+(define (signal-set! signal value)
+ "Change the current value of SIGNAL to VALUE and propagate SIGNAL to
+all connected signals."
+ (%signal-set! signal value)
+ (signal-propagate signal))
;;;
-;;; Primitive signals
+;;; Higher Order Signals
;;;
-;; TODO: Write a macro for generating lifts
-(define (signal-lift transformer signal)
- "Create a new signal that lifts the procedure TRANSFORMER of arity 1
-onto SIGNAL."
- (make-signal
- #:transformer (lambda (value prev from)
- (transformer value))
- #:connectors (list signal)))
-
-(define (signal-lift2 transformer signal1 signal2)
- "Create a new signal that lifts the procedure TRANSFORMER of arity 2
-onto SIGNAL1 and SIGNAL2."
- (make-signal
- #:transformer (lambda (value prev from)
- (transformer (signal-ref signal1)
- (signal-ref signal2)))
- #:connectors (list signal1 signal2)))
-
-(define (signal-lift3 transformer signal1 signal2 signal3)
- "Create a new signal that lifts the procedure TRANSFORMER of arity 3
-onto SIGNAL1, SIGNAL2, and SIGNAL3."
- (make-signal
- #:transformer (lambda (value prev from)
- (transformer (signal-ref signal1)
- (signal-ref signal2)
- (signal-ref signal3)))
- #:connectors (list signal1 signal2 signal3)))
-
-(define (signal-lift4 transformer signal1 signal2 signal3 signal4)
- "Create a new signal that lifts the procedure TRANSFORMER of arity 4
-onto SIGNAL1, SIGNAL2, SIGNAL3, and SIGNAL4."
- (make-signal
- #:transformer (lambda (value prev from)
- (transformer (signal-ref signal1)
- (signal-ref signal2)
- (signal-ref signal3)
- (signal-ref signal4)))
- #:connectors (list signal1 signal2 signal3 signal4)))
-
-(define (signal-liftn transformer . signals)
- "Create a new signal that lifts the procedure TRANSFORMER of arity n
-onto SIGNALS where n is the size of SIGNALS."
- (make-signal
- #:transformer (lambda (value prev from)
- (apply transformer (map signal-ref signals)))
- #:connectors signals))
-
(define (signal-merge . signals)
- "Create a new signal that merges every signal in the list SIGNALS
-into one. The value of the new signal is the value of the most
-recently changed signal in the list."
- (make-signal #:connectors signals))
+ "Create a new signal whose value is the that of the most recently
+changed signal in SIGNALs. The initial value is that of the first
+signal in SIGNALS."
+ (apply make-signal
+ (signal-ref (car signals))
+ (lambda (merger from)
+ (signal-set! merger (signal-ref from)))
+ signals))
(define (signal-combine . signals)
- "Create a new signal that combines the values of SIGNALS into a
-list."
- (make-signal
- #:transformer (lambda (value prev from)
- (map signal-ref signals))
- #:connectors signals))
+ "Create a new signal whose value is a list of the values stored in
+the list SIGNALS."
+ (define (update)
+ (map signal-ref signals))
-(define (signal-fold proc init signal)
- "Create a new signal that accumulates the current and previous
-values of SIGNAL using PROC."
- (make-signal
- init
- #:transformer (lambda (value prev from)
- (proc value prev))
- #:connectors (list signal)))
+ (make-signal (update)
+ (lambda (combiner from)
+ (signal-set! combiner (update)))))
-(define (signal-count signal)
- "Create a new signal that increments a counter every time the value
-of SIGNAL changes."
- ;; Initial value is -1 to compensate for the inital signal update
- ;; when connecting.
- (signal-fold (lambda (new old) (1+ old)) -1 signal))
+(define (signal-do proc signal)
+ "Create a new signal that applies PROC when a new values is received
+from SIGNAL. The value of the new signal will always be the value of
+SIGNAL. This signal is a convenient way to sneak a procedure that has
+a side-effect into a signal chain."
+ (make-signal (signal-ref signal)
+ (lambda (do-signal from)
+ (let ((value (signal-ref signal)))
+ (proc value)
+ value))))
-(define (signal-constant constant signal)
- "Create a new signal that emits the value CONSTANT whenever a new
-value is received from SIGNAL."
- (signal-lift (lambda (value) constant) signal))
+(define (signal-map proc signal . signals)
+ "Create a new signal that applies PROC to the values stored in one
+or more SIGNALS."
+ (define (update)
+ (apply proc (map signal-ref (cons signal signals))))
-(define (signal-if predicate consequent alternate)
- "Create a new signal that emits the value of the signal CONSEQUENT
-when the value of the signal PREDICATE is true and the value of the
-signal ALTERNATE otherwise."
- (make-signal
- #:transformer (lambda (value prev from)
- (if (signal-ref predicate)
- (signal-ref consequent)
- (signal-ref alternate)))
- #:connectors (list predicate
- consequent
- alternate)))
+ (make-signal (update)
+ (lambda (map-signal from)
+ (signal-set! map-signal (update)))
+ signal))
-(define (signal-when predicate init consequent)
- "Create a new signal that keeps the value from CONSEQUENT only when
-PREDICATE is true. INIT specifies the value that is set if PREDICATE
-is never true."
- (make-signal
- init
- #:filter (lambda (value prev from)
- (signal-ref predicate))
- #:transformer (lambda (value prev from)
- (signal-ref consequent))
- #:connectors (list predicate consequent)))
+(define (signal-fold proc init signal)
+ "Create a new signal that applies PROC to the values stored in
+SIGNAL. PROC is applied with the current value of SIGNAL and the
+previously computed value, or INIT for the first call."
+ (make-signal init
+ (let ((previous init))
+ (lambda (fold-signal from)
+ (let ((value (proc previous (signal-ref from))))
+ (set! previous value)
+ (signal-set! fold-signal value))))
+ signal))
+
+(define (signal-filter predicate default signal)
+ "Create a new signal that keeps an incoming value from SIGNAL when
+it satifies the procedure PREDICATE. The value of the signal is
+DEFAULT when the predicate is never satisfied."
+ (make-signal (if (predicate (signal-ref signal))
+ (signal-ref signal)
+ default)
+ (lambda (filter from)
+ (when (predicate (signal-ref from))
+ (signal-set! filter (signal-ref from))))
+ signal))
+
+(define (signal-reject predicate default signal)
+ "Create a new signal that does not keep an incoming value from
+SIGNAL when it satisfies the procedure PREDICATE. The value of the
+signal is DEFAULT when the predicate is never satisfied."
+ (signal-filter (lambda (x) (not (predicate x))) default signal))
-(define (signal-unless predicate init consequent)
- "Create a new signal that drops the value from CONSEQUENT only when
-PREDICATE is true. INIT specifies the value that is set if PREDICATE
-is never true."
- (make-signal
- init
- #:filter (lambda (value prev from)
- (not (signal-ref predicate)))
- #:transformer (lambda (value prev from)
- (signal-ref consequent))
- #:connectors (list predicate consequent)))
+(define (signal-constant constant signal)
+ "Create a new signal whose value is always CONSTANT regardless of
+what the value received from SIGNAL."
+ (signal-map (lambda (value) constant) signal))
-(define (signal-do proc signal)
- "Create a new signal that applies PROC with incoming values from
-SIGNAL. The value of the new signal will always be the value of
-SIGNAL. This signal is a convenient way to apply a side-effect to a
-signal value."
- (make-signal
- #:transformer (lambda (value prev from)
- (proc value)
- value)
- #:connectors (list signal)))
+(define (signal-count signal)
+ "Create a new signal that increments a counter every time a new
+value from SIGNAL is received."
+ (signal-fold + 0 (signal-constant 1 signal)))