[cells-cvs] CVS triple-cells

ktilton ktilton at common-lisp.net
Sat Feb 23 01:22:11 UTC 2008


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




More information about the Cells-cvs mailing list