0.pre7.126:

[sbcl.git] / src / pcl / fngen.lisp

diff --git a/src/pcl/fngen.lisp b/src/pcl/fngen.lisp
index bdcb746..aec5b59 100644 (file)
--- a/src/pcl/fngen.lisp
+++ b/src/pcl/fngen.lisp
@@ -132,60 +132,60 @@
   (let ((*walk-form-expand-macros-p* t))
     (walk-form lambda
               nil
-              #'(lambda (f c e)
-                  (declare (ignore e))
-                  (if (neq c :eval)
-                      f
-                      (let ((converted (funcall test-converter f)))
-                        (values converted (neq converted f))))))))
+              (lambda (f c e)
+                (declare (ignore e))
+                (if (neq c :eval)
+                    f
+                    (let ((converted (funcall test-converter f)))
+                      (values converted (neq converted f))))))))
 
 (defun compute-code (lambda code-converter)
   (let ((*walk-form-expand-macros-p* t)
        (gensyms ()))
     (values (walk-form lambda
                       nil
-                      #'(lambda (f c e)
-                          (declare (ignore e))
-                          (if (neq c :eval)
-                              f
-                              (multiple-value-bind (converted gens)
-                                  (funcall code-converter f)
-                                (when gens (setq gensyms (append gensyms gens)))
-                                (values converted (neq converted f))))))
-             gensyms)))
+                      (lambda (f c e)
+                        (declare (ignore e))
+                        (if (neq c :eval)
+                            f
+                            (multiple-value-bind (converted gens)
+                                (funcall code-converter f)
+                              (when gens (setq gensyms (append gensyms gens)))
+                              (values converted (neq converted f))))))
+           gensyms)))
 
 (defun compute-constants (lambda constant-converter)
-  (let ((*walk-form-expand-macros-p* t)) ; doesn't matter here.
-    (macrolet ((appending ()
-                `(let ((result ()))
-                  (values #'(lambda (value) (setq result (append result value)))
-                   #'(lambda ()result)))))
-      (gathering1 (appending)
-                 (walk-form lambda
-                            nil
-                            #'(lambda (f c e)
-                                (declare (ignore e))
-                                (if (neq c :eval)
-                                    f
-                                    (let ((consts (funcall constant-converter f)))
-                                      (if consts
-                                          (progn (gather1 consts) (values f t))
-                                          f)))))))))
+  (let ((*walk-form-expand-macros-p* t) ; doesn't matter here.
+        collect)
+    (walk-form lambda
+               nil
+               (lambda (f c e)
+                (declare (ignore e))
+                (if (neq c :eval)
+                    f
+                    (let ((consts (funcall constant-converter f)))
+                      (if consts
+                          (progn
+                            (setq collect (nconc collect consts))
+                            (values f t))
+                          f)))))
+    collect))
 \f
 (defmacro precompile-function-generators (&optional system)
   `(progn
-    ,@(gathering1 (collecting)
-                  (dolist (fgen *fgens*)
-                    (when (or (null (fgen-system fgen))
-                              (eq (fgen-system fgen) system))
-                      (when system (setf (svref fgen 4) system))
-                      (gather1
-                       `(load-function-generator
-                         ',(fgen-test fgen)
-                         ',(fgen-gensyms fgen)
-                         (function ,(fgen-generator-lambda fgen))
-                         ',(fgen-generator-lambda fgen)
-                         ',system)))))))
+    ,@(let (collect)
+        (dolist (fgen *fgens*)
+          (when (or (null (fgen-system fgen))
+                    (eq (fgen-system fgen) system))
+            (when system (setf (svref fgen 4) system))
+            (push `(load-function-generator
+                    ',(fgen-test fgen)
+                    ',(fgen-gensyms fgen)
+                    (function ,(fgen-generator-lambda fgen))
+                    ',(fgen-generator-lambda fgen)
+                    ',system)
+                  collect)))
+        (nreverse collect))))
 
 (defun load-function-generator (test gensyms generator generator-lambda system)
   (store-fgen (make-fgen test gensyms generator generator-lambda system)))