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 ,@body) ,@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 ,@body) @@ -70,6 +71,14 @@ :value-state :unevaluated :rule (c-lambda (without-c-dependency ,@body))))
+(defmacro c_1 (&body body) + `(make-c-dependent + :code '(without-c-dependency ,@body) + :inputp nil + :lazy t + :value-state :unevaluated + :rule (c-lambda (without-c-dependency ,@body)))) + (defmacro c?1 (&body body) `(c?once ,@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) )) )