Update of /project/rjain-utils/cvsroot/formulate/src In directory cl-net:/tmp/cvs-serv28087/src
Modified Files: formulate.lisp metaobjects.lisp package.lisp variables.lisp Log Message: add dynamic-formulators: formua-formulators which allow changing of the formula at run time
unify the procedure for accessing the formuator of a variable or slot
--- /project/rjain-utils/cvsroot/formulate/src/formulate.lisp 2009/11/11 08:52:10 1.4 +++ /project/rjain-utils/cvsroot/formulate/src/formulate.lisp 2009/11/19 00:44:14 1.5 @@ -7,6 +7,8 @@ ;;; *** GENERAL DEFINITIONS *** ;;;
+(defvar *get-formulator* nil) + (defvar *formulating* '() "The FORMULATOR, if any, that is being evaluated.")
@@ -116,3 +118,15 @@ (defmethod formulator-value-changed ((sink lazy-formula-formulator-sink) source new-value old-value) (formulator-invalidate sink)) + +;;; +;;; DYNAMIC-FORMULATOR +;;; + +(defclass dynamic-formulator (lazy-formula-formulator-sink) + ()) + +(defmethod (setf formulator-value) (new-value (formulator dynamic-formulator)) + (setf (formulator-formula formulator) new-value + (formulator-formula-function formulator) (compile nil `(lambda () ,new-value))) + (formulator-invalidate formulator)) --- /project/rjain-utils/cvsroot/formulate/src/metaobjects.lisp 2009/11/04 21:41:35 1.2 +++ /project/rjain-utils/cvsroot/formulate/src/metaobjects.lisp 2009/11/19 00:44:14 1.3 @@ -57,17 +57,15 @@
(defvar *me*)
-(defvar *get-slot-formulator* nil) - (defmethod slot-value-using-class :around (class object (slotd formulated-effective-slot-definition)) - (if *get-slot-formulator* + (if *get-formulator* (call-next-method) (let ((*me* object)) (formulator-value (call-next-method) 'unbound-slot (slot-definition-name slotd)))))
(defmethod slot-formulator-using-class (class object (slotd formulated-effective-slot-definition)) - (let ((*get-slot-formulator* t)) + (let ((*get-formulator* t)) (slot-value-using-class class object slotd)))
(defmethod (setf slot-value-using-class) :around @@ -80,3 +78,7 @@ (declaim (inline my)) (defun my (slot) (slot-value *me* slot)) + +(defun slot-formulator (object slot-name) + (let ((*get-formulator* t)) + (slot-value object slot-name))) \ No newline at end of file --- /project/rjain-utils/cvsroot/formulate/src/package.lisp 2009/11/11 08:53:07 1.3 +++ /project/rjain-utils/cvsroot/formulate/src/package.lisp 2009/11/19 00:44:14 1.4 @@ -29,5 +29,6 @@ #:formulated-slot-definition #:formulated-direct-slot-definition #:formulated-effective-slot-definition + #:slot-formulator #:slot-formulator-using-class)) (:shadowing-import-from :formulate . #1#)) --- /project/rjain-utils/cvsroot/formulate/src/variables.lisp 2009/11/11 08:54:08 1.3 +++ /project/rjain-utils/cvsroot/formulate/src/variables.lisp 2009/11/19 00:44:14 1.4 @@ -12,7 +12,7 @@ (setf (symbol-value ',name) (make-instance ',(or formulator-class (if formula-p - 'lazy-formula-formulator-sink + 'dynamic-formulator 'simple-formulator-source)) 'formula ',formula 'formula-function (lambda () (declare ,@declare) ,formula) @@ -20,7 +20,9 @@ ',name))
(defun formulate-variable (name) - (formulator-value (symbol-value name) 'unbound-variable name)) + (if *get-formulator* + (symbol-value name) + (formulator-value (symbol-value name) 'unbound-variable name)))
(defun (setf formulate-variable) (new-value name) (setf (formulator-value (symbol-value name)) new-value))