1 ;;; cconv.el --- Closure conversion for statically scoped Emacs lisp. -*- lexical-binding: t; coding: utf-8 -*-
3 ;; Copyright (C) 2011 Free Software Foundation, Inc.
5 ;; Author: Igor Kuzmin <kzuminig@iro.umontreal.ca>
10 ;; This file is part of GNU Emacs.
12 ;; GNU Emacs is free software: you can redistribute it and/or modify
13 ;; it under the terms of the GNU General Public License as published by
14 ;; the Free Software Foundation, either version 3 of the License, or
15 ;; (at your option) any later version.
17 ;; GNU Emacs is distributed in the hope that it will be useful,
18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20 ;; GNU General Public License for more details.
22 ;; You should have received a copy of the GNU General Public License
23 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
27 ;; This takes a piece of Elisp code, and eliminates all free variables from
28 ;; lambda expressions. The user entry points are cconv-closure-convert and
29 ;; cconv-closure-convert-toplevel(for toplevel forms).
30 ;; All macros should be expanded beforehand.
32 ;; Here is a brief explanation how this code works.
33 ;; Firstly, we analyse the tree by calling cconv-analyse-form.
34 ;; This function finds all mutated variables, all functions that are suitable
35 ;; for lambda lifting and all variables captured by closure. It passes the tree
36 ;; once, returning a list of three lists.
38 ;; Then we calculate the intersection of first and third lists returned by
39 ;; cconv-analyse form to find all mutated variables that are captured by
42 ;; Armed with this data, we call cconv-closure-convert-rec, that rewrites the
43 ;; tree recursivly, lifting lambdas where possible, building closures where it
44 ;; is needed and eliminating mutable variables used in closure.
46 ;; We do following replacements :
47 ;; (lambda (v1 ...) ... fv1 fv2 ...) => (lambda (v1 ... fv1 fv2 ) ... fv1 fv2 .)
48 ;; if the function is suitable for lambda lifting (if all calls are known)
50 ;; (lambda (v0 ...) ... fv0 .. fv1 ...) =>
51 ;; (internal-make-closure (v0 ...) (fv1 ...)
52 ;; ... (internal-get-closed-var 0) ... (internal-get-closed-var 1) ...)
54 ;; If the function has no free variables, we don't do anything.
56 ;; If a variable is mutated (updated by setq), and it is used in a closure
57 ;; we wrap its definition with list: (list val) and we also replace
58 ;; var => (car var) wherever this variable is used, and also
59 ;; (setq var value) => (setcar var value) where it is updated.
61 ;; If defun argument is closure mutable, we letbind it and wrap it's
62 ;; definition with list.
63 ;; (defun foo (... mutable-arg ...) ...) =>
64 ;; (defun foo (... m-arg ...) (let ((m-arg (list m-arg))) ...))
69 ;; - byte-optimize-form should be applied before cconv.
70 ;; - maybe unify byte-optimize and compiler-macros.
71 ;; - canonize code in macro-expand so we don't have to handle (let (var) body)
72 ;; and other oddities.
73 ;; - new byte codes for unwind-protect, catch, and condition-case so that
74 ;; closures aren't needed at all.
75 ;; - a reference to a var that is known statically to always hold a constant
76 ;; should be turned into a byte-constant rather than a byte-stack-ref.
77 ;; Hmm... right, that's called constant propagation and could be done here,
78 ;; but when that constant is a function, we have to be careful to make sure
79 ;; the bytecomp only compiles it once.
80 ;; - Since we know here when a variable is not mutated, we could pass that
81 ;; info to the byte-compiler, e.g. by using a new `immutable-let'.
82 ;; - add tail-calls to bytecode.c and the byte compiler.
83 ;; - call known non-escaping functions with gotos rather than `call'.
84 ;; - optimize mapcar to a while loop.
86 ;; (defmacro dlet (binders &rest body)
87 ;; ;; Works in both lexical and non-lexical mode.
89 ;; ,@(mapcar (lambda (binder)
90 ;; `(defvar ,(if (consp binder) (car binder) binder)))
92 ;; (let ,binders ,@body)))
94 ;; (defmacro llet (binders &rest body)
95 ;; ;; Only works in lexical-binding mode.
97 ;; (lambda ,(mapcar (lambda (binder) (if (consp binder) (car binder) binder))
100 ;; ,@(mapcar (lambda (binder) (if (consp binder) (cadr binder)))
103 ;; (defmacro letrec (binders &rest body)
104 ;; ;; Only useful in lexical-binding mode.
105 ;; ;; As a special-form, we could implement it more efficiently (and cleanly,
106 ;; ;; making the vars actually unbound during evaluation of the binders).
107 ;; `(let ,(mapcar (lambda (binder) (if (consp binder) (car binder) binder))
109 ;; ,@(delq nil (mapcar (lambda (binder) (if (consp binder) `(setq ,@binder)))
113 (eval-when-compile (require 'cl
))
115 (defconst cconv-liftwhen
6
116 "Try to do lambda lifting if the number of arguments + free variables
117 is less than this number.")
118 ;; List of all the variables that are both captured by a closure
119 ;; and mutated. Each entry in the list takes the form
120 ;; (BINDER . PARENTFORM) where BINDER is the (VAR VAL) that introduces the
121 ;; variable (or is just (VAR) for variables not introduced by let).
122 (defvar cconv-captured
+mutated
)
124 ;; List of candidates for lambda lifting.
125 ;; Each candidate has the form (BINDER . PARENTFORM). A candidate
126 ;; is a variable that is only passed to `funcall' or `apply'.
127 (defvar cconv-lambda-candidates
)
129 ;; Alist associating to each function body the list of its free variables.
130 (defvar cconv-freevars-alist
)
133 (defun cconv-closure-convert (form)
134 "Main entry point for closure conversion.
135 -- FORM is a piece of Elisp code after macroexpansion.
136 -- TOPLEVEL(optional) is a boolean variable, true if we are at the root of AST
138 Returns a form where all lambdas don't have any free variables."
139 ;; (message "Entering cconv-closure-convert...")
140 (let ((cconv-freevars-alist '())
141 (cconv-lambda-candidates '())
142 (cconv-captured+mutated
'()))
143 ;; Analyse form - fill these variables with new information.
144 (cconv-analyse-form form
'())
145 (setq cconv-freevars-alist
(nreverse cconv-freevars-alist
))
146 (cconv-convert form nil nil
))) ; Env initially empty.
148 (defconst cconv--dummy-var
(make-symbol "ignored"))
150 (defun cconv--set-diff (s1 s2
)
151 "Return elements of set S1 that are not in set S2."
154 (unless (memq x s2
) (push x res
)))
157 (defun cconv--set-diff-map (s m
)
158 "Return elements of set S that are not in Dom(M)."
161 (unless (assq x m
) (push x res
)))
164 (defun cconv--map-diff (m1 m2
)
165 "Return the submap of map M1 that has Dom(M2) removed."
168 (unless (assq (car x
) m2
) (push x res
)))
171 (defun cconv--map-diff-elem (m x
)
172 "Return the map M minus any mapping for X."
173 ;; Here we assume that X appears at most once in M.
174 (let* ((b (assq x m
))
175 (res (if b
(remq b m
) m
)))
176 (assert (null (assq x res
))) ;; Check the assumption was warranted.
179 (defun cconv--map-diff-set (m s
)
180 "Return the map M minus any mapping for elements of S."
181 ;; Here we assume that X appears at most once in M.
184 (unless (memq (car b
) s
) (push b res
)))
187 (defun cconv--convert-function (args body env parentform
)
188 (assert (equal body
(caar cconv-freevars-alist
)))
189 (let* ((fvs (cdr (pop cconv-freevars-alist
)))
195 ;; Build the "formal and actual envs" for the closure-converted function.
197 (let ((exp (or (cdr (assq fv env
)) fv
)))
199 ;; If `fv' is a variable that's wrapped in a cons-cell,
200 ;; we want to put the cons-cell itself in the closure,
201 ;; rather than just a copy of its current content.
204 (push `(,fv .
(car (internal-get-closed-var ,i
))) new-env
))
207 (push `(,fv .
(internal-get-closed-var ,i
)) new-env
))))
209 (setq envector
(nreverse envector
))
210 (setq new-env
(nreverse new-env
))
213 (if (not (member (cons (list arg
) parentform
) cconv-captured
+mutated
))
214 (if (assq arg new-env
) (push `(,arg
) new-env
))
215 (push `(,arg .
(car ,arg
)) new-env
)
216 (push `(,arg
(list ,arg
)) letbind
)))
218 (setq body-new
(mapcar (lambda (form)
219 (cconv-convert form new-env nil
))
223 (let ((special-forms '()))
224 ;; Keep special forms at the beginning of the body.
225 (while (or (stringp (car body-new
)) ;docstring.
226 (memq (car-safe (car body-new
)) '(interactive declare
)))
227 (push (pop body-new
) special-forms
))
229 `(,@(nreverse special-forms
) (let ,letbind .
,body-new
)))))
232 ((null envector
) ;if no freevars - do nothing
233 `(function (lambda ,args .
,body-new
)))
235 `(internal-make-closure
236 ,args
,envector .
,body-new
)))))
238 (defun cconv-convert (form env extend
)
239 ;; This function actually rewrites the tree.
240 "Return FORM with all its lambdas changed so they are closed.
241 ENV is a lexical environment mapping variables to the expression
242 used to get its value. This is used for variables that are copied into
243 closures, moved into cons cells, ...
244 ENV is a list where each entry takes the shape either:
245 (VAR . (car EXP)): VAR has been moved into the car of a cons-cell, and EXP
246 is an expression that evaluates to this cons-cell.
247 (VAR . (internal-get-closed-var N)): VAR has been copied into the closure
248 environment's Nth slot.
249 (VAR . (apply-partially F ARG1 ARG2 ..)): VAR has been λ-lifted and takes
250 additional arguments ARGs.
251 EXTEND is a list of variables which might need to be accessed even from places
252 where they are shadowed, because some part of ENV causes them to be used at
253 places where they originally did not directly appear."
254 (assert (not (delq nil
(mapcar (lambda (mapping)
255 (if (eq (cadr mapping
) 'apply-partially
)
256 (cconv--set-diff (cdr (cddr mapping
))
260 ;; What's the difference between fvrs and envs?
261 ;; Suppose that we have the code
262 ;; (lambda (..) fvr (let ((fvr 1)) (+ fvr 1)))
263 ;; only the first occurrence of fvr should be replaced by
265 ;; So initially envs and fvrs are the same thing, but when we descend to
266 ;; the 'let, we delete fvr from fvrs. Why we don't delete fvr from envs?
267 ;; Because in envs the order of variables is important. We use this list
268 ;; to find the number of a specific variable in the environment vector,
269 ;; so we never touch it(unless we enter to the other closure).
270 ;;(if (listp form) (print (car form)) form)
272 (`(,(and letsym
(or `let
* `let
)) ,binders .
,body
)
274 ; let and let* special forms
275 (let ((binders-new '())
279 (dolist (binder binders
)
281 (var (if (not (consp binder
))
282 (prog1 binder
(setq binder
(list binder
)))
283 (setq value
(cadr binder
))
287 ;; Check if var is a candidate for lambda lifting.
288 ((and (member (cons binder form
) cconv-lambda-candidates
)
290 (assert (and (eq (car value
) 'function
)
291 (eq (car (cadr value
)) 'lambda
)))
292 (assert (equal (cddr (cadr value
))
293 (caar cconv-freevars-alist
)))
294 ;; Peek at the freevars to decide whether to λ-lift.
295 (let* ((fvs (cdr (car cconv-freevars-alist
)))
298 (funcvars (append fvs funargs
)))
299 ; lambda lifting condition
300 (and fvs
(>= cconv-liftwhen
(length funcvars
))))))
302 (let* ((fvs (cdr (pop cconv-freevars-alist
)))
305 (funcvars (append fvs funargs
))
306 (funcbody (cddr fun
))
308 (push `(,var .
(apply-partially ,var .
,fvs
)) new-env
)
310 (pushnew fv new-extend
)
311 (if (and (eq 'car
(car-safe (cdr (assq fv env
))))
312 (not (memq fv funargs
)))
313 (push `(,fv .
(car ,fv
)) funcbody-env
)))
314 `(function (lambda ,funcvars .
315 ,(mapcar (lambda (form)
317 form funcbody-env nil
))
320 ;; Check if it needs to be turned into a "ref-cell".
321 ((member (cons binder form
) cconv-captured
+mutated
)
322 ;; Declared variable is mutated and captured.
323 (push `(,var .
(car ,var
)) new-env
)
324 `(list ,(cconv-convert value env extend
)))
326 ;; Normal default case.
328 (if (assq var new-env
) (push `(,var
) new-env
))
329 (cconv-convert value env extend
)))))
331 ;; The piece of code below letbinds free variables of a λ-lifted
332 ;; function if they are redefined in this let, example:
333 ;; (let* ((fun (lambda (x) (+ x y))) (y 1)) (funcall fun 1))
334 ;; Here we can not pass y as parameter because it is redefined.
335 ;; So we add a (closed-y y) declaration. We do that even if the
336 ;; function is not used inside this let(*). The reason why we
337 ;; ignore this case is that we can't "look forward" to see if the
338 ;; function is called there or not. To treat this case better we'd
339 ;; need to traverse the tree one more time to collect this data, and
340 ;; I think that it's not worth it.
341 (when (memq var new-extend
)
343 (make-symbol (concat "closed-" (symbol-name var
)))))
345 (mapcar (lambda (mapping)
346 (if (not (eq (cadr mapping
) 'apply-partially
))
348 (assert (eq (car mapping
) (nth 2 mapping
)))
352 (mapcar (lambda (arg)
355 (nthcdr 3 mapping
)))))
357 (setq new-extend
(remq var new-extend
))
358 (push closedsym new-extend
)
359 (push `(,closedsym
,var
) binders-new
)))
361 ;; We push the element after redefined free variables are
362 ;; processed. This is important to avoid the bug when free
363 ;; variable and the function have the same name.
364 (push (list var new-val
) binders-new
)
366 (when (eq letsym
'let
*)
368 (setq extend new-extend
))
369 )) ; end of dolist over binders
371 `(,letsym
,(nreverse binders-new
)
372 .
,(mapcar (lambda (form)
374 form new-env new-extend
))
376 ;end of let let* forms
378 ; first element is lambda expression
379 (`(,(and `(lambda .
,_
) fun
) .
,args
)
380 ;; FIXME: it's silly to create a closure just to call it.
382 ,(cconv-convert `(function ,fun
) env extend
)
383 ,@(mapcar (lambda (form)
384 (cconv-convert form env extend
))
387 (`(cond .
,cond-forms
) ; cond special form
388 `(cond .
,(mapcar (lambda (branch)
389 (mapcar (lambda (form)
390 (cconv-convert form env extend
))
394 (`(function (lambda ,args .
,body
) .
,_
)
395 (cconv--convert-function args body env form
))
397 (`(internal-make-closure .
,_
)
398 (byte-compile-report-error
399 "Internal error in compiler: cconv called twice?"))
402 (`(function .
,_
) form
)
405 (`(,(and sym
(or `defconst
`defvar
)) ,definedsymbol .
,forms
)
406 `(,sym
,definedsymbol
407 .
,(mapcar (lambda (form) (cconv-convert form env extend
))
411 (`(,(and sym
(or `defun
`defmacro
))
413 (assert (equal body
(caar cconv-freevars-alist
)))
414 (assert (null (cdar cconv-freevars-alist
)))
416 (let ((new (cconv--convert-function args body env form
)))
418 (`(function (lambda ,newargs .
,new-body
))
419 (assert (equal args newargs
))
420 `(,sym
,func
,args .
,new-body
))
421 (t (byte-compile-report-error
422 (format "Internal error in cconv of (%s %s ...)" sym func
))))))
425 (`(condition-case ,var
,protected-form .
,handlers
)
426 (let ((newform (cconv--convert-function
427 () (list protected-form
) env form
)))
428 `(condition-case :fun-body
,newform
429 ,@(mapcar (lambda (handler)
431 (cconv--convert-function
432 (list (or var cconv--dummy-var
))
433 (cdr handler
) env form
)))
436 (`(,(and head
(or `catch
`unwind-protect
)) ,form .
,body
)
437 `(,head
,(cconv-convert form env extend
)
438 :fun-body
,(cconv--convert-function () body env form
)))
440 (`(track-mouse .
,body
)
442 :fun-body
,(cconv--convert-function () body env form
)))
444 (`(setq .
,forms
) ; setq special form
445 (let ((prognlist ()))
447 (let* ((sym (pop forms
))
448 (sym-new (or (cdr (assq sym env
)) sym
))
449 (value (cconv-convert (pop forms
) env extend
)))
451 ((pred symbolp
) `(setq ,sym-new
,value
))
452 (`(car ,iexp
) `(setcar ,iexp
,value
))
453 ;; This "should never happen", but for variables which are
454 ;; mutated+captured+unused, we may end up trying to `setq'
455 ;; on a closed-over variable, so just drop the setq.
456 (_ ;; (byte-compile-report-error
457 ;; (format "Internal error in cconv of (setq %s ..)"
462 `(progn .
,(nreverse prognlist
))
465 (`(,(and (or `funcall
`apply
) callsym
) ,fun .
,args
)
466 ;; These are not special forms but we treat them separately for the needs
467 ;; of lambda lifting.
468 (let ((mapping (cdr (assq fun env
))))
470 (`(apply-partially ,_ .
,(and fvs
`(,_ .
,_
)))
471 (assert (eq (cadr mapping
) fun
))
473 ,@(mapcar (lambda (fv)
474 (let ((exp (or (cdr (assq fv env
)) fv
)))
476 (`(car ,iexp .
,_
) iexp
)
479 ,@(mapcar (lambda (arg)
480 (cconv-convert arg env extend
))
482 (_ `(,callsym
,@(mapcar (lambda (arg)
483 (cconv-convert arg env extend
))
484 (cons fun args
)))))))
486 (`(interactive .
,forms
)
487 `(interactive .
,(mapcar (lambda (form)
488 (cconv-convert form nil nil
))
491 (`(declare .
,_
) form
) ;The args don't contain code.
494 ;; First element is function or whatever function-like forms are: or, and,
495 ;; if, progn, prog1, prog2, while, until
496 `(,func .
,(mapcar (lambda (form)
497 (cconv-convert form env extend
))
500 (_ (or (cdr (assq form env
)) form
))))
502 (unless (fboundp 'byte-compile-not-lexical-var-p
)
503 ;; Only used to test the code in non-lexbind Emacs.
504 (defalias 'byte-compile-not-lexical-var-p
'boundp
))
506 (defun cconv--analyse-use (vardata form varkind
)
507 "Analyse the use of a variable.
508 VARDATA should be (BINDER READ MUTATED CAPTURED CALLED).
509 VARKIND is the name of the kind of variable.
510 FORM is the parent form that binds this var."
511 ;; use = `(,binder ,read ,mutated ,captured ,called)
513 (`(,_ nil nil nil nil
) nil
)
514 (`((,(and (pred (lambda (var) (eq ?_
(aref (symbol-name var
) 0)))) var
) .
,_
)
516 (byte-compile-log-warning
517 (format "%s `%S' not left unused" varkind var
))))
519 (`((,var .
,_
) nil
,_
,_ nil
)
520 ;; FIXME: This gives warnings in the wrong order, with imprecise line
521 ;; numbers and without function name info.
522 (unless (or ;; Uninterned symbols typically come from macro-expansion, so
523 ;; it is often non-trivial for the programmer to avoid such
525 (not (intern-soft var
))
526 (eq ?_
(aref (symbol-name var
) 0)))
527 (byte-compile-log-warning (format "Unused lexical %s `%S'"
529 ;; If it's unused, there's no point converting it into a cons-cell, even if
530 ;; it's captured and mutated.
531 (`(,binder
,_ t t
,_
)
532 (push (cons binder form
) cconv-captured
+mutated
))
533 (`(,(and binder
`(,_
(function (lambda .
,_
)))) nil nil nil t
)
534 (push (cons binder form
) cconv-lambda-candidates
))))
536 (defun cconv--analyse-function (args body env parentform
)
538 (freevars (list body
))
539 ;; We analyze the body within a new environment where all uses are
540 ;; nil, so we can distinguish uses within that function from uses
543 (mapcar (lambda (vdata) (list (car vdata
) nil nil nil nil
)) env
))
545 ;; Push it before recursing, so cconv-freevars-alist contains entries in
546 ;; the order they'll be used by closure-convert-rec.
547 (push freevars cconv-freevars-alist
)
550 ((byte-compile-not-lexical-var-p arg
)
551 (byte-compile-report-error
552 (format "Argument %S is not a lexical variable" arg
)))
553 ((eq ?
& (aref (symbol-name arg
) 0)) nil
) ;Ignore &rest, &optional, ...
554 (t (let ((varstruct (list arg nil nil nil nil
)))
555 (push (cons (list arg
) (cdr varstruct
)) newvars
)
556 (push varstruct newenv
)))))
557 (dolist (form body
) ;Analyse body forms.
558 (cconv-analyse-form form newenv
))
559 ;; Summarize resulting data about arguments.
560 (dolist (vardata newvars
)
561 (cconv--analyse-use vardata parentform
"argument"))
562 ;; Transfer uses collected in `envcopy' (via `newenv') back to `env';
563 ;; and compute free variables.
565 (assert (and envcopy
(eq (caar env
) (caar envcopy
))))
568 (y (cdr (car envcopy
))))
570 (when (car y
) (setcar x t
) (setq free t
))
571 (setq x
(cdr x
) y
(cdr y
)))
573 (push (caar env
) (cdr freevars
))
574 (setf (nth 3 (car env
)) t
))
575 (setq env
(cdr env
) envcopy
(cdr envcopy
))))))
577 (defun cconv-analyse-form (form env
)
578 "Find mutated variables and variables captured by closure.
579 Analyse lambdas if they are suitable for lambda lifting.
580 - FORM is a piece of Elisp code after macroexpansion.
581 - ENV is an alist mapping each enclosing lexical variable to its info.
582 I.e. each element has the form (VAR . (READ MUTATED CAPTURED CALLED)).
583 This function does not return anything but instead fills the
584 `cconv-captured+mutated' and `cconv-lambda-candidates' variables
585 and updates the data stored in ENV."
588 (`(,(and (or `let
* `let
) letsym
) ,binders .
,body-forms
)
594 (dolist (binder binders
)
595 (if (not (consp binder
))
597 (setq var binder
) ; treat the form (let (x) ...) well
598 (setq binder
(list binder
))
600 (setq var
(car binder
))
601 (setq value
(cadr binder
))
603 (cconv-analyse-form value
(if (eq letsym
'let
*) env orig-env
)))
605 (unless (byte-compile-not-lexical-var-p var
)
606 (let ((varstruct (list var nil nil nil nil
)))
607 (push (cons binder
(cdr varstruct
)) newvars
)
608 (push varstruct env
))))
610 (dolist (form body-forms
) ; Analyse body forms.
611 (cconv-analyse-form form env
))
613 (dolist (vardata newvars
)
614 (cconv--analyse-use vardata form
"variable"))))
617 (`(,(or `defun
`defmacro
) ,func
,vrs .
,body-forms
)
619 (byte-compile-log-warning
620 (format "Function %S will ignore its context %S"
621 func
(mapcar #'car env
))
623 (cconv--analyse-function vrs body-forms nil form
))
625 (`(function (lambda ,vrs .
,body-forms
))
626 (cconv--analyse-function vrs body-forms env form
))
629 ;; If a local variable (member of env) is modified by setq then
630 ;; it is a mutated variable.
632 (let ((v (assq (car forms
) env
))) ; v = non nil if visible
633 (when v
(setf (nth 2 v
) t
)))
634 (cconv-analyse-form (cadr forms
) env
)
635 (setq forms
(cddr forms
))))
637 (`((lambda .
,_
) .
,_
) ; first element is lambda expression
638 (dolist (exp `((function ,(car form
)) .
,(cdr form
)))
639 (cconv-analyse-form exp env
)))
641 (`(cond .
,cond-forms
) ; cond special form
642 (dolist (forms cond-forms
)
643 (dolist (form forms
) (cconv-analyse-form form env
))))
645 (`(quote .
,_
) nil
) ; quote form
646 (`(function .
,_
) nil
) ; same as quote
648 (`(condition-case ,var
,protected-form .
,handlers
)
649 ;; FIXME: The bytecode for condition-case forces us to wrap the
650 ;; form and handlers in closures (for handlers, it's probably
651 ;; unavoidable, but not for the protected form).
652 (cconv--analyse-function () (list protected-form
) env form
)
653 (dolist (handler handlers
)
654 (cconv--analyse-function (if var
(list var
)) (cdr handler
) env form
)))
656 ;; FIXME: The bytecode for catch forces us to wrap the body.
657 (`(,(or `catch
`unwind-protect
) ,form .
,body
)
658 (cconv-analyse-form form env
)
659 (cconv--analyse-function () body env form
))
661 ;; FIXME: The bytecode for save-window-excursion and the lack of
662 ;; bytecode for track-mouse forces us to wrap the body.
663 (`(track-mouse .
,body
)
664 (cconv--analyse-function () body env form
))
666 (`(,(or `defconst
`defvar
) ,var
,value .
,_
)
667 (push var byte-compile-bound-variables
)
668 (cconv-analyse-form value env
))
670 (`(,(or `funcall
`apply
) ,fun .
,args
)
671 ;; Here we ignore fun because funcall and apply are the only two
672 ;; functions where we can pass a candidate for lambda lifting as
673 ;; argument. So, if we see fun elsewhere, we'll delete it from
674 ;; lambda candidate list.
675 (let ((fdata (and (symbolp fun
) (assq fun env
))))
677 (setf (nth 4 fdata
) t
)
678 (cconv-analyse-form fun env
)))
679 (dolist (form args
) (cconv-analyse-form form env
)))
681 (`(interactive .
,forms
)
682 ;; These appear within the function body but they don't have access
683 ;; to the function's arguments.
684 ;; We could extend this to allow interactive specs to refer to
685 ;; variables in the function's enclosing environment, but it doesn't
686 ;; seem worth the trouble.
687 (dolist (form forms
) (cconv-analyse-form form nil
)))
689 (`(declare .
,_
) nil
) ;The args don't contain code.
691 (`(,_ .
,body-forms
) ; First element is a function or whatever.
692 (dolist (form body-forms
) (cconv-analyse-form form env
)))
695 (let ((dv (assq form env
))) ; dv = declared and visible
697 (setf (nth 1 dv
) t
))))))
700 ;;; cconv.el ends here