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) )) )