origina by Stuart Sierra. []s in doseq are modified.

cells.clj

;;; cells.clj -- simple data-flow extension for Clojure

;; by Stuart Sierra, http://stuartsierra.com/
;; September 20, 2008

;; Based on Ken Tilton's Cells package for Common Lisp,
;; http://common-lisp.net/project/cells/

;; Copyright (c) 2008 Stuart Sierra. All rights reserved.  The use and
;; distribution terms for this software are covered by the Common
;; Public License 1.0 (http://www.opensource.org/licenses/cpl1.0.php)
;; which can be found in the file CPL.TXT at the root of this
;; distribution.  By using this software in any fashion, you are
;; agreeing to be bound by the terms of this license.  You must not
;; remove this notice, or any other, from this software.



;; A "cell" is a magical variable whose value is defined by an
;; expression, which may include references to other cells.  Whenever
;; a cell's value changes, all the cells that depend on it are
;; automatically updated.  Think of them like cells in a spreadsheet,
;; defined by formulas.  See the comment at the end of this file for
;; examples.



(ns cells
    (:use clojure.set))

(defmacro dependencies
  "Returns a set of symbols found within (cv ...) forms in expr.  You
  never need to call this macro."
  [expr]
  (if (sequential? expr)
    `(set (list ~@(map second
		       (filter #(and (list? %) (= (first %) 'cv))
			       (tree-seq sequential? seq expr)))))
    #{}))

(defn cv
  "Short for cell-value.  Returns the value of a cell."
  [cell]
  (:value (deref cell)))

(defn update-cell
  "Called automatically to update the value of a cell and its
  dependents.  You never need to call this function."
  [cell]
  (let [old-value (cv cell)
	new-value ((:fn @cell))]
    (when (not= new-value old-value)
      (dosync (alter cell assoc :value new-value))
      (doseq [t (:triggers @cell)] 
	(t old-value new-value))
      (doseq [d (:children @cell)] 
	(update-cell d)))
    cell))

(defn add-trigger
  "Adds a trigger function that will be called whenver the cell's
  value changes.  f receives two arguments, the old and new values of
  the cell."
  [cell f]
  (dosync (commute cell assoc :triggers
		   (conj (:triggers @cell) f))))

(defmacro trace-cell
  "Adds a trigger to cell that prints a message whenever its value
  changes."
  [cell]
  `(add-trigger ~cell
		(fn [old# new#]
		  (println '~cell "changed from" old# "to" new#))))

(defn clear-triggers
  "Removes all triggers from cell."
  [cell]
  (dosync (alter cell assoc :triggers #{})))

(defmacro alter-cell
  "Changes the value of cell to expr."
  [cell expr]
  `(let [f# (fn [] ~expr)
	 c# ~cell
	 depends-on# (dependencies ~expr)
	 obsolete-parents# (difference (:parents @c#) depends-on#)
	 new-parents# (difference depends-on# (:parents @c#))]
     (dosync (doseq [old-parent# obsolete-parents#] 
	       (commute old-parent# assoc :children
			(disj (:children @old-parent#) c#)))
	     (doseq [new-parent# new-parents#] 
	       (commute new-parent# assoc :children
			(conj (:children @new-parent#) c#)))
	     (alter c# assoc :parents depends-on#
		    :fn f#))
     (update-cell c#)))

(defmacro cell
  "Creates a new cell with expr as its initial value."
  [expr]
  `(alter-cell (ref {:triggers #{}
		     :parents #{}
		     :children #{}})
	       ~expr))


(comment
  (def c1 (cell 10))
  (def c2 (cell (* 5 (cv c1))))
  (cv c2)  ;=> 50

  ;; Now when we change c1, c2 gets updated:
  (trace-cell c1)
  (trace-cell c2)
  (alter-cell c1 100)
  ;; c1 changed from 10 to 100
  ;; c2 changed from 50 to 500
  (cv c2) ;=> 500

  ;; Circular dependencies are allowed, just watch out for infinite
  ;; loops:
  (def c3 (cell 5))
  (def c4 (cell (dec (cv c3))))
  (trace-cell c3)
  (trace-cell c4)
  (alter-cell c3 (if (< (cv c4) 0) 0 (cv c4)))
  ;; c3 changed from 5 to 4
  ;; c4 changed from 4 to 3
  ;; c3 changed from 4 to 3
  ;; c4 changed from 3 to 2
  ;; c3 changed from 3 to 2
  ;; c4 changed from 2 to 1
  ;; c3 changed from 2 to 1
  ;; c4 changed from 1 to 0
  ;; c3 changed from 1 to 0
  ;; c4 changed from 0 to -1
  (cv c3) ;=> 0
  (cv c4) ;=> -1
)