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

Contents of /triple-cells/dataflow.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.2 - (hide annotations)
Sat Feb 23 01:22:11 2008 UTC (6 years, 1 month ago) by ktilton
Branch: MAIN
CVS Tags: HEAD
Changes since 1.1: +21 -35 lines
Version 2, with integrity
1 ktilton 1.1 ;; -*- mode: Lisp; Syntax: Common-Lisp; Package: triple-cells; -*-
2     ;;;
3     ;;;
4 ktilton 1.2 ;;; Copyright (c) 2008 by Kenneth William Tilton.
5 ktilton 1.1 ;;;
6    
7     (in-package :3c)
8    
9     (defun 3c-propagate (cell)
10 ktilton 1.2 (3c-ufb-add !ccc:ufb-tell-dependents cell))
11 ktilton 1.1
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 ktilton 1.2 (setf s (cell-model cell))
17     (setf p (cell-predicate cell)))
18 ktilton 1.1 ;(trc "3c-ensure-current" s p)
19     (when (and cell (3c-ruled? cell))
20 ktilton 1.2 (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 ktilton 1.1 (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 ktilton 1.2
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