;;; There are three internal functions which operate on the lambda argument
;;; to GET-FUN:
;;; COMPUTE-TEST converts the lambda into a key to be used for lookup,
;;; There are three internal functions which operate on the lambda argument
;;; to GET-FUN:
;;; COMPUTE-TEST converts the lambda into a key to be used for lookup,
-;;; COMPUTE-CODE is used by get-new-fun-generator-internal to
-;;; generate the actual lambda to be compiled, and
+;;; COMPUTE-CODE is used by GET-NEW-FUN-GENERATOR-INTERNAL to
+;;; generate the actual lambda to be compiled, and
- (test-converter #'default-test-converter)
- (code-converter #'default-code-converter)
- (constant-converter #'default-constant-converter))
+ (test-converter #'default-test-converter)
+ (code-converter #'default-code-converter)
+ (constant-converter #'default-constant-converter))
- (test-converter #'default-test-converter)
- (code-converter #'default-code-converter)
- (constant-converter #'default-constant-converter))
+ (test-converter #'default-test-converter)
+ (code-converter #'default-code-converter)
+ (constant-converter #'default-constant-converter))
- (get-fun-generator lambda test-converter code-converter))
- (compute-constants lambda constant-converter)))
+ (get-fun-generator lambda test-converter code-converter))
+ (compute-constants lambda constant-converter)))
- (setf (svref old 2) (fgen-generator fgen)
- (svref old 4) (or (svref old 4)
- (fgen-system fgen)))
- (setq *fgens* (nconc *fgens* (list fgen))))))
+ (setf (svref old 2) (fgen-generator fgen)
+ (svref old 4) (or (svref old 4)
+ (fgen-system fgen)))
+ (setq *fgens* (nconc *fgens* (list fgen))))))
-(defun fgen-test (fgen) (svref fgen 0))
-(defun fgen-gensyms (fgen) (svref fgen 1))
-(defun fgen-generator (fgen) (svref fgen 2))
+(defun fgen-test (fgen) (svref fgen 0))
+(defun fgen-gensyms (fgen) (svref fgen 1))
+(defun fgen-generator (fgen) (svref fgen 2))
\f
(defun get-fun-generator (lambda test-converter code-converter)
(let* ((test (compute-test lambda test-converter))
\f
(defun get-fun-generator (lambda test-converter code-converter)
(let* ((test (compute-test lambda test-converter))
(defun get-new-fun-generator (lambda test code-converter)
(multiple-value-bind (gensyms generator-lambda)
(get-new-fun-generator-internal lambda code-converter)
(let* ((generator (compile nil generator-lambda))
(defun get-new-fun-generator (lambda test code-converter)
(multiple-value-bind (gensyms generator-lambda)
(get-new-fun-generator-internal lambda code-converter)
(let* ((generator (compile nil generator-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)))
+ 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)))
(defun compute-constants (lambda constant-converter)
(let ((*walk-form-expand-macros-p* t) ; doesn't matter here.
(defun compute-constants (lambda constant-converter)
(let ((*walk-form-expand-macros-p* t) ; doesn't matter here.
(defun load-function-generator (test gensyms generator generator-lambda system)
(store-fgen (make-fgen test gensyms generator generator-lambda system)))
(defun load-function-generator (test gensyms generator generator-lambda system)
(store-fgen (make-fgen test gensyms generator generator-lambda system)))