X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~mdw/git/lisp/blobdiff_plain/0eed4749891adf0a7be89e786b8968ee805a8d41..77f935dafbb63f1674a3df832972fda67c10e3d6:/dep.lisp diff --git a/dep.lisp b/dep.lisp index 8a9410d..c437538 100644 --- a/dep.lisp +++ b/dep.lisp @@ -22,12 +22,7 @@ ;;; 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) ;;;-------------------------------------------------------------------------- @@ -86,6 +81,7 @@ (defvar *pending-deps* nil ;;;-------------------------------------------------------------------------- ;;; 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. @@ -99,9 +95,9 @@ (defstruct (dep (:predicate depp) 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) @@ -238,6 +234,7 @@ (defun %dep-value (dep) (pushnew dep (dep-dependencies *evaluating-dep*))) (force-dep-value dep)) +(export 'dep-value) (declaim (inline dep-value)) (defun dep-value (dep) "Retrieve the current value from DEP." @@ -248,12 +245,14 @@ (defun dep-value (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"))) @@ -262,6 +261,7 @@ (defmacro dep-try (expr &body body) (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)) @@ -308,6 +308,7 @@ (defun with-deps-frozen* (thunk &key delay) (return)) (funcall (dequeue *delayed-operations*)))))))) +(export 'with-deps-frozen) (defmacro with-deps-frozen ((&key delay) &body body) "Evaluate BODY in the :FROZEN state. @@ -346,16 +347,19 @@ (defun (setf dep-value) (value dep) (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: @@ -429,6 +433,7 @@ (defun make-dep (&rest args) (enqueue dep *pending-deps*))) dep)))) +(export 'install-dep-syntax) (defun install-dep-syntax (&optional (readtable *readtable*)) "Installs into the given READTABLE some syntactic shortcuts: