Function: cl--function-convert

cl--function-convert is a byte-compiled function defined in cl.el.gz.

Signature

(cl--function-convert F)

Documentation

Special macro-expander for special cases of (function F).

The two cases that are handled are:
- closure-conversion of lambda expressions for lexical-let.
- renaming of F when it's a function defined via cl-labels or labels.

Source Code

;; Defined in /usr/src/emacs/lisp/obsolete/cl.el.gz
(defun cl--function-convert (f)
  "Special macro-expander for special cases of (function F).
The two cases that are handled are:
- closure-conversion of lambda expressions for `lexical-let'.
- renaming of F when it's a function defined via `cl-labels' or `labels'."
  (require 'cl-macs)
  (declare-function cl--expr-contains-any "cl-macs" (x y))
  (declare-function cl--labels-convert "cl-macs" (f))
  (defvar cl--labels-convert-cache)
  (cond
   ;; ¡¡Big Ugly Hack!! We can't use a compiler-macro because those are checked
   ;; *after* handling `function', but we want to stop macroexpansion from
   ;; being applied infinitely, so we use a cache to return the exact `form'
   ;; being expanded even though we don't receive it.
   ((eq f (car cl--function-convert-cache)) (cdr cl--function-convert-cache))
   ((eq (car-safe f) 'lambda)
    (let ((body (mapcar (lambda (f)
                          (macroexpand-all f macroexpand-all-environment))
                        (cddr f))))
      (if (and cl-closure-vars
               (cl--expr-contains-any body cl-closure-vars))
          (let* ((new (mapcar #'cl-gensym cl-closure-vars))
                 (sub (cl-pairlis cl-closure-vars new)) (decls nil))
            (while (or (stringp (car body))
                       (eq (car-safe (car body)) 'interactive))
              (push (list 'quote (pop body)) decls))
            (put (car (last cl-closure-vars)) 'used t)
            `(list 'lambda '(&rest --cl-rest--)
                   ,@(cl-sublis sub (nreverse decls))
                   (list 'apply
                         (list 'function
                               #'(lambda ,(append new (cadr f))
                                   ,@(cl-sublis sub body)))
                         ,@(nconc (mapcar (lambda (x) `(list 'quote ,x))
                                          cl-closure-vars)
                                  '((quote --cl-rest--))))))
        (let* ((newf `(lambda ,(cadr f) ,@body))
               (res `(function ,newf)))
          (setq cl--function-convert-cache (cons newf res))
          res))))
   (t
    (cl--labels-convert f))))