Function: cconv-convert
cconv-convert is a byte-compiled function defined in cconv.el.gz.
Signature
(cconv-convert FORM ENV EXTEND)
Documentation
Return FORM with all its lambdas changed so they are closed.
ENV is a lexical environment mapping variables to the expression
used to get its value. This is used for variables that are copied into
closures, moved into cons cells, ...
ENV is a list where each entry takes the shape either:
(VAR . (car-safe EXP)): VAR has been moved into the car of a cons-cell, and EXP
is an expression that evaluates to this cons-cell.
(VAR . (internal-get-closed-var N)): VAR has been copied into the closure
environment's Nth slot.
(VAR . (apply-partially F ARG1 ARG2 ..)): VAR has been λ-lifted and takes
additional arguments ARGs.
(VAR . nil): VAR is accessed normally. This is the same as VAR
being absent from ENV, but an explicit nil entry is useful
for shadowing VAR for a specific scope.
EXTEND is a list of variables which might need to be accessed even from places
where they are shadowed, because some part of ENV causes them to be used at
places where they originally did not directly appear.
Source Code
;; Defined in /usr/src/emacs/lisp/emacs-lisp/cconv.el.gz
(defun cconv-convert (form env extend)
;; This function actually rewrites the tree.
"Return FORM with all its lambdas changed so they are closed.
ENV is a lexical environment mapping variables to the expression
used to get its value. This is used for variables that are copied into
closures, moved into cons cells, ...
ENV is a list where each entry takes the shape either:
(VAR . (car-safe EXP)): VAR has been moved into the car of a cons-cell, and EXP
is an expression that evaluates to this cons-cell.
(VAR . (internal-get-closed-var N)): VAR has been copied into the closure
environment's Nth slot.
(VAR . (apply-partially F ARG1 ARG2 ..)): VAR has been λ-lifted and takes
additional arguments ARGs.
(VAR . nil): VAR is accessed normally. This is the same as VAR
being absent from ENV, but an explicit nil entry is useful
for shadowing VAR for a specific scope.
EXTEND is a list of variables which might need to be accessed even from places
where they are shadowed, because some part of ENV causes them to be used at
places where they originally did not directly appear."
(cl-assert (not (delq nil (mapcar (lambda (mapping)
(if (eq (cadr mapping) 'apply-partially)
(cconv--set-diff (cdr (cddr mapping))
extend)))
env))))
;; What's the difference between fvrs and envs?
;; Suppose that we have the code
;; (lambda (..) fvr (let ((fvr 1)) (+ fvr 1)))
;; only the first occurrence of fvr should be replaced by
;; (aref env ...).
;; So initially envs and fvrs are the same thing, but when we descend to
;; the 'let, we delete fvr from fvrs. Why we don't delete fvr from envs?
;; Because in envs the order of variables is important. We use this list
;; to find the number of a specific variable in the environment vector,
;; so we never touch it(unless we enter to the other closure).
;;(if (listp form) (print (car form)) form)
(pcase form
(`(,(and letsym (or 'let* 'let)) ,binders . ,body)
; let and let* special forms
(let ((binders-new '())
(new-env env)
(new-extend extend))
(dolist (binder binders)
(let* ((value nil)
(var (if (not (consp binder))
(prog1 binder (setq binder (list binder)))
(when (cddr binder)
(byte-compile-warn
"Malformed `%S' binding: %S"
letsym binder))
(setq value (cadr binder))
(car binder))))
(cond
;; Ignore bindings without a valid name.
((not (symbolp var))
(byte-compile-warn "attempt to let-bind nonvariable `%S'" var))
((or (booleanp var) (keywordp var))
(byte-compile-warn "attempt to let-bind constant `%S'" var))
(t
(let ((new-val
(pcase (cconv--var-classification binder form)
;; Check if var is a candidate for lambda lifting.
((and :lambda-candidate
(guard
(progn
(cl-assert (and (eq (car value) 'function)
(eq (car (cadr value)) 'lambda)))
(cl-assert (equal (cddr (cadr value))
(caar cconv-freevars-alist)))
;; Peek at the freevars to decide whether
;; to λ-lift.
(let* ((fvs (cdr (car cconv-freevars-alist)))
(fun (cadr value))
(funargs (cadr fun))
(funcvars (append fvs funargs)))
; lambda lifting condition
(and fvs (>= cconv-liftwhen
(length funcvars)))))))
; Lift.
(let* ((fvs (cdr (pop cconv-freevars-alist)))
(fun (cadr value))
(funargs (cadr fun))
(funcvars (append fvs funargs))
(funcbody (cddr fun))
(funcbody-env ()))
(push `(,var . (apply-partially ,var . ,fvs)) new-env)
(dolist (fv fvs)
(cl-pushnew fv new-extend)
(if (and (eq 'car-safe (car-safe
(cdr (assq fv env))))
(not (memq fv funargs)))
(push `(,fv . (car-safe ,fv)) funcbody-env)))
`(function (lambda ,funcvars .
,(cconv--convert-funcbody
funargs funcbody funcbody-env value)))))
;; Check if it needs to be turned into a "ref-cell".
(:captured+mutated
;; Declared variable is mutated and captured.
(push `(,var . (car-safe ,var)) new-env)
`(list ,(cconv-convert value env extend)))
;; Check if it needs to be turned into a "ref-cell".
(:unused
;; Declared variable is unused.
(if (assq var new-env)
(push `(,var) new-env)) ;FIXME:Needed?
(let ((newval
`(ignore ,(cconv-convert value env extend)))
(msg (cconv--warn-unused-msg var "variable")))
(if (null msg) newval
(macroexp--warn-wrap msg newval 'lexical))))
;; Normal default case.
(_
(if (assq var new-env) (push `(,var) new-env))
(cconv-convert value env extend)))))
(when (and (eq letsym 'let*) (memq var new-extend))
;; One of the lambda-lifted vars is shadowed, so add
;; a reference to the outside binding and arrange to use
;; that reference.
(let ((closedsym (make-symbol (format "closed-%s" var))))
(setq new-env (cconv--remap-llv new-env var closedsym))
(setq new-extend (cons closedsym (remq var new-extend)))
(push `(,closedsym ,var) binders-new)))
;; We push the element after redefined free variables are
;; processed. This is important to avoid the bug when free
;; variable and the function have the same name.
(push (list var new-val) binders-new)
(when (eq letsym 'let*)
(setq env new-env)
(setq extend new-extend))))))
) ; end of dolist over binders
(when (not (eq letsym 'let*))
;; We can't do the cconv--remap-llv at the same place for let and
;; let* because in the case of `let', the shadowing may occur
;; before we know that the var will be in `new-extend' (bug#24171).
(dolist (binder binders-new)
(when (memq (car-safe binder) new-extend)
;; One of the lambda-lifted vars is shadowed, so add
;; a reference to the outside binding and arrange to use
;; that reference.
(let* ((var (car-safe binder))
(closedsym (make-symbol (format "closed-%s" var))))
(setq new-env (cconv--remap-llv new-env var closedsym))
(setq new-extend (cons closedsym (remq var new-extend)))
(push `(,closedsym ,var) binders-new)))))
`(,letsym ,(nreverse binders-new)
. ,(mapcar (lambda (form)
(cconv-convert
form new-env new-extend))
body))))
;end of let let* forms
; first element is lambda expression
(`(,(and `(lambda . ,_) fun) . ,args)
;; FIXME: it's silly to create a closure just to call it.
;; Running byte-optimize-form earlier will resolve this.
`(funcall
,(cconv-convert `(function ,fun) env extend)
,@(mapcar (lambda (form)
(cconv-convert form env extend))
args)))
(`(cond . ,cond-forms) ; cond special form
`(cond . ,(mapcar (lambda (branch)
(mapcar (lambda (form)
(cconv-convert form env extend))
branch))
cond-forms)))
(`(function (lambda ,args . ,body) . ,_)
(let ((docstring (if (eq :documentation (car-safe (car body)))
(cconv-convert (cadr (pop body)) env extend))))
(cconv--convert-function args body env form docstring)))
(`(internal-make-closure . ,_)
(byte-compile-report-error
"Internal error in compiler: cconv called twice?"))
(`(quote . ,_) form)
(`(function . ,_) form)
;defconst, defvar
(`(,(and sym (or 'defconst 'defvar)) ,definedsymbol . ,forms)
`(,sym ,definedsymbol
. ,(when (consp forms)
(cons (cconv-convert (car forms) env extend)
;; The rest (i.e. docstring, of any) is not evaluated,
;; and may be an invalid expression (e.g. ($# . 678)).
(cdr forms)))))
; condition-case
(`(condition-case ,var ,protected-form . ,handlers)
(let* ((class (and var (cconv--var-classification (list var) form)))
(newenv
(cond ((eq class :captured+mutated)
(cons `(,var . (car-safe ,var)) env))
((assq var env) (cons `(,var) env))
(t env)))
(msg (when (eq class :unused)
(cconv--warn-unused-msg var "variable")))
(newprotform (cconv-convert protected-form env extend)))
`(condition-case ,var
,(if msg
(macroexp--warn-wrap msg newprotform 'lexical)
newprotform)
,@(mapcar
(lambda (handler)
`(,(car handler)
,@(let ((body
(mapcar (lambda (form)
(cconv-convert form newenv extend))
(cdr handler))))
(if (not (eq class :captured+mutated))
body
`((let ((,var (list ,var))) ,@body))))))
handlers))))
(`(unwind-protect ,form . ,body)
`(unwind-protect ,(cconv-convert form env extend)
:fun-body ,(cconv--convert-function () body env form)))
(`(setq . ,forms) ; setq special form
(if (= (logand (length forms) 1) 1)
;; With an odd number of args, let bytecomp.el handle the error.
form
(let ((prognlist ()))
(while forms
(let* ((sym (pop forms))
(sym-new (or (cdr (assq sym env)) sym))
(value (cconv-convert (pop forms) env extend)))
(push (pcase sym-new
((pred symbolp) `(setq ,sym-new ,value))
(`(car-safe ,iexp) `(setcar ,iexp ,value))
;; This "should never happen", but for variables which are
;; mutated+captured+unused, we may end up trying to `setq'
;; on a closed-over variable, so just drop the setq.
(_ ;; (byte-compile-report-error
;; (format "Internal error in cconv of (setq %s ..)"
;; sym-new))
value))
prognlist)))
(if (cdr prognlist)
`(progn . ,(nreverse prognlist))
(car prognlist)))))
(`(,(and (or 'funcall 'apply) callsym) ,fun . ,args)
;; These are not special forms but we treat them separately for the needs
;; of lambda lifting.
(let ((mapping (cdr (assq fun env))))
(pcase mapping
(`(apply-partially ,_ . ,(and fvs `(,_ . ,_)))
(cl-assert (eq (cadr mapping) fun))
`(,callsym ,fun
,@(mapcar (lambda (fv)
(let ((exp (or (cdr (assq fv env)) fv)))
(pcase exp
(`(car-safe ,iexp . ,_) iexp)
(_ exp))))
fvs)
,@(mapcar (lambda (arg)
(cconv-convert arg env extend))
args)))
(_ `(,callsym ,@(mapcar (lambda (arg)
(cconv-convert arg env extend))
(cons fun args)))))))
(`(interactive . ,forms)
`(interactive . ,(mapcar (lambda (form)
(cconv-convert form nil nil))
forms)))
(`(declare . ,_) form) ;The args don't contain code.
(`(,func . ,forms)
;; First element is function or whatever function-like forms are: or, and,
;; if, catch, progn, prog1, while, until
`(,func . ,(mapcar (lambda (form)
(cconv-convert form env extend))
forms)))
(_ (or (cdr (assq form env)) form))))