/[cells]/triple-cells/3c-integrity.lisp
ViewVC logotype

Contents of /triple-cells/3c-integrity.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.1 - (show annotations)
Sat Feb 23 01:23:45 2008 UTC (6 years, 1 month ago) by ktilton
Branch: MAIN
CVS Tags: HEAD
*** empty log message ***
1 (in-package :3c)
2
3 (defmacro with-3c-integrity ((&optional opcode defer-info debug) &rest body)
4 `(call-with-3c-integrity ,opcode ,defer-info (lambda (opcode defer-info)
5 (declare (ignorable opcode defer-info))
6 ,(when debug
7 `(trc "integrity action entry" opcode defer-info ',body))
8 ,@body)))
9
10 (defmacro with-3cc (id &body body)
11 `(with-ec-integrity (:change ,id)
12 ,@body))
13
14 (defun 3c-integrity-managed? ()
15 (get-triple :s !ccc:integrity :p !ccc:within))
16
17 (defun (setf 3c-integrity-managed?) (on?)
18 (if on?
19 (if (get-triple :s !ccc:integrity :p !ccc:within)
20 (break "integ already managed")
21 (add-triple !ccc:integrity !ccc:within (new-blank-node)))
22 (bif (tr (get-triple :s !ccc:integrity :p !ccc:within))
23 (delete-triple (triple-id tr))
24 (warn "integ not being managed, nothing to turn off"))))
25
26 (defun call-with-3c-integrity (opcode defer-info action)
27 (if (3c-integrity-managed?)
28 (if opcode
29 (3c-ufb-add opcode defer-info)
30 (funcall action opcode defer-info))
31 (prog2
32 (setf (3c-integrity-managed?) t)
33
34 (progn ;; let (*defer-changes*)
35 (when (or (null (3c-pulse))
36 (eq opcode :change))
37 (3c-pulse-advance (cons opcode defer-info)))
38 (prog1
39 (funcall action opcode defer-info)
40 (3c-finish-business)))
41
42 (setf (3c-integrity-managed?) nil))))
43
44 (defun 3c-ufb-add (opcode defer-info)
45 (add-triple opcode (mk-upi (get-internal-real-time)) defer-info))
46
47 (defun 3c-finish-business ()
48 (tagbody
49 tell-dependents
50 (process-tell-dependents)
51 (process-awaken)
52 (when (get-triple :p !ccc:tell-dependents)
53 (go tell-dependents))
54
55 ;;; ;--- process client queue ------------------------------
56 ;;; ;
57 ;;; handle-clients
58 ;;; (bwhen (clientq (ufb-queue :client))
59 ;;; (if *client-queue-handler*
60 ;;; (funcall *client-queue-handler* clientq) ;; might be empty/not exist, so handlers must check
61 ;;; (just-do-it clientq))
62 ;;; (when (fifo-peek (ufb-queue :client))
63 ;;; #+shhh (ukt::fifo-browse (ufb-queue :client) (lambda (entry)
64 ;;; (trc "surprise client" entry)))
65 ;;; (go handle-clients)))
66 (process-reset-ephemerals)
67
68 ;;; (bwhen (task-info (fifo-pop (ufb-queue :change)))
69 ;;; (trc nil "!!! finbiz --- CHANGE ---- (first of)" (fifo-length (ufb-queue :change)))
70 ;;; (destructuring-bind (defer-info . task-fn) task-info
71 ;;; (trc nil "finbiz: deferred state change" defer-info)
72 ;;; (data-pulse-next (list :finbiz defer-info))
73 ;;; (funcall task-fn :change defer-info)
74 ;;; (go tell-dependents)))
75 ))
76
77 (defun process-tell-dependents ()
78 (index-new-triples)
79 (loop while (loop with any
80 for cell in (prog1
81 (mapcar 'object (get-triples-list :s !ccc:ufb-tell-dependents))
82 (delete-triples :s !ccc:ufb-tell-dependents))
83 do (loop for user in (get-triples-list :p !ccc:uses :o cell)
84 do (trc nil "propagating !!!!!!!!!!!!" cell :to (cell-predicate (subject user)))
85 (setf any t)
86 (3c-ensure-current (subject user)))
87 finally (return any))))
88
89 (defun process-awaken ()
90 (index-new-triples)
91 (loop for cell in (prog1
92 (mapcar 'object (get-triples-list :s !ccc:awaken-ruled-cell))
93 (delete-triples :s !ccc:awaken-ruled-cell))
94 do (3c-awaken-ruled-cell cell))
95 (loop for o in (prog1
96 (mapcar 'object (get-triples-list :s !ccc:observe))
97 (delete-triples :s !ccc:observe))
98 do (if (3c-cell? o)
99 (cell-observe-change o (cell-model o) (cell-predicate o) (3c-cell-value o) nil nil)
100 (let ((tr (get-triple-by-id (upi->value o)))) ;; must be a mod-pred-triple constant
101 (trc "obsing k" tr (predicate tr))
102 (cell-observe-change nil (subject tr) (predicate tr) (upi->value (object tr)) nil nil)))))
103
104 (defun process-reset-ephemerals ()
105 (let ((q !ccc:ufb-reset-ephemerals))
106 (index-new-triples)
107 (loop for cell in (prog1
108 (mapcar 'object (get-triples-list :s q))
109 (delete-triples :s q))
110 for p = (cell-predicate cell)
111 do ;(trc "resetting ephemeral" p)
112 (delete-triples :s cell :p !ccc:value)
113 (delete-triples :s (cell-model cell) :p p))))

  ViewVC Help
Powered by ViewVC 1.1.5