[cells-cvs] CVS cells

[ktilton]

Update of /project/cells/cvsroot/cells
In directory clnet:/tmp/cvs-serv6305

Modified Files:
	cells.lpr constructors.lisp family.lisp 
Added Files:
	variables.lisp 
Log Message:


--- /project/cells/cvsroot/cells/cells.lpr	2006/12/12 15:58:42	1.25
+++ /project/cells/cvsroot/cells/cells.lpr	2006/12/13 18:05:08	1.26
@@ -23,8 +23,7 @@
                  (make-instance 'module :name "md-utilities.lisp")
                  (make-instance 'module :name "family.lisp")
                  (make-instance 'module :name "fm-utilities.lisp")
-                 (make-instance 'module :name "family-values.lisp")
-                 (make-instance 'module :name "variables.lisp"))
+                 (make-instance 'module :name "family-values.lisp"))
   :projects (list (make-instance 'project-module :name
                                  "utils-kt\\utils-kt"))
   :libraries nil
--- /project/cells/cvsroot/cells/constructors.lisp	2006/12/12 15:58:42	1.14
+++ /project/cells/cvsroot/cells/constructors.lisp	2006/12/13 18:05:08	1.15
@@ -62,7 +62,8 @@
     :rule (c-lambda , at body)
     , at args))
 
-(export! c?once c?n-until c?1)
+(export! c?once c?n-until c?1 c_1)
+
 (defmacro c?once (&body body)
   `(make-c-dependent
     :code '(without-c-dependency , at body)
@@ -70,6 +71,14 @@
     :value-state :unevaluated
     :rule (c-lambda (without-c-dependency , at body))))
 
+(defmacro c_1 (&body body)
+  `(make-c-dependent
+    :code '(without-c-dependency , at body)
+    :inputp nil
+    :lazy t
+    :value-state :unevaluated
+    :rule (c-lambda (without-c-dependency , at body))))
+
 (defmacro c?1 (&body body)
   `(c?once , at body))
 
--- /project/cells/cvsroot/cells/family.lisp	2006/11/13 05:28:08	1.17
+++ /project/cells/cvsroot/cells/family.lisp	2006/12/13 18:05:08	1.18
@@ -19,12 +19,14 @@
 (in-package :cells)
 
 (eval-when (:compile-toplevel :execute :load-toplevel)
-  (export '(model value family kids kid1 ^k1 kid2 ^k2 last-kid ^k-last perishable)))
+  (export '(model value family dbg
+             kids kid1 ^k1 kid2 ^k2 last-kid ^k-last perishable)))
 
 (defmodel model ()
   ((.md-name :cell nil :initform nil :initarg :md-name :accessor md-name)
    (.fm-parent :cell nil :initform nil :initarg :fm-parent :accessor fm-parent)
-   (.value :initform nil :accessor value :initarg :value)))
+   (.value :initform nil :accessor value :initarg :value)
+   (zdbg :initform nil :accessor dbg :initarg :dbg)))
 
 
 (defmethod fm-parent (other)

--- /project/cells/cvsroot/cells/variables.lisp	2006/12/13 18:05:08	NONE
+++ /project/cells/cvsroot/cells/variables.lisp	2006/12/13 18:05:08	1.1
;; -*- mode: Lisp; Syntax: Common-Lisp; Package: cells; -*-
#|

    Cells -- Automatic Dataflow Managememnt

Copyright (C) 1995, 2006 by Kenneth Tilton

This library is free software; you can redistribute it and/or
modify it under the terms of the Lisp Lesser GNU Public License
 (http://opensource.franz.com/preamble.html), known as the LLGPL.

This library is distributed  WITHOUT ANY WARRANTY; without even 
the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  

See the Lisp Lesser GNU Public License for more details.

|#

(in-package :cells)

(defun c-variable-accessor (symbol)
  (assert (symbolp symbol))
  (c-variable-reader symbol))

(defun (setf c-variable-accessor) (value symbol)
  (assert (symbolp symbol))
  (c-variable-writer value symbol))

(defun c-variable-reader (symbol)
  (assert (symbolp symbol))
  (assert (get symbol 'cell))
  (cell-read (get symbol 'cell)))

(defun c-variable-writer (value symbol)
  (assert (symbolp symbol))
  (setf (md-slot-value nil symbol) value)
  (setf (symbol-value symbol) value))

(export! def-c-variable)

(defmacro def-c-variable (v-name cell &key ephemeral owning unchanged-if)
  (declare (ignore unchanged-if))
  (let ((c 'whathef)) ;;(gensym)))
    `(progn
       (eval-when (:compile-toplevel :load-toplevel)
         (define-symbol-macro ,v-name (c-variable-accessor ',v-name))
         (setf (md-slot-cell-type 'null ',v-name) (when ,ephemeral :ephemeral))
         (when ,owning
           (setf (md-slot-owning 'null ',v-name) t)))
       (eval-when (:load-toplevel)
         (let ((,c ,cell))
           (md-install-cell nil ',v-name ,c)
           (awaken-cell ,c)))
       ',v-name)))


(defobserver *kenny* ()
  (trcx kenny-obs new-value old-value old-value-boundp))

#+test
(def-c-variable *kenny* (c-in nil))

#+test
(defmd kenny-watcher ()
  (twice (c? (bwhen (k *kenny*)
               (* 2 k)))))

(defobserver twice ()
  (trc "twice kenny is:" new-value self old-value old-value-boundp))

#+test-ephem
(progn
  (cells-reset)
  (let ((tvw (make-instance 'kenny-watcher)))
    (trcx twice-read (twice tvw))
    (setf *c-debug* nil)
    (setf *kenny* 42)
    (setf *kenny* 42)
    (trcx post-setf-kenny *kenny*)
    (trcx print-twice (twice tvw))
    ))

#+test
(let ((*kenny* 13)) (print *kenny*))
     
#+test
(let ((c (c-in 42)))
  (md-install-cell '*test-c-variable* '*test-c-variable* c)
  (awaken-cell c)
  (let ((tvw (make-instance 'test-var-watcher)))
    (trcx twice-read (twice tvw))
    (setf *test-c-variable* 69)
    (trcx print-testvar *test-c-variable*)
    (trcx print-twice (twice tvw))
    (unless (eql (twice tvw) 138)
      (inspect (md-slot-cell tvw 'twice))
      (inspect c)
      ))
  )

#+test2
(let ((tvw (make-instance 'test-var-watcher :twice (c-in 42))))
  (let ((c (c? (trcx joggggggggging!!!!!!!!!!!!!!!)
             (floor (twice tvw) 2))))
    (md-install-cell '*test-c-variable* '*test-c-variable* c)
    (awaken-cell c)
    (trcx print-testvar *test-c-variable*)
    (trcx twice-read (twice tvw))
    (setf (twice tvw) 138)
    (trcx print-twice (twice tvw))
    (trcx print-testvar *test-c-variable*)
    (unless (eql *test-c-variable* 69)
      (inspect (md-slot-cell tvw 'twice))
      (inspect c)
      ))
  )