X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fmain.lisp;h=d5ce1d971073b01af453c448389135d60dfc6a58;hb=b33fd6859bbe71667bf9d8a6dbcaf62464bfbee5;hp=e359b1a612c1f9a4c1dfc2a3545d108ae37ca4fe;hpb=4823297c200e5b1fcab240f06ce82c308b8ee7d7;p=sbcl.git

diff --git a/src/compiler/main.lisp b/src/compiler/main.lisp
index e359b1a..d5ce1d9 100644
--- a/src/compiler/main.lisp
+++ b/src/compiler/main.lisp
@@ -137,7 +137,7 @@
     (pprint-logical-block (*error-output* nil :per-line-prefix "; ")
        (apply #'compiler-mumble foo))))
 
-(deftype object () '(or fasl-file core-object null))
+(deftype object () '(or fasl-output core-object null))
 
 (defvar *compile-object* nil)
 (declaim (type object *compile-object*))
@@ -461,7 +461,7 @@
 						     *compiler-trace-output*))
 
 	    (etypecase *compile-object*
-	      (fasl-file
+	      (fasl-output
 	       (maybe-mumble "fasl")
 	       (fasl-dump-component component
 				    *code-segment*
@@ -745,7 +745,7 @@
 				:forms (vector form)
 				:positions '#(0)))))
 
-;;; Return a SOURCE-INFO which will read from Stream.
+;;; Return a SOURCE-INFO which will read from STREAM.
 (defun make-stream-source-info (stream)
   (let ((files (list (make-file-info :name :stream))))
     (make-source-info
@@ -753,88 +753,28 @@
      :current-file files
      :stream stream)))
 
-;;; Print an error message for a non-EOF error on STREAM. OLD-POS is a
-;;; preceding file position that hopefully comes before the beginning
-;;; of the line. Of course, this only works on streams that support
-;;; the file-position operation.
-(defun normal-read-error (stream old-pos condition)
-  (declare (type stream stream) (type unsigned-byte old-pos))
-  (let ((pos (file-position stream)))
-    (file-position stream old-pos)
-    (let ((start old-pos))
-      (loop
-	(let ((line (read-line stream nil))
-	      (end (file-position stream)))
-	  (when (>= end pos)
-	    ;; FIXME: READER-ERROR also prints the file position. Do we really
-	    ;; need to try to give position information here?
-	    (compiler-abort "read error at ~D:~% \"~A/\\~A\"~%~A"
-			    pos
-			    (string-left-trim " 	"
-					      (subseq line 0 (- pos start)))
-			    (subseq line (- pos start))
-			    condition)
-	    (return))
-	  (setq start end)))))
-  (values))
-
-;;; Back STREAM up to the position Pos, then read a form with
-;;; *READ-SUPPRESS* on, discarding the result. If an error happens
-;;; during this read, then bail out using COMPILER-ERROR (fatal in
-;;; this context).
-(defun ignore-error-form (stream pos)
-  (declare (type stream stream) (type unsigned-byte pos))
-  (file-position stream pos)
-  (handler-case (let ((*read-suppress* t))
-		  (read stream))
-    (error (condition)
-      (declare (ignore condition))
-      (compiler-error "unable to recover from read error"))))
-
-;;; Print an error message giving some context for an EOF error. We
-;;; print the first line after POS that contains #\" or #\(, or
-;;; lacking that, the first non-empty line.
-(defun unexpected-eof-error (stream pos condition)
-  (declare (type stream stream) (type unsigned-byte pos))
-  (let ((res nil))
-    (file-position stream pos)
-    (loop
-      (let ((line (read-line stream nil nil)))
-	(unless line (return))
-	(when (or (find #\" line) (find #\( line))
-	  (setq res line)
-	  (return))
-	(unless (or res (zerop (length line)))
-	  (setq res line))))
-    (compiler-abort "read error in form starting at ~D:~%~@[ \"~A\"~%~]~A"
-		    pos
-		    res
-		    condition))
-  (file-position stream (file-length stream))
-  (values))
-
-;;; Read a form from STREAM, returning EOF at EOF. If a read error
-;;; happens, then attempt to recover if possible, returning a proxy
-;;; error form.
-;;;
-;;; FIXME: This seems like quite a lot of complexity, and it seems
-;;; impossible to get it quite right. (E.g. the `(CERROR ..) form
-;;; returned here won't do the right thing if it's not in a position
-;;; for an executable form.) I think it might be better to just stop
-;;; trying to recover from read errors, punting all this noise
-;;; (including UNEXPECTED-EOF-ERROR and IGNORE-ERROR-FORM) and doing a
-;;; COMPILER-ABORT instead.
-(defun careful-read (stream eof pos)
-  (handler-case (read stream nil eof)
-    (error (condition)
-      (let ((new-pos (file-position stream)))
-	(cond ((= new-pos (file-length stream))
-	       (unexpected-eof-error stream pos condition))
-	      (t
-	       (normal-read-error stream pos condition)
-	       (ignore-error-form stream pos))))
-      '(cerror "Skip this form."
-	       "compile-time read error"))))
+;;; Read a form from STREAM; or for EOF, use the trick popularized by
+;;; Kent Pitman of returning STREAM itself. If an error happens, then
+;;; convert it to standard abort-the-compilation error condition
+;;; (possibly recording some extra location information).
+(defun read-for-compile-file (stream position)
+  (handler-case (read stream nil stream)
+    (reader-error (condition)
+     (error 'input-error-in-compile-file
+	    :error condition
+	    ;; We don't need to supply :POSITION here because
+	    ;; READER-ERRORs already know their position in the file.
+	    ))
+    ;; ANSI, in its wisdom, says that READ should return END-OF-FILE
+    ;; (and that this is not a READER-ERROR) when it encounters end of
+    ;; file in the middle of something it's trying to read.
+    (end-of-file (condition)
+     (error 'input-error-in-compile-file
+	    :error condition
+	    ;; We need to supply :POSITION here because the END-OF-FILE
+	    ;; condition doesn't carry the position that the user
+	    ;; probably cares about, where the failed READ began.
+	    :position position))))
 
 ;;; If STREAM is present, return it, otherwise open a stream to the
 ;;; current file. There must be a current file. When we open a new
@@ -884,23 +824,26 @@
 	 (stream (get-source-stream info)))
     (loop
      (let* ((pos (file-position stream))
-	    (eof '(*eof*))
-	    (form (careful-read stream eof pos)))
-       (if (eq form eof)
-	 (return)
-	 (let* ((forms (file-info-forms file))
-		(current-idx (+ (fill-pointer forms)
-				(file-info-source-root file))))
-	   (vector-push-extend form forms)
-	   (vector-push-extend pos (file-info-positions file))
-	   (clrhash *source-paths*)
-	   (find-source-paths form current-idx)
-	   (process-top-level-form form
-				   `(original-source-start 0 ,current-idx))))))
+	    (form (read-for-compile-file stream pos)))
+       (if (eq form stream) ; i.e., if EOF
+	   (return)
+	   (let* ((forms (file-info-forms file))
+		  (current-idx (+ (fill-pointer forms)
+				  (file-info-source-root file))))
+	     (vector-push-extend form forms)
+	     (vector-push-extend pos (file-info-positions file))
+	     (clrhash *source-paths*)
+	     (find-source-paths form current-idx)
+	     (process-top-level-form form
+				     `(original-source-start 0
+							     ,current-idx))))))
     (when (advance-source-file info)
       (process-sources info))))
 
 ;;; Return the FILE-INFO describing the INDEX'th form.
+;;;
+;;; FIXME: This is unnecessarily general cruft now that we only read
+;;; a single file in COMPILE-FILE.
 (defun find-file-info (index info)
   (declare (type index index) (type source-info info))
   (dolist (file (source-info-files info))
@@ -911,6 +854,9 @@
 
 ;;; Return the INDEX'th source form read from INFO and the position
 ;;; where it was read.
+;;;
+;;; FIXME: This is unnecessarily general cruft now that we only read
+;;; a single file in COMPILE-FILE.
 (defun find-source-root (index info)
   (declare (type source-info info) (type index index))
   (let* ((file (find-file-info index info))
@@ -972,7 +918,7 @@
 (defun process-cold-load-form (form path eval)
   (let ((object *compile-object*))
     (etypecase object
-      (fasl-file
+      (fasl-output
        (compile-top-level-lambdas () t)
        (fasl-dump-cold-load-form form object))
       ((or null core-object)
@@ -980,8 +926,6 @@
     (when eval
       (eval form))))
 
-(declaim (special *compiler-error-bailout*))
-
 ;;; Process a top-level FORM with the specified source PATH.
 ;;;  * If this is a magic top-level form, then do stuff.
 ;;;  * If this is a macro, then expand it.
@@ -1048,11 +992,11 @@
 ;;;;
 ;;;; (See EMIT-MAKE-LOAD-FORM.)
 
-;;; Returns T iff we are currently producing a fasl-file and hence
+;;; Returns T iff we are currently producing a fasl file and hence
 ;;; constants need to be dumped carefully.
 (defun producing-fasl-file ()
   (unless *converting-for-interpreter*
-    (fasl-file-p *compile-object*)))
+    (fasl-output-p *compile-object*)))
 
 ;;; Compile FORM and arrange for it to be called at load-time. Return
 ;;; the dumper handle and our best guess at the type of the object.
@@ -1101,125 +1045,6 @@
       (setf (component-name component) (leaf-name lambda))
       (compile-component component)
       (clear-ir1-info component))))
-
-;;; The entry point for MAKE-LOAD-FORM support. When IR1 conversion
-;;; finds a constant structure, it invokes this to arrange for proper
-;;; dumping. If it turns out that the constant has already been
-;;; dumped, then we don't need to do anything.
-;;;
-;;; If the constant hasn't been dumped, then we check to see whether
-;;; we are in the process of creating it. We detect this by
-;;; maintaining the special *CONSTANTS-BEING-CREATED* as a list of all
-;;; the constants we are in the process of creating. Actually, each
-;;; entry is a list of the constant and any init forms that need to be
-;;; processed on behalf of that constant.
-;;;
-;;; It's not necessarily an error for this to happen. If we are
-;;; processing the init form for some object that showed up *after*
-;;; the original reference to this constant, then we just need to
-;;; defer the processing of that init form. To detect this, we
-;;; maintain *CONSTANTS-CREATED-SINCE-LAST-INIT* as a list of the
-;;; constants created since the last time we started processing an
-;;; init form. If the constant passed to emit-make-load-form shows up
-;;; in this list, then there is a circular chain through creation
-;;; forms, which is an error.
-;;;
-;;; If there is some intervening init form, then we blow out of
-;;; processing it by throwing to the tag PENDING-INIT. The value we
-;;; throw is the entry from *CONSTANTS-BEING-CREATED*. This is so the
-;;; offending init form can be tacked onto the init forms for the
-;;; circular object.
-;;;
-;;; If the constant doesn't show up in *CONSTANTS-BEING-CREATED*, then
-;;; we have to create it. We call MAKE-LOAD-FORM and check to see
-;;; whether the creation form is the magic value
-;;; :JUST-DUMP-IT-NORMALLY. If it is, then we don't do anything. The
-;;; dumper will eventually get its hands on the object and use the
-;;; normal structure dumping noise on it.
-;;;
-;;; Otherwise, we bind *CONSTANTS-BEING-CREATED* and
-;;; *CONSTANTS-CREATED-SINCE- LAST-INIT* and compile the creation form
-;;; much the way LOAD-TIME-VALUE does. When this finishes, we tell the
-;;; dumper to use that result instead whenever it sees this constant.
-;;;
-;;; Now we try to compile the init form. We bind
-;;; *CONSTANTS-CREATED-SINCE- LAST-INIT* to NIL and compile the init
-;;; form (and any init forms that were added because of circularity
-;;; detection). If this works, great. If not, we add the init forms to
-;;; the init forms for the object that caused the problems and let it
-;;; deal with it.
-(defvar *constants-being-created* nil)
-(defvar *constants-created-since-last-init* nil)
-;;; FIXME: Shouldn't these^ variables be bound in LET forms?
-(defun emit-make-load-form (constant)
-  (aver (fasl-file-p *compile-object*))
-  (unless (or (fasl-constant-already-dumped constant *compile-object*)
-	      ;; KLUDGE: This special hack is because I was too lazy
-	      ;; to rework DEF!STRUCT so that the MAKE-LOAD-FORM
-	      ;; function of LAYOUT returns nontrivial forms when
-	      ;; building the cross-compiler but :IGNORE-IT when
-	      ;; cross-compiling or running under the target Lisp. --
-	      ;; WHN 19990914
-	      #+sb-xc-host (typep constant 'layout))
-    (let ((circular-ref (assoc constant *constants-being-created* :test #'eq)))
-      (when circular-ref
-	(when (find constant *constants-created-since-last-init* :test #'eq)
-	  (throw constant t))
-	(throw 'pending-init circular-ref)))
-    (multiple-value-bind (creation-form init-form)
-	(handler-case
-	    (sb!xc:make-load-form constant (make-null-lexenv))
-	  (error (condition)
-		 (compiler-error "(while making load form for ~S)~%~A"
-				 constant
-				 condition)))
-      (case creation-form
-	(:just-dump-it-normally
-	 (fasl-validate-structure constant *compile-object*)
-	 t)
-	(:ignore-it
-	 nil)
-	(t
-	 (compile-top-level-lambdas () t)
-	 (when (fasl-constant-already-dumped constant *compile-object*)
-	   (return-from emit-make-load-form nil))
-	 (let* ((name (let ((*print-level* 1) (*print-length* 2))
-			(with-output-to-string (stream)
-			  (write constant :stream stream))))
-		(info (if init-form
-			  (list constant name init-form)
-			  (list constant))))
-	   (let ((*constants-being-created*
-		  (cons info *constants-being-created*))
-		 (*constants-created-since-last-init*
-		  (cons constant *constants-created-since-last-init*)))
-	     (when
-		 (catch constant
-		   (fasl-note-handle-for-constant
-		    constant
-		    (compile-load-time-value
-		     creation-form
-		     (format nil "creation form for ~A" name))
-		    *compile-object*)
-		   nil)
-	       (compiler-error "circular references in creation form for ~S"
-			       constant)))
-	   (when (cdr info)
-	     (let* ((*constants-created-since-last-init* nil)
-		    (circular-ref
-		     (catch 'pending-init
-		       (loop for (name form) on (cdr info) by #'cddr
-			 collect name into names
-			 collect form into forms
-			 finally
-			 (compile-make-load-form-init-forms
-			  forms
-			  (format nil "init form~:[~;s~] for ~{~A~^, ~}"
-				  (cdr forms) names)))
-		       nil)))
-	       (when circular-ref
-		 (setf (cdr circular-ref)
-		       (append (cdr circular-ref) (cdr info))))))))))))
 
 ;;;; COMPILE-FILE
 
@@ -1256,7 +1081,7 @@
   (declare (type functional tll))
   (let ((object *compile-object*))
     (etypecase object
-      (fasl-file
+      (fasl-output
        (fasl-dump-top-level-lambda-call tll object))
       (core-object
        (core-call-top-level-lambda tll object))
@@ -1409,20 +1234,29 @@
 	 (*info-environment* (or *backend-info-environment*
 				 *info-environment*))
 	 (*gensym-counter* 0))
-    (with-compilation-values
-      (sb!xc:with-compilation-unit ()
-        (clear-stuff)
-
-	(process-sources info)
-
-	(finish-block-compilation)
-	(compile-top-level-lambdas () t)
-	(let ((object *compile-object*))
-	  (etypecase object
-	    (fasl-file (fasl-dump-source-info info object))
-	    (core-object (fix-core-source-info info object d-s-info))
-	    (null)))
-	nil))))
+    (handler-case
+	(with-compilation-values
+	 (sb!xc:with-compilation-unit ()
+	   (clear-stuff)
+
+	   (process-sources info)
+
+	   (finish-block-compilation)
+	   (compile-top-level-lambdas () t)
+	   (let ((object *compile-object*))
+	     (etypecase object
+	       (fasl-output (fasl-dump-source-info info object))
+	       (core-object (fix-core-source-info info object d-s-info))
+	       (null)))
+	   nil))
+      ;; Some errors are sufficiently bewildering that we just fail
+      ;; immediately, without trying to recover and compile more of
+      ;; the input file.
+      (input-error-in-compile-file (condition)
+       (format *error-output*
+	       "~@<compilation aborted because of input error: ~2I~_~A~:>"
+	       condition)
+       (values nil t t)))))
 
 ;;; Return a list of pathnames for the named files. All the files must
 ;;; exist.
@@ -1465,7 +1299,6 @@
 						   :print-weekday nil
 						   :print-timezone nil)))
   (values))
-
 (defun finish-error-output (source-info won)
   (declare (type source-info source-info))
   (compiler-mumble "~&; compilation ~:[aborted after~;finished in~] ~A~&"
@@ -1528,7 +1361,7 @@
 
   (unless (eq external-format :default)
     (error "Non-:DEFAULT EXTERNAL-FORMAT values are not supported."))
-  (let* ((fasl-file nil)
+  (let* ((fasl-output nil)
 	 (output-file-name nil)
 	 (compile-won nil)
 	 (warnings-p nil)
@@ -1550,18 +1383,18 @@
 	    (setq output-file-name
 		  (sb!xc:compile-file-pathname input-file
 					       :output-file output-file))
-	    (setq fasl-file
-		  (open-fasl-file output-file-name
-				  (namestring input-pathname)
-				  (eq *byte-compile* t))))
+	    (setq fasl-output
+		  (open-fasl-output output-file-name
+				    (namestring input-pathname)
+				    (eq *byte-compile* t))))
 	  (when trace-file
 	    (let* ((default-trace-file-pathname
 		     (make-pathname :type "trace" :defaults input-pathname))
 		   (trace-file-pathname
 		    (if (eql trace-file t)
 			default-trace-file-pathname
-			(make-pathname trace-file
-				       default-trace-file-pathname))))
+			(merge-pathnames trace-file
+					 default-trace-file-pathname))))
 	      (setf *compiler-trace-output*
 		    (open trace-file-pathname
 			  :if-exists :supersede
@@ -1569,7 +1402,7 @@
 
 	  (when sb!xc:*compile-verbose*
 	    (start-error-output source-info))
-	  (let ((*compile-object* fasl-file)
+	  (let ((*compile-object* fasl-output)
 		dummy)
 	    (multiple-value-setq (dummy warnings-p failure-p)
 	      (sub-compile-file source-info)))
@@ -1577,9 +1410,10 @@
 
       (close-source-info source-info)
 
-      (when fasl-file
-	(close-fasl-file fasl-file (not compile-won))
-	(setq output-file-name (pathname (fasl-file-stream fasl-file)))
+      (when fasl-output
+	(close-fasl-output fasl-output (not compile-won))
+	(setq output-file-name
+	      (pathname (fasl-output-stream fasl-output)))
 	(when (and compile-won sb!xc:*compile-verbose*)
 	  (compiler-mumble "~2&; ~A written~%" (namestring output-file-name))))
 
@@ -1605,8 +1439,7 @@
 ;;; default to the appropriate implementation-defined default type for
 ;;; compiled files.
 (defun cfp-output-file-default (input-file)
-  (let* ((defaults (merge-pathnames input-file
-				    *default-pathname-defaults*))
+  (let* ((defaults (merge-pathnames input-file *default-pathname-defaults*))
 	 (retyped (make-pathname :type *backend-fasl-file-type*
 				 :defaults defaults)))
     retyped))
@@ -1629,3 +1462,124 @@
   "Return a pathname describing what file COMPILE-FILE would write to given
    these arguments."
   (pathname output-file))
+
+;;;; MAKE-LOAD-FORM stuff
+
+;;; The entry point for MAKE-LOAD-FORM support. When IR1 conversion
+;;; finds a constant structure, it invokes this to arrange for proper
+;;; dumping. If it turns out that the constant has already been
+;;; dumped, then we don't need to do anything.
+;;;
+;;; If the constant hasn't been dumped, then we check to see whether
+;;; we are in the process of creating it. We detect this by
+;;; maintaining the special *CONSTANTS-BEING-CREATED* as a list of all
+;;; the constants we are in the process of creating. Actually, each
+;;; entry is a list of the constant and any init forms that need to be
+;;; processed on behalf of that constant.
+;;;
+;;; It's not necessarily an error for this to happen. If we are
+;;; processing the init form for some object that showed up *after*
+;;; the original reference to this constant, then we just need to
+;;; defer the processing of that init form. To detect this, we
+;;; maintain *CONSTANTS-CREATED-SINCE-LAST-INIT* as a list of the
+;;; constants created since the last time we started processing an
+;;; init form. If the constant passed to emit-make-load-form shows up
+;;; in this list, then there is a circular chain through creation
+;;; forms, which is an error.
+;;;
+;;; If there is some intervening init form, then we blow out of
+;;; processing it by throwing to the tag PENDING-INIT. The value we
+;;; throw is the entry from *CONSTANTS-BEING-CREATED*. This is so the
+;;; offending init form can be tacked onto the init forms for the
+;;; circular object.
+;;;
+;;; If the constant doesn't show up in *CONSTANTS-BEING-CREATED*, then
+;;; we have to create it. We call MAKE-LOAD-FORM and check to see
+;;; whether the creation form is the magic value
+;;; :JUST-DUMP-IT-NORMALLY. If it is, then we don't do anything. The
+;;; dumper will eventually get its hands on the object and use the
+;;; normal structure dumping noise on it.
+;;;
+;;; Otherwise, we bind *CONSTANTS-BEING-CREATED* and
+;;; *CONSTANTS-CREATED-SINCE- LAST-INIT* and compile the creation form
+;;; much the way LOAD-TIME-VALUE does. When this finishes, we tell the
+;;; dumper to use that result instead whenever it sees this constant.
+;;;
+;;; Now we try to compile the init form. We bind
+;;; *CONSTANTS-CREATED-SINCE-LAST-INIT* to NIL and compile the init
+;;; form (and any init forms that were added because of circularity
+;;; detection). If this works, great. If not, we add the init forms to
+;;; the init forms for the object that caused the problems and let it
+;;; deal with it.
+(defvar *constants-being-created* nil)
+(defvar *constants-created-since-last-init* nil)
+;;; FIXME: Shouldn't these^ variables be bound in LET forms?
+(defun emit-make-load-form (constant)
+  (aver (fasl-output-p *compile-object*))
+  (unless (or (fasl-constant-already-dumped-p constant *compile-object*)
+	      ;; KLUDGE: This special hack is because I was too lazy
+	      ;; to rework DEF!STRUCT so that the MAKE-LOAD-FORM
+	      ;; function of LAYOUT returns nontrivial forms when
+	      ;; building the cross-compiler but :IGNORE-IT when
+	      ;; cross-compiling or running under the target Lisp. --
+	      ;; WHN 19990914
+	      #+sb-xc-host (typep constant 'layout))
+    (let ((circular-ref (assoc constant *constants-being-created* :test #'eq)))
+      (when circular-ref
+	(when (find constant *constants-created-since-last-init* :test #'eq)
+	  (throw constant t))
+	(throw 'pending-init circular-ref)))
+    (multiple-value-bind (creation-form init-form)
+	(handler-case
+	    (sb!xc:make-load-form constant (make-null-lexenv))
+	  (error (condition)
+		 (compiler-error "(while making load form for ~S)~%~A"
+				 constant
+				 condition)))
+      (case creation-form
+	(:just-dump-it-normally
+	 (fasl-validate-structure constant *compile-object*)
+	 t)
+	(:ignore-it
+	 nil)
+	(t
+	 (compile-top-level-lambdas () t)
+	 (when (fasl-constant-already-dumped-p constant *compile-object*)
+	   (return-from emit-make-load-form nil))
+	 (let* ((name (let ((*print-level* 1) (*print-length* 2))
+			(with-output-to-string (stream)
+			  (write constant :stream stream))))
+		(info (if init-form
+			  (list constant name init-form)
+			  (list constant))))
+	   (let ((*constants-being-created*
+		  (cons info *constants-being-created*))
+		 (*constants-created-since-last-init*
+		  (cons constant *constants-created-since-last-init*)))
+	     (when
+		 (catch constant
+		   (fasl-note-handle-for-constant
+		    constant
+		    (compile-load-time-value
+		     creation-form
+		     (format nil "creation form for ~A" name))
+		    *compile-object*)
+		   nil)
+	       (compiler-error "circular references in creation form for ~S"
+			       constant)))
+	   (when (cdr info)
+	     (let* ((*constants-created-since-last-init* nil)
+		    (circular-ref
+		     (catch 'pending-init
+		       (loop for (name form) on (cdr info) by #'cddr
+			 collect name into names
+			 collect form into forms
+			 finally
+			 (compile-make-load-form-init-forms
+			  forms
+			  (format nil "init form~:[~;s~] for ~{~A~^, ~}"
+				  (cdr forms) names)))
+		       nil)))
+	       (when circular-ref
+		 (setf (cdr circular-ref)
+		       (append (cdr circular-ref) (cdr info))))))))))))