X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=sidebyside;f=src%2Fpcl%2Ffngen.lisp;h=3631cb513fb31ca6148cf170d2f48d32e31e79da;hb=683874b497a99cd2c11b6c5d9b47e2785b1ede5f;hp=cda7f435f5b3df89a73e088f3464c52f775c75d3;hpb=cea4896b2482b7b2b429c1631d774b4cfbc0efba;p=sbcl.git

diff --git a/src/pcl/fngen.lisp b/src/pcl/fngen.lisp
index cda7f43..3631cb5 100644
--- a/src/pcl/fngen.lisp
+++ b/src/pcl/fngen.lisp
@@ -24,7 +24,7 @@
 (in-package "SB-PCL")
 
 ;;; GET-FUNCTION is the main user interface to this code. It is like
-;;; COMPILE-LAMBDA, only more efficient. It achieves this efficiency by
+;;; COMPILE, only more efficient. It achieves this efficiency by
 ;;; reducing the number of times that the compiler needs to be called.
 ;;; Calls to GET-FUNCTION in which the lambda forms differ only by constants
 ;;; can use the same piece of compiled code. (For example, dispatch dfuns and
@@ -39,14 +39,11 @@
 ;;; There are three internal functions which operate on the lambda argument
 ;;; to GET-FUNCTION:
 ;;;   compute-test converts the lambda into a key to be used for lookup,
-;;;   compute-code is used by get-new-function-generator-internal to
+;;;   compute-code is used by get-new-fun-generator-internal to
 ;;;		generate the actual lambda to be compiled, and
 ;;;   compute-constants is used to generate the argument list that is
 ;;;		to be passed to the compiled function.
 ;;;
-;;; Whether the returned function is actually compiled depends on whether
-;;; the compiler is present (see COMPILE-LAMBDA) and whether this shape of
-;;; code was precompiled.
 (defun get-function (lambda
 		      &optional (test-converter     #'default-test-converter)
 				(code-converter     #'default-code-converter)
@@ -116,17 +113,17 @@
 	 (fgen (lookup-fgen test)))
     (if fgen
 	(fgen-generator fgen)
-	(get-new-function-generator lambda test code-converter))))
+	(get-new-fun-generator lambda test code-converter))))
 
-(defun get-new-function-generator (lambda test code-converter)
+(defun get-new-fun-generator (lambda test code-converter)
   (multiple-value-bind (gensyms generator-lambda)
-      (get-new-function-generator-internal lambda code-converter)
-    (let* ((generator (compile-lambda generator-lambda))
+      (get-new-fun-generator-internal lambda code-converter)
+    (let* ((generator (compile nil generator-lambda))
 	   (fgen (make-fgen test gensyms generator generator-lambda nil)))
       (store-fgen fgen)
       generator)))
 
-(defun get-new-function-generator-internal (lambda code-converter)
+(defun get-new-fun-generator-internal (lambda code-converter)
   (multiple-value-bind (code gensyms)
       (compute-code lambda code-converter)
     (values gensyms `(lambda ,gensyms (function ,code)))))
@@ -158,40 +155,37 @@
 	      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))
 
 (defmacro precompile-function-generators (&optional system)
-  (let ((index -1))
-    `(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
-		     (make-top-level-form
-		      `(precompile-function-generators ,system ,(incf index))
-		      '(:load-toplevel)
-		      `(load-function-generator
-			',(fgen-test fgen)
-			',(fgen-gensyms fgen)
-			(function ,(fgen-generator-lambda fgen))
-			',(fgen-generator-lambda fgen)
-			',system)))))))))
+  `(progn
+    ,@(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)))