[cells-cvs] CVS cells

[ktilton]

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

Modified Files:
	cells.lisp cells.lpr md-slot-value.lisp optimization.lisp 
Log Message:
Lose *c-optimizep* (and the sep source file next)

--- /project/cells/cvsroot/cells/cells.lisp	2006/06/23 01:04:56	1.13
+++ /project/cells/cvsroot/cells/cells.lisp	2006/06/25 21:30:34	1.14
@@ -21,7 +21,6 @@
 
 (in-package :cells)
 
-(define-constant *c-optimizep* t)
 (defparameter *c-prop-depth* 0)
 (defparameter *causation* nil)
 
--- /project/cells/cvsroot/cells/cells.lpr	2006/06/23 01:04:56	1.15
+++ /project/cells/cvsroot/cells/cells.lpr	2006/06/25 21:30:34	1.16
@@ -13,7 +13,6 @@
                  (make-instance 'module :name "initialize.lisp")
                  (make-instance 'module :name "md-slot-value.lisp")
                  (make-instance 'module :name "slot-utilities.lisp")
-                 (make-instance 'module :name "optimization.lisp")
                  (make-instance 'module :name "link.lisp")
                  (make-instance 'module :name "propagate.lisp")
                  (make-instance 'module :name "synapse.lisp")
--- /project/cells/cvsroot/cells/md-slot-value.lisp	2006/06/23 01:04:56	1.22
+++ /project/cells/cvsroot/cells/md-slot-value.lisp	2006/06/25 21:30:34	1.23
@@ -205,5 +205,31 @@
         
         absorbed-value)))
 
+;---------- optimizing away cells whose dependents all turn out to be constant ----------------
+;
+
+(defun c-optimize-away?! (c)
+  (when (and (typep c 'c-dependent)
+          (not (c-optimized-away-p c)) ;; c-streams (FNYI) may come this way repeatedly even if optimized away
+          (c-validp c)
+          (not (c-synaptic c)) ;; no slot to cache invariant result, so they have to stay around)
+          ;; chop (every (lambda (lbl-syn) (null (cd-useds (cdr lbl-syn)))) (cd-synapses c))
+          (not (c-inputp c))
+          (null (cd-useds c)))
+         
+    (trc nil "optimizing away" c (c-state c))
+    (count-it :c-optimized)
+    
+    (setf (c-state c) :optimized-away)
+       
+    (let ((entry (rassoc c (cells (c-model c))))) ; move from cells to cells-flushed
+      (c-assert entry)
+      (setf (cells (c-model c)) (delete entry (cells (c-model c))))
+      (push entry (cells-flushed (c-model c))))
+       
+    (dolist (caller (c-callers c))
+      (setf (cd-useds caller) (delete c (cd-useds caller)))
+      (c-optimize-away?! caller) ;; rare but it happens when rule says (or .cache ...)
+      )))
 
     
--- /project/cells/cvsroot/cells/optimization.lisp	2006/06/23 01:04:56	1.8
+++ /project/cells/cvsroot/cells/optimization.lisp	2006/06/25 21:30:34	1.9
@@ -18,41 +18,3 @@
 
 (in-package :cells)
 
-;---------- optimizing away cells whose dependents all turn out to be constant ----------------
-;
-
-(defun c-optimize-away?! (c)
-  (declare (ignorable c))
-
-  (typecase c
-    (c-dependent
-     (if (and *c-optimizep*
-           (not (c-optimized-away-p c)) ;; c-streams (FNYI) may come this way repeatedly even if optimized away
-           (c-validp c)
-           (not (c-synaptic c)) ;; no slot to cache invariant result, so they have to stay around)
-           ;; chop (every (lambda (lbl-syn) (null (cd-useds (cdr lbl-syn)))) (cd-synapses c))
-           (not (c-inputp c))
-           (null (cd-useds c)))
-         
-         (progn
-           (trc nil "optimizing away" c (c-state c))
-           (count-it :c-optimized)
-           
-           (setf (c-state c) :optimized-away)
-
-           (let ((entry (rassoc c (cells (c-model c))))) ; move from cells to cells-flushed
-             (c-assert entry)
-             (setf (cells (c-model c)) (delete entry (cells (c-model c))))
-             (push entry (cells-flushed (c-model c))))
-           
-           (dolist (caller (c-callers c))
-             (setf (cd-useds caller) (delete c (cd-useds caller)))
-             (c-optimize-away?! caller) ;; rare but it happens when rule says (or .cache ...)
-             )
-           t)
-       
-       (progn
-         (trc nil "not optimizing away" *c-optimizep* (car (cd-useds c)) (c-validp c))
-         ;  (count-it :c-not-optimize)
-         ;  (count-it (intern-keyword "noopti-" #+nah (c-model c) "-" (symbol-name (c-slot-name c))))
-         )))))