;;; Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
(defpackage #:dep
- (:use #:common-lisp #:queue #:weak)
- (:export #:dep #:depp #:make-dep #:dep-goodp #:dep-name
- #:with-deps-frozen
- #:install-dep-syntax
- #:dep-value #:dep-make-bad #:dep-bad #:dep-try
- #:dep-add-listener))
+ (:use #:common-lisp #:queue #:weak))
(in-package #:dep)
;;;--------------------------------------------------------------------------
;;;--------------------------------------------------------------------------
;;; Data structures.
+(export '(dep depp dep-name))
(defstruct (dep (:predicate depp)
(:constructor %make-dep))
"There are two kinds of `dep', though we use the same object type for both.
value of a bad dep results in a throw of `bad-dep'. Badness propagates
automatically during recomputation phases."
(%value .bad. :type t)
- (name nil :type t)
- (value-function nil :type (or function null))
- (value-predicate #'eql :type function)
+ (name nil :type t :read-only t)
+ (value-function nil :type (or function null) :read-only t)
+ (value-predicate #'eql :type function :read-only t)
(%flags 0 :type (unsigned-byte 8))
(generation *generation* :type list)
(listeners nil :type list)
(progn (setf (dep-flags dep) flags) nil))))))
(defun %dep-value (dep)
- "Do the difficult work of retrieving the current value of a DEP."
+ "Do the difficult work of retrieving the current value of a DEP.
+
+ This is the unhappy path of `dep-value'."
+ (force-dep-value dep)
(when *evaluating-dep*
(pushnew (dep-weak-pointer *evaluating-dep*) (dep-dependents dep))
- (pushnew dep (dep-dependencies *evaluating-dep*)))
- (force-dep-value dep))
+ (pushnew dep (dep-dependencies *evaluating-dep*))))
+(export 'dep-value)
(declaim (inline dep-value))
(defun dep-value (dep)
"Retrieve the current value from DEP."
(throw 'dep-bad .bad.)
value)))
+(export 'dep-goodp)
(defun dep-goodp (dep)
"Answer whether DEP is good."
(when (eq *state* :recomputing)
(force-dep-value dep))
(not (eq (dep-%value dep) .bad.)))
+(export 'dep-try)
(defmacro dep-try (expr &body body)
"Evaluate EXPR. If it throws DEP-BAD then evaluate BODY instead."
(let ((block-name (gensym "TRY")))
(return-from ,block-name ,expr))
,@body)))
+(export 'dep-bad)
(defun dep-bad ()
"Call from a value-function: indicates that the dep should marked as bad."
(throw 'dep-bad nil))
(return))
(funcall (dequeue *delayed-operations*))))))))
+(export 'with-deps-frozen)
(defmacro with-deps-frozen ((&key delay) &body body)
"Evaluate BODY in the :FROZEN state.
(propagate-to-dependents dep)))
value)
+(export 'dep-make-bad)
(defun dep-make-bad (dep)
"Mark DEP as being bad."
(setf (dep-value dep) .bad.))
+(export 'dep-add-listener)
(defun dep-add-listener (dep func)
"Add a listener function FUNC to the DEP. The FUNC is called each time the
DEP's value (or good/bad state) changes. It is called with no arguments,
and its return value is ignored."
(push func (dep-listeners dep)))
+(export 'make-dep)
(defun make-dep (&rest args)
"Create a new DEP object. There are two basic argument forms:
(enqueue dep *pending-deps*)))
dep))))
+(export 'install-dep-syntax)
(defun install-dep-syntax (&optional (readtable *readtable*))
"Installs into the given READTABLE some syntactic shortcuts: