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
