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

Contents of /triple-cells/dataflow.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.2 - (show annotations)
Sat Feb 23 01:22:11 2008 UTC (6 years, 2 months ago) by ktilton
Branch: MAIN
CVS Tags: HEAD
Changes since 1.1: +21 -35 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 (defun 3c-propagate (cell)
10 (3c-ufb-add !ccc:ufb-tell-dependents cell))
11
12 ;;; --- integrity -----------------(part-value prior-value)-----------------------------
13
14 (defun 3c-ensure-current (cell &optional s p) ;; when we don't have s/p extend to work backwards from cell
15 (unless s
16 (setf s (cell-model cell))
17 (setf p (cell-predicate cell)))
18 ;(trc "3c-ensure-current" s p)
19 (when (and cell (3c-ruled? cell))
20 (unless (upi= (3c-pulse) (3c-cell-pulse cell))
21 ; (trc "old" (3c-cell-value cell))
22 ;(trc "HEY!!! what happened to checking if necessary to rerun rule?!")
23 (let* ((prior-value (3c-cell-value cell))
24 (new-value (progn
25 (clear-usage cell)
26 (funcall (3c?-rule cell) cell
27 prior-value
28 t)))
29 (test (or (bwhen (test (get-sp-value cell !ccc:test))
30 (intern test))
31 'EQL)))
32
33 (if (funcall test new-value prior-value)
34 (3c-cell-make-current cell)
35 (progn
36 ;(trc "prop new" new-value :prior prior-value)
37 (let ((prior-value (3c-cell-value cell)))
38 (setf (3c-cell-value cell) new-value)
39 (delete-triples :s s :p p)
40 (when new-value
41 (add-triple s p (mk-upi new-value)))
42 (3c-propagate cell)
43 (cell-observe-change cell s p new-value prior-value t)
44 (when (3c-ephemeral? cell)
45 (add-triple !ccc:ufb-reset-ephemerals (mk-upi 42) cell)))))))))

  ViewVC Help
Powered by ViewVC 1.1.5