From 97be1c6af52fa8bed14acf2fe3cf508555fc3384 Mon Sep 17 00:00:00 2001
From: jgarcia <jgarcia>
Date: Tue, 18 Dec 2007 21:54:46 +0000
Subject: [PATCH] When upgrading the type of a node, cannot clone it or the
 parent-child chain will be broken

---
 src/cmp/cmptype.lsp   | 18 ++++++++++--------
 src/lsp/config.lsp.in |  2 +-
 2 files changed, 11 insertions(+), 9 deletions(-)

diff --git a/src/cmp/cmptype.lsp b/src/cmp/cmptype.lsp
index 557eefae4..3b7854b40 100644
--- a/src/cmp/cmptype.lsp
+++ b/src/cmp/cmptype.lsp
@@ -190,9 +190,7 @@
       (funcall (if (eq mode :safe) #'cmperr #'cmpwarn)
 	       "~?, the type of the form ~s is ~s, not ~s." format-string
 	       format-args original-form type2 type))
-    (unless (eq type1 type2)
-      (setf form (copy-c1form form))
-      (setf (c1form-type form) type1))
+    (setf (c1form-type form) type1)
     form))
 
 (defun default-init (var &optional warn)
@@ -390,12 +388,16 @@
 	  ((endp fl))
 	(unless (endp arg-types)
 	  ;; Check the type of the arguments.
-	  (let ((new (and-form-type (pop arg-types) (first fl) (first al)
-				    :safe "In the argument ~d of a call to ~a" i fname)))
-	    ;; In unsafe mode, we assume that the type of the
+	  (let* ((form (first fl))
+		 (lisp-form (first al))
+		 (expected-type (pop arg-types))
+                 (old-type (c1form-type form)))
+	    (and-form-type expected-type form lisp-form
+			   :safe "In the argument ~d of a call to ~a" i fname)
+	    ;; In safe mode, we cannot assume that the type of the
 	    ;; argument is going to be the right one.
-	    (when (zerop *safety*)
-	      (setf (car fl) new))))))
+	    (unless (zerop *safety*)
+              (setf (c1form-type new) old-type))))))
     return-type))
 
 (defmacro def-type-propagator (fname lambda-list &body body)
diff --git a/src/lsp/config.lsp.in b/src/lsp/config.lsp.in
index 8190229cf..460043576 100644
--- a/src/lsp/config.lsp.in
+++ b/src/lsp/config.lsp.in
@@ -24,7 +24,7 @@ Returns, as a string, the location of the machine on which ECL runs."
 (defun lisp-implementation-version ()
   "Args:()
 Returns the version of your ECL as a string."
-  "@PACKAGE_VERSION@ (CVS 2007-12-18 21:41)")
+  "@PACKAGE_VERSION@ (CVS 2007-12-18 22:53)")
 
 (defun machine-type ()
   "Args: ()