Update of /project/cells/cvsroot/triple-cells In directory clnet:/tmp/cvs-serv15290

Modified Files: api.lisp core.lisp dataflow.lisp defpackage.lisp hello-world.lisp observer.lisp triple-cells.lpr Log Message: Version 2, with integrity

--- /project/cells/cvsroot/triple-cells/api.lisp 2007/12/23 10:04:56 1.1 +++ /project/cells/cvsroot/triple-cells/api.lisp 2008/02/23 01:22:11 1.2 @@ -1,25 +1,8 @@ ;; -*- mode: Lisp; Syntax: Common-Lisp; Package: triple-cells; -*- ;;; ;;; -;;; Copyright (c) 1995,2003 by Kenneth William Tilton. +;;; Copyright (c) 2008 by Kenneth William Tilton. ;;; -;;; Permission is hereby granted, free of charge, to any person obtaining a copy -;;; of this software and associated documentation files (the "Software"), to deal -;;; in the Software without restriction, including without limitation the rights -;;; to use, copy, modify, merge, publish, distribute, sublicense, and/or sell -;;; copies of the Software, and to permit persons to whom the Software is furnished -;;; to do so, subject to the following conditions: -;;; -;;; The above copyright notice and this permission notice shall be included in -;;; all copies or substantial portions of the Software. -;;; -;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR -;;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, -;;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE -;;; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER -;;; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING -;;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS -;;; IN THE SOFTWARE.

(in-package :3c) @@ -27,10 +10,9 @@ ;;; --- API ---------------------------------------

(defun 3c-init () - (setf *3c-pulse* 0) (setf *calc-nodes* nil) (setf *3c?* (make-hash-table :test 'equal)) - (setf *3c-observers* (make-hash-table :test 'equal))) + (setf *3c-observers* (make-hash-table :test 'equalp)))

;;; --- API constructors -------------------------------

@@ -59,6 +41,7 @@ (add-triple c !ccc:type !ccc:ruled) (add-triple c !ccc:rule (mk-upi (prin1-to-string rule))) (when ephemeral + ;(trc "bingo ephemeral" rule) (add-triple c !ccc:ephemeral !ccc:t)) (when test (add-triple c !ccc:test (mk-upi test))) @@ -71,13 +54,8 @@ ;(trc "c? value tr" tr-cv) c)))

- - ;;; --- API accessors

-(defun clear-usage (cell) - (delete-triples :s cell :p !ccc:uses)) - (defun 3c (s p) (assert (and s p)) (bif (cell (stmt-cell s p)) @@ -102,21 +80,18 @@ ;(trc "tr-value" (triple-id tr-value))

(unless (equal new-value prior-value) - (3c-pulse-advance :setf-3c) - (when tr-value - (delete-triple (triple-id tr-value))) - - (let* ((new-value-upi (mk-upi new-value)) - (tr-value-new (add-triple s p new-value-upi))) - - (delete-triples :s cell :p !ccc:value) - - (let ((tr-cell-value-new (add-triple cell !ccc:value new-value-upi))) + (with-3c-integrity (:change cell) + (when tr-value + (delete-triple (triple-id tr-value))) + + (let ((new-value-upi (mk-upi new-value))) + (add-triple s p new-value-upi) + ; cell maintenance, including its own copy of value + (delete-triples :s cell :p !ccc:value) + (add-triple cell !ccc:value new-value-upi) (3c-propagate cell) (cell-observe-change cell s p new-value prior-value t) (when (3c-ephemeral? cell) - ; fix up cell... - (delete-triple tr-cell-value-new) - ; reset value itself to nil - (delete-triple tr-value-new))))))) + (add-triple !ccc:ufb-reset-ephemerals (mk-upi 42) cell))))))) +

--- /project/cells/cvsroot/triple-cells/core.lisp 2007/12/23 10:04:53 1.3 +++ /project/cells/cvsroot/triple-cells/core.lisp 2008/02/23 01:22:11 1.4 @@ -1,38 +1,23 @@ ;; -*- mode: Lisp; Syntax: Common-Lisp; Package: triple-cells; -*- ;;; +;;; Copyright (c) 2008 by Kenneth William Tilton. ;;; -;;; Copyright (c) 1995,2003 by Kenneth William Tilton. -;;; -;;; Permission is hereby granted, free of charge, to any person obtaining a copy -;;; of this software and associated documentation files (the "Software"), to deal -;;; in the Software without restriction, including without limitation the rights -;;; to use, copy, modify, merge, publish, distribute, sublicense, and/or sell -;;; copies of the Software, and to permit persons to whom the Software is furnished -;;; to do so, subject to the following conditions: -;;; -;;; The above copyright notice and this permission notice shall be included in -;;; all copies or substantial portions of the Software. -;;; -;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR -;;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, -;;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE -;;; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER -;;; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING -;;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS -;;; IN THE SOFTWARE. -

(in-package :3c)

;; --- triple-cells ---

-(defvar *3c-pulse*) (defvar *calc-nodes*)

-(defun 3c-pulse-advance (dbg) +(defun 3c-pulse-advance (&optional (dbg :anon-advance)) (declare (ignorable dbg)) - (trc "PULSE> ------------------" (1+ *3c-pulse*) dbg) - (incf *3c-pulse*)) + (trc "PULSE> ---- advancing:" dbg) + (delete-triples :s !ccc:integrity :p !ccc:pulse) + (add-triple !ccc:integrity !ccc:pulse (new-blank-node))) + +(defun 3c-pulse () + (bwhen (tr (get-triple :s !ccc:integrity :p !ccc:pulse)) + (object tr)))

;;; --- low-level 3cell accessors

@@ -41,12 +26,18 @@ (part-value (object tr))))

(defun (setf 3c-cell-value) (new-value c) + (3c-cell-make-current c) + (delete-triples :s c :p !ccc:value) (when new-value (add-triple c !ccc:value (mk-upi new-value))))

-(defun 3c-pulse (c) - (get-sp-value c !ccc:pulse)) +(defun 3c-cell-make-current (c) + (delete-triples :s c :p !ccc:pulse) + (add-triple c !ccc:pulse (3c-pulse))) + +(defun 3c-cell-pulse (c) + (object (get-sp c !ccc:pulse)))

;;; --- rule storage -------------------------------

@@ -55,7 +46,7 @@ #+dump (maphash (lambda (k v) (trc "kk" k v)) *3c?*)

-(defun (setf 3c?-rule) ( rule c-node) +(defun (setf 3c?-rule) (rule c-node) (assert (functionp rule) () "3c?-rule setf not rule: ~a ~a" (type-of rule) rule) ;;(trc "storing rule!!!! for" c-node rule) (setf (gethash c-node *3c?*) rule)) @@ -102,8 +93,6 @@ (intern (nsubstitute #- ## (up$ (string-trim "<>" s)))))

- - ;;; --- access ------------------------------------------

(defun subject-cells-node (s) @@ -121,42 +110,65 @@ (object tr)))

(defun cell-predicate (c) - (predicate (car (get-triples-list :o c)))) + (object (get-sp c !ccc:is-cell-of-predicate)))

-(defun cell-subject (c) - (subject (car (get-triples-list - :p !ccc:cells - :o (subject (car (get-triples-list :o c))))))) +(defun cell-model (c) + (object (get-sp c !ccc:is-cell-of-model))) + +(defun 3c-install-cell (s p o) + (add-triple (subject-cells-node s) p o) + (add-triple o !ccc:is-cell-of-model s) + (add-triple o !ccc:is-cell-of-predicate p))

(defun stmt-new (s p o &aux (tv o)) - (when (3c-cell? o) - (add-triple (subject-cells-node s) p o) - + (cond + ((3c-cell? o) + (3c-install-cell s p o) (cond ((3c-input? o) - (3c-pulse-advance :new-input) ;; why does creating data advance pulse? - (setf tv (3c-cell-value o))) - - ((3c-ruled? o) - (setf tv (funcall (3c?-rule o) o nil nil)) - (setf (3c-cell-value o) tv)) - - (t (break "unknown cell" o))) - - (add-triple o !ccc:pulse (mk-upi *3c-pulse*)) - (setf tv (3c-cell-value o))) - - (when tv - (add-triple s p (mk-upi tv))) - - (cell-observe-change o s p tv nil nil)) + (bwhen (tv (3c-cell-value o)) + (add-triple s p (mk-upi tv))) + (with-3c-integrity (!ccc:observe o) + (cell-observe-change o s p tv nil nil))) + ((3c-ruled? o) + (with-3c-integrity (!ccc:awaken-ruled-cell o) + (3c-awaken-ruled-cell o))) + (t (break "unknown cell" o)))) + + (t (when tv + (let ((tr (add-triple s p (mk-upi tv)))) + (trc "recording k under" p :id tr tv) + (with-3c-integrity (!ccc:observe (mk-upi tr)) + (cell-observe-change o s p tv nil nil))))))) + +(defun 3c-awaken-ruled-cell (c) + (let ((s (cell-model c)) + (p (cell-predicate c)) + (tv (funcall (3c?-rule c) c nil nil))) + ;(trc "awakening ruled" p) + (setf (3c-cell-value c) tv) + (cell-observe-change c s p tv nil nil)))

(defun 3c-make (type &key id) "Generates blank node and associates it with type and other options" (let ((node (new-blank-node))) (trc "3c-make storing type" type (type-of type)) - (add-triple node !ccc:instance-of type) ; (mk-upi type)) + (add-triple node !ccc:instance-of type) (when id (3c-register node id)) node))

+(defun 3c-register (node name) + (add-triple (mk-upi name) !ccc:id node)) + +(defun 3c-find-id (name) + (object (get-sp (mk-upi name) !ccc:id))) + +(defun clear-usage (cell) + (delete-triples :s cell :p !ccc:uses)) + +#+test +(progn + (make-tutorial-store) + (let ((x (3c-make !<plane> :id "x-plane"))) + (3c-find-id "x-plane"))) --- /project/cells/cvsroot/triple-cells/dataflow.lisp 2007/12/23 10:04:56 1.1 +++ /project/cells/cvsroot/triple-cells/dataflow.lisp 2008/02/23 01:22:11 1.2 @@ -1,44 +1,25 @@ ;; -*- mode: Lisp; Syntax: Common-Lisp; Package: triple-cells; -*- ;;; ;;; -;;; Copyright (c) 1995,2003 by Kenneth William Tilton. +;;; Copyright (c) 2008 by Kenneth William Tilton. ;;; -;;; Permission is hereby granted, free of charge, to any person obtaining a copy -;;; of this software and associated documentation files (the "Software"), to deal -;;; in the Software without restriction, including without limitation the rights -;;; to use, copy, modify, merge, publish, distribute, sublicense, and/or sell -;;; copies of the Software, and to permit persons to whom the Software is furnished -;;; to do so, subject to the following conditions: -;;; -;;; The above copyright notice and this permission notice shall be included in -;;; all copies or substantial portions of the Software. -;;; -;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR -;;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, -;;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE -;;; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER -;;; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING -;;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS -;;; IN THE SOFTWARE. -

(in-package :3c)

(defun 3c-propagate (cell) - (loop for user in (get-triples-list :p !ccc:uses :o cell) - do (trc nil "propagating !!!!!!!!!!!!" cell :to (subject user)) - (3c-ensure-current (subject user)))) + (3c-ufb-add !ccc:ufb-tell-dependents cell))

;;; --- integrity -----------------(part-value prior-value)-----------------------------

(defun 3c-ensure-current (cell &optional s p) ;; when we don't have s/p extend to work backwards from cell (unless s - (setf s (cell-subject cell) - p (cell-predicate cell))) + (setf s (cell-model cell)) + (setf p (cell-predicate cell))) ;(trc "3c-ensure-current" s p) (when (and cell (3c-ruled? cell)) - (when (> *3c-pulse* (3c-pulse cell)) - ;(trc "old" (3c-cell-value cell)) + (unless (upi= (3c-pulse) (3c-cell-pulse cell)) + ; (trc "old" (3c-cell-value cell)) + ;(trc "HEY!!! what happened to checking if necessary to rerun rule?!") (let* ((prior-value (3c-cell-value cell)) (new-value (progn (clear-usage cell) @@ -48,12 +29,17 @@ (test (or (bwhen (test (get-sp-value cell !ccc:test)) (intern test)) 'EQL))) - ;(trc "prop new" new-value) - (unless (funcall test new-value prior-value) - (let ((prior-value (3c-cell-value cell))) - (setf (3c-cell-value cell) new-value) - (delete-triples :s s :p p) - (when new-value - (add-triple s p (mk-upi new-value))) - (3c-propagate cell) - (cell-observe-change cell s p new-value prior-value t))))))) + + (if (funcall test new-value prior-value) + (3c-cell-make-current cell) + (progn + ;(trc "prop new" new-value :prior prior-value) + (let ((prior-value (3c-cell-value cell))) + (setf (3c-cell-value cell) new-value) + (delete-triples :s s :p p) + (when new-value + (add-triple s p (mk-upi new-value))) + (3c-propagate cell) + (cell-observe-change cell s p new-value prior-value t) + (when (3c-ephemeral? cell) + (add-triple !ccc:ufb-reset-ephemerals (mk-upi 42) cell))))))))) --- /project/cells/cvsroot/triple-cells/defpackage.lisp 2007/12/20 13:08:17 1.1 +++ /project/cells/cvsroot/triple-cells/defpackage.lisp 2008/02/23 01:22:11 1.2 @@ -1,6 +1,6 @@ ;; -*- mode: Lisp; Syntax: Common-Lisp; Package: cl-user; -*- ;;; -;;; Copyright (c) 1995,2003 by Kenneth William Tilton. +;;; Copyright (c) 2008 by Kenneth William Tilton. ;;; ;;; Permission is hereby granted, free of charge, to any person obtaining a copy ;;; of this software and associated documentation files (the "Software"), to deal @@ -29,5 +29,5 @@

(defpackage :triple-cells (:nicknames :3c) - (:use #:common-lisp #:utils-kt #:db.agraph #:cells)) ;; cells just fro TRC (so far) + (:use #:common-lisp #:utils-kt #:db.agraph #:cells)) ;; cells just for TRC (so far)

--- /project/cells/cvsroot/triple-cells/hello-world.lisp 2007/12/23 10:04:56 1.3 +++ /project/cells/cvsroot/triple-cells/hello-world.lisp 2008/02/23 01:22:11 1.4 @@ -1,124 +1,114 @@ ;; -*- mode: Lisp; Syntax: Common-Lisp; Package: triple-cells; -*- ;;; ;;; -;;; Copyright (c) 1995,2003 by Kenneth William Tilton. +;;; Copyright (c) 2008 by Kenneth William Tilton. ;;; -;;; Permission is hereby granted, free of charge, to any person obtaining a copy -;;; of this software and associated documentation files (the "Software"), to deal -;;; in the Software without restriction, including without limitation the rights -;;; to use, copy, modify, merge, publish, distribute, sublicense, and/or sell -;;; copies of the Software, and to permit persons to whom the Software is furnished -;;; to do so, subject to the following conditions: -;;; -;;; The above copyright notice and this permission notice shall be included in -;;; all copies or substantial portions of the Software. -;;; -;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR -;;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, -;;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE -;;; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER -;;; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING -;;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS -;;; IN THE SOFTWARE.

(in-package :3c)

- -(defun 3c-test-reopen () - (close-triple-store) - (open-triple-store "hello-world" - :directory (project-path) - :if-does-not-exist :error) - (let ((dell (3c-find-id "dell")) - (happen !hw:happen) - (location !hw:location) - (response !hw:response)) - - (trc "start" (3c dell happen)(3c dell location)(3c dell response)) - (setf (3c dell happen) "knock-knock") - (setf (3c dell happen) "arrive") - (setf (3c dell happen) "knock-knock") - )) +#+test +(3c-test-reopen)

#+test -(3c-test) +(3c-test-build)

(defun 3c-test () + (3c-test-build) + (3c-test-reopen) + ) + +(defun 3c-test-build () (test-prep "3c") - (unwind-protect - (progn - (3c-init) + ; + ; initialize new DB altogether + ; + (create-triple-store "hello-world" + :if-exists :supersede + :directory (project-path)) + (register-namespace "hw" "helloworld#" :errorp nil) + (register-namespace "ccc" "triplecells#" :errorp nil) + ; + ; initialize new DB session + ; + (3c-init) + (let ((*synchronize-automatically* t)) (enable-print-decoded t) - (create-triple-store "hello-world" - :if-exists :supersede - :directory (project-path)) - (register-namespace "hw" "helloworld#" :errorp nil) - (register-namespace "ccc" "triplecells#" :errorp nil)

- + (make-observer !hw:echo-happen (trc "happen:" new-value)) + (make-observer !hw:location (trc "We are now" new-value )) + (make-observer !hw:obs-response (trc "Speak:" new-value ))

- (let ((dell (3c-make !hw:computer :id "dell")) - (happen !hw:happen) - (location !hw:location) - (response !hw:response)) - (assert dell) - - (make-observer !hw:echo-happen (trc "happen:" new-value)) - (make-observer !hw:obs-location (trc "We are now" new-value )) - (make-observer !hw:obs-response (trc "Speak:" new-value )) - - (stmt-new dell happen #+const "test" - (3c-in nil :ephemeral t - :observer !hw:echo-happen - :test 'equal)) - - (stmt-new dell location - (3c? ;(trc "RULE-ENTRY>" *3c-pulse*) - (let ((h (3c (3c-find-id "dell") !hw:happen))) - ;(trc "rule sees happen" h) - (cond - ((string-equal h "arrive") "home") - ((string-equal h "leave") "away") - (cache? cache) - (t "away"))) - :observer !hw:obs-location - :test 'equal)) - - (stmt-new dell response - (3c? (let* ((dell (3c-find-id "dell")) - (h (3c dell !hw:happen)) - (loc (3c dell !hw:location))) - ;(trc "response rule sees happen" h :loc loc) - (cond - ((string-equal h "knock-knock") - (cond - ((string-equal loc "home") "who's there?") - (t "silence"))) - ((string-equal h "arrive") - (cond - ((string-equal loc "home") "honey, i am home!"))) - ((string-equal h "leave") + (with-3c-integrity (:change) ;; change advances pulse + (let ((dell (3c-make !hw:computer :id "dell")) + (happen !hw:happen) + (location !hw:location) + (response !hw:response)) + (declare (ignorable response location)) + (assert dell) + + (stmt-new dell happen + (3c-in nil :ephemeral t + :observer !hw:echo-happen + :test 'equal)) + + + (stmt-new dell location + (3c? (let ((h (3c (3c-find-id "dell") !hw:happen))) + ;(trc "rule sees happen" h) (cond - ((string-equal loc "away") "bye-bye!"))) - (t cache))) - :observer !hw:obs-response - :test 'equal)) - - (time - (progn - (setf (3c dell happen) "knock-knock") - (loop repeat 2 do - (setf (3c dell happen) "knock-knock")) - (setf (3c dell happen) "arrive") + ((string-equal h "arrive") "home") + ((string-equal h "leave") "away") + (cache? cache) + (t "away"))) + :observer !hw:location + :test 'equal)) + ;;#+step2 + (progn

- (setf (3c dell happen) "knock-knock") - (setf (3c dell happen) "leave"))) - - ))) - (dribble))) - + (stmt-new dell response + (3c? (let* ((dell (3c-find-id "dell")) + (h (3c dell !hw:happen)) + (loc (3c dell !hw:location))) + ;(trc "response rule sees happen" h :loc loc) + (cond + ((string-equal h "knock-knock") + (cond + ((string-equal loc "home") "who's there?") + (t "silence"))) + ((string-equal h "arrive") + (cond + ((string-equal loc "home") "honey, i am home!"))) + ((string-equal h "leave") + (cond + ((string-equal loc "away") "bye-bye!"))) + (t cache))) + :observer !hw:obs-response + :ephemeral t + :test 'equal)))))))

+(defun 3c-test-reopen () + (close-triple-store) + (open-triple-store "hello-world" + :directory (project-path) + :if-does-not-exist :error) + (when (3c-integrity-managed?) (break "1")) + (time + (let ((dell (3c-find-id "dell")) + (happen !hw:happen) + (location !hw:location) + (response !hw:response)) + + (trc "---------------- start-------------------------- " (3c dell happen)(3c dell location)(3c dell response)) + (when (3c-integrity-managed?) (break "2")) + (setf (3c dell happen) "knock-knock") + (loop repeat 2 do + (setf (3c dell happen) "knock-knock")) + (setf (3c dell happen) "arrive") + + (setf (3c dell happen) "knock-knock") + (setf (3c dell happen) "leave") + )))

--- /project/cells/cvsroot/triple-cells/observer.lisp 2007/12/23 10:04:56 1.1 +++ /project/cells/cvsroot/triple-cells/observer.lisp 2008/02/23 01:22:11 1.2 @@ -1,26 +1,8 @@ ;; -*- mode: Lisp; Syntax: Common-Lisp; Package: triple-cells; -*- ;;; ;;; -;;; Copyright (c) 1995,2003 by Kenneth William Tilton. +;;; Copyright (c) 2008 by Kenneth William Tilton. ;;; -;;; Permission is hereby granted, free of charge, to any person obtaining a copy -;;; of this software and associated documentation files (the "Software"), to deal -;;; in the Software without restriction, including without limitation the rights -;;; to use, copy, modify, merge, publish, distribute, sublicense, and/or sell -;;; copies of the Software, and to permit persons to whom the Software is furnished -;;; to do so, subject to the following conditions: -;;; -;;; The above copyright notice and this permission notice shall be included in -;;; all copies or substantial portions of the Software. -;;; -;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR -;;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, -;;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE -;;; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER -;;; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING -;;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS -;;; IN THE SOFTWARE. -

(in-package :3c)

@@ -31,18 +13,46 @@ ,form)))

(defun call-make-observer (id observer) - (trc "storing observer!!!!!!!!!!!" id !ccc:observer-id-rule (mk-upi (prin1-to-string observer))) (add-triple id !ccc:observer-id-rule (mk-upi (prin1-to-string observer))) (setf (3c-observer id) (eval observer))) ;; while we're at it

;;; --- 3cell observation --------------------------------------------------------

- (defun cell-observe-change (cell s p new-value prior-value prior-value?) - (bif (otr (get-sp cell !ccc:observer-is)) - (funcall (3c-observer (object otr)) s p new-value prior-value prior-value?) - (trc "unobserved" s p))) + (cond + (cell + (loop for observer in (get-triples-list :s cell :p !ccc:observer-is) + do (funcall (3c-observer (object observer)) s p + new-value prior-value prior-value?))) + (p (loop for observer in (get-triples-list :s p :p !ccc:observer-id-rule) + do (funcall (3c-observer-from-rule-triple observer) s p + new-value prior-value prior-value?))))) + +;;;(defun cell-observe-change (cell s p new-value prior-value prior-value?) +;;; (trc "observing" p new-value) +;;; (if (get-triple :s cell :p !ccc:observer-is) ; just need one to decide to schedule +;;; (let ((o (new-blank-node))) ;; o = observation, an instance of a cell to be observed and its parameters +;;; (add-triple o !ccc:obs-s cell) +;;; (add-triple o !ccc:obs-p cell) +;;; (add-triple o !ccc:obs-new-value (mk-upi new-value)) +;;; (add-triple o !ccc:obs-prior-value (mk-upi prior-value)) +;;; (add-triple o !ccc:obs-prior-value? (mk-upi prior-value?)) +;;; (add-triple !ccc:obs-queue (mk-upi (get-internal-real-time)) o)) +;;; (trc "unobserved" s p))) + +;;;(defun process-observer-queue () +;;; (index-new-triples) +;;; (let ((oq (get-triples-list :s !ccc:obs-queue))) +;;; (loop for observation in (mapcar 'object oq) +;;; for s = (object (get-sp observation !ccc:obs-s)) +;;; for p = (object (get-sp observation !ccc:obs-p)) +;;; for new-value = (get-sp-value observation !ccc:obs-new-value) +;;; for prior-value = (get-sp-value observation !ccc:obs-prior-value) +;;; for prior-value? = (get-sp-value observation !ccc:obs-prior-value) +;;; do (loop for observer in (get-triples-list :s s :p !ccc:observer-is) +;;; do (funcall (3c-observer (object observer)) s p +;;; new-value prior-value prior-value?)))))

;;; ---------------------------------------------------- @@ -60,3 +70,8 @@ (assert fn$)

(eval (read-from-string fn$)))))) + +(defun 3c-observer-from-rule-triple (tr) + (let ((fn$ (triple-value tr))) + (assert fn$) + (eval (read-from-string fn$)))) --- /project/cells/cvsroot/triple-cells/triple-cells.lpr 2007/12/23 10:04:56 1.3 +++ /project/cells/cvsroot/triple-cells/triple-cells.lpr 2008/02/23 01:22:11 1.4 @@ -1,4 +1,4 @@ -;; -*- lisp-version: "8.1 [Windows] (Dec 2, 2007 6:32)"; cg: "1.103.2.10"; -*- +;; -*- lisp-version: "8.1 [Windows] (Feb 1, 2008 18:35)"; cg: "1.103.2.10"; -*-

(in-package :cg-user)

@@ -6,14 +6,14 @@

(define-project :name :triple-cells :modules (list (make-instance 'module :name "defpackage.lisp") + (make-instance 'module :name "ag-utilities.lisp") (make-instance 'module :name "core.lisp") - (make-instance 'module :name "agraph-tutorial") - (make-instance 'module :name "namespace.lisp") (make-instance 'module :name "api.lisp") - (make-instance 'module :name "ag-utilities.lisp") (make-instance 'module :name "dataflow.lisp") (make-instance 'module :name "observer.lisp") - (make-instance 'module :name "hello-world.lisp")) + (make-instance 'module :name "hello-world.lisp") + (make-instance 'module :name "read-me.lisp") + (make-instance 'module :name "3c-integrity.lisp")) :projects (list (make-instance 'project-module :name "..\Cells\cells")) :libraries nil