/[cells]/triple-cells/observer.lisp
ViewVC logotype

Contents of /triple-cells/observer.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.2 - (show annotations)
Sat Feb 23 01:22:11 2008 UTC (6 years, 1 month ago) by ktilton
Branch: MAIN
Changes since 1.1: +39 -24 lines
Version 2, with integrity
1 ;; -*- mode: Lisp; Syntax: Common-Lisp; Package: triple-cells; -*-
2 ;;;
3 ;;;
4 ;;; Copyright (c) 2008 by Kenneth William Tilton.
5 ;;;
6
7 (in-package :3c)
8
9 (defmacro make-observer (id form)
10 `(call-make-observer ,id
11 '(lambda (s p new-value prior-value prior-value?)
12 (declare (ignorable s p new-value prior-value prior-value?))
13 ,form)))
14
15 (defun call-make-observer (id observer)
16 (add-triple id !ccc:observer-id-rule (mk-upi (prin1-to-string observer)))
17 (setf (3c-observer id) (eval observer))) ;; while we're at it
18
19
20 ;;; --- 3cell observation --------------------------------------------------------
21
22 (defun cell-observe-change (cell s p new-value prior-value prior-value?)
23 (cond
24 (cell
25 (loop for observer in (get-triples-list :s cell :p !ccc:observer-is)
26 do (funcall (3c-observer (object observer)) s p
27 new-value prior-value prior-value?)))
28 (p (loop for observer in (get-triples-list :s p :p !ccc:observer-id-rule)
29 do (funcall (3c-observer-from-rule-triple observer) s p
30 new-value prior-value prior-value?)))))
31
32 ;;;(defun cell-observe-change (cell s p new-value prior-value prior-value?)
33 ;;; (trc "observing" p new-value)
34 ;;; (if (get-triple :s cell :p !ccc:observer-is) ; just need one to decide to schedule
35 ;;; (let ((o (new-blank-node))) ;; o = observation, an instance of a cell to be observed and its parameters
36 ;;; (add-triple o !ccc:obs-s cell)
37 ;;; (add-triple o !ccc:obs-p cell)
38 ;;; (add-triple o !ccc:obs-new-value (mk-upi new-value))
39 ;;; (add-triple o !ccc:obs-prior-value (mk-upi prior-value))
40 ;;; (add-triple o !ccc:obs-prior-value? (mk-upi prior-value?))
41 ;;; (add-triple !ccc:obs-queue (mk-upi (get-internal-real-time)) o))
42 ;;; (trc "unobserved" s p)))
43
44 ;;;(defun process-observer-queue ()
45 ;;; (index-new-triples)
46 ;;; (let ((oq (get-triples-list :s !ccc:obs-queue)))
47 ;;; (loop for observation in (mapcar 'object oq)
48 ;;; for s = (object (get-sp observation !ccc:obs-s))
49 ;;; for p = (object (get-sp observation !ccc:obs-p))
50 ;;; for new-value = (get-sp-value observation !ccc:obs-new-value)
51 ;;; for prior-value = (get-sp-value observation !ccc:obs-prior-value)
52 ;;; for prior-value? = (get-sp-value observation !ccc:obs-prior-value)
53 ;;; do (loop for observer in (get-triples-list :s s :p !ccc:observer-is)
54 ;;; do (funcall (3c-observer (object observer)) s p
55 ;;; new-value prior-value prior-value?)))))
56
57
58 ;;; ----------------------------------------------------
59
60 (defvar *3c-observers*)
61
62 (defun (setf 3c-observer) (function c-node)
63 (assert (functionp function) () "3c-observer setf not rule: ~a ~a" (type-of function) function)
64 (setf (gethash c-node *3c-observers*) function))
65
66 (defun 3c-observer (c-node &aux (unode (part->string c-node)))
67 (or (gethash unode *3c-observers*)
68 (setf (gethash unode *3c-observers*)
69 (let ((fn$ (get-sp-value unode !ccc:observer-id-rule)))
70 (assert fn$)
71
72 (eval (read-from-string fn$))))))
73
74 (defun 3c-observer-from-rule-triple (tr)
75 (let ((fn$ (triple-value tr)))
76 (assert fn$)
77 (eval (read-from-string fn$))))

  ViewVC Help
Powered by ViewVC 1.1.5