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

Diff of /triple-cells/api.lisp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.1 by ktilton, Sun Dec 23 10:04:56 2007 UTC revision 1.2 by ktilton, Sat Feb 23 01:22:11 2008 UTC
# Line 1  Line 1 
1  ;; -*- mode: Lisp; Syntax: Common-Lisp; Package: triple-cells; -*-  ;; -*- mode: Lisp; Syntax: Common-Lisp; Package: triple-cells; -*-
2  ;;;  ;;;
3  ;;;  ;;;
4  ;;; Copyright (c) 1995,2003 by Kenneth William Tilton.  ;;; Copyright (c) 2008 by Kenneth William Tilton.
5  ;;;  ;;;
 ;;; 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.  
6    
7    
8  (in-package :3c)  (in-package :3c)
# Line 27  Line 10 
10  ;;; --- API ---------------------------------------  ;;; --- API ---------------------------------------
11    
12  (defun 3c-init ()  (defun 3c-init ()
   (setf *3c-pulse* 0)  
13    (setf *calc-nodes* nil)    (setf *calc-nodes* nil)
14    (setf *3c?* (make-hash-table :test 'equal))    (setf *3c?* (make-hash-table :test 'equal))
15    (setf *3c-observers* (make-hash-table :test 'equal)))    (setf *3c-observers* (make-hash-table :test 'equalp)))
16    
17  ;;; --- API constructors -------------------------------  ;;; --- API constructors -------------------------------
18    
# Line 59  Line 41 
41      (add-triple c !ccc:type !ccc:ruled)      (add-triple c !ccc:type !ccc:ruled)
42      (add-triple c !ccc:rule (mk-upi (prin1-to-string rule)))      (add-triple c !ccc:rule (mk-upi (prin1-to-string rule)))
43      (when ephemeral      (when ephemeral
44          ;(trc "bingo ephemeral" rule)
45        (add-triple c !ccc:ephemeral !ccc:t))        (add-triple c !ccc:ephemeral !ccc:t))
46      (when test      (when test
47        (add-triple c !ccc:test (mk-upi test)))        (add-triple c !ccc:test (mk-upi test)))
# Line 71  Line 54 
54        ;(trc "c? value tr" tr-cv)        ;(trc "c? value tr" tr-cv)
55        c)))        c)))
56    
   
   
57  ;;; --- API accessors  ;;; --- API accessors
58    
 (defun clear-usage (cell)  
   (delete-triples :s cell :p !ccc:uses))  
   
59  (defun 3c (s p)  (defun 3c (s p)
60    (assert (and s p))    (assert (and s p))
61    (bif (cell (stmt-cell s p))    (bif (cell (stmt-cell s p))
# Line 102  Line 80 
80        ;(trc "tr-value" (triple-id tr-value))        ;(trc "tr-value" (triple-id tr-value))
81    
82        (unless (equal new-value prior-value)        (unless (equal new-value prior-value)
83          (3c-pulse-advance :setf-3c)          (with-3c-integrity (:change cell)
84          (when tr-value            (when tr-value
85            (delete-triple (triple-id tr-value)))              (delete-triple (triple-id tr-value)))
86    
87          (let* ((new-value-upi (mk-upi new-value))            (let ((new-value-upi (mk-upi new-value)))
88                 (tr-value-new (add-triple s p new-value-upi)))              (add-triple s p new-value-upi)
89                ; cell maintenance, including its own copy of value
90            (delete-triples :s cell :p !ccc:value)              (delete-triples :s cell :p !ccc:value)
91                (add-triple cell !ccc:value new-value-upi)
           (let ((tr-cell-value-new (add-triple cell !ccc:value new-value-upi)))  
92              (3c-propagate cell)              (3c-propagate cell)
93              (cell-observe-change cell s p new-value prior-value t)              (cell-observe-change cell s p new-value prior-value t)
94              (when (3c-ephemeral? cell)              (when (3c-ephemeral? cell)
95                ; fix up cell...                (add-triple !ccc:ufb-reset-ephemerals (mk-upi 42) cell)))))))
96                (delete-triple tr-cell-value-new)  
               ; reset value itself to nil  
               (delete-triple tr-value-new)))))))  
97    

Legend:
Removed from v.1.1  
changed lines
  Added in v.1.2

  ViewVC Help
Powered by ViewVC 1.1.5