1 ;;; cconv.el --- Closure conversion for statically scoped Emacs lisp. -*- lexical-binding: t; coding: utf-8 -*-
3 ;; Copyright (C) 2011-2012 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 analyze 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 the 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 recursively, 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))) ...))
68 ;; TODO: (not just for cconv but also for the lexbind changes in general)
69 ;; - let (e)debug find the value of lexical variables from the stack.
70 ;; - make eval-region do the eval-sexp-add-defvars dance.
71 ;; - byte-optimize-form should be applied before cconv.
72 ;; OTOH, the warnings emitted by cconv-analyze need to come before optimize
73 ;; since afterwards they can because obnoxious (warnings about an "unused
74 ;; variable" should not be emitted when the variable use has simply been
76 ;; - let macros specify that some let-bindings come from the same source,
77 ;; so the unused warning takes all uses into account.
78 ;; - let interactive specs return a function to build the args (to stash into
80 ;; - canonize code in macro-expand so we don't have to handle (let (var) body)
81 ;; and other oddities.
82 ;; - new byte codes for unwind-protect, catch, and condition-case so that
83 ;; closures aren't needed at all.
84 ;; - inline source code of different binding mode by first compiling it.
85 ;; - a reference to a var that is known statically to always hold a constant
86 ;; should be turned into a byte-constant rather than a byte-stack-ref.
87 ;; Hmm... right, that's called constant propagation and could be done here,
88 ;; but when that constant is a function, we have to be careful to make sure
89 ;; the bytecomp only compiles it once.
90 ;; - Since we know here when a variable is not mutated, we could pass that
91 ;; info to the byte-compiler, e.g. by using a new `immutable-let'.
92 ;; - add tail-calls to bytecode.c and the byte compiler.
93 ;; - call known non-escaping functions with `goto' rather than `call'.
94 ;; - optimize mapcar to a while loop.
96 ;; (defmacro dlet (binders &rest body)
97 ;; ;; Works in both lexical and non-lexical mode.
99 ;; ,@(mapcar (lambda (binder)
100 ;; `(defvar ,(if (consp binder) (car binder) binder)))
102 ;; (let ,binders ,@body)))
104 ;; (defmacro llet (binders &rest body)
105 ;; ;; Only works in lexical-binding mode.
107 ;; (lambda ,(mapcar (lambda (binder) (if (consp binder) (car binder) binder))
110 ;; ,@(mapcar (lambda (binder) (if (consp binder) (cadr 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 ;; Analyze 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.
381 ;; Running byte-optimize-form earlier will resolve this.
383 ,(cconv-convert `(function ,fun
) env extend
)
384 ,@(mapcar (lambda (form)
385 (cconv-convert form env extend
))
388 (`(cond .
,cond-forms
) ; cond special form
389 `(cond .
,(mapcar (lambda (branch)
390 (mapcar (lambda (form)
391 (cconv-convert form env extend
))
395 (`(function (lambda ,args .
,body
) .
,_
)
396 (cconv--convert-function args body env form
))
398 (`(internal-make-closure .
,_
)
399 (byte-compile-report-error
400 "Internal error in compiler: cconv called twice?"))
403 (`(function .
,_
) form
)
406 (`(,(and sym
(or `defconst
`defvar
)) ,definedsymbol .
,forms
)
407 `(,sym
,definedsymbol
408 .
,(mapcar (lambda (form) (cconv-convert form env extend
))
412 (`(condition-case ,var
,protected-form .
,handlers
)
413 (let ((newform (cconv--convert-function
414 () (list protected-form
) env form
)))
415 `(condition-case :fun-body
,newform
416 ,@(mapcar (lambda (handler)
418 (cconv--convert-function
419 (list (or var cconv--dummy-var
))
420 (cdr handler
) env form
)))
423 (`(,(and head
(or `catch
`unwind-protect
)) ,form .
,body
)
424 `(,head
,(cconv-convert form env extend
)
425 :fun-body
,(cconv--convert-function () body env form
)))
427 (`(track-mouse .
,body
)
429 :fun-body
,(cconv--convert-function () body env form
)))
431 (`(setq .
,forms
) ; setq special form
432 (let ((prognlist ()))
434 (let* ((sym (pop forms
))
435 (sym-new (or (cdr (assq sym env
)) sym
))
436 (value (cconv-convert (pop forms
) env extend
)))
438 ((pred symbolp
) `(setq ,sym-new
,value
))
439 (`(car ,iexp
) `(setcar ,iexp
,value
))
440 ;; This "should never happen", but for variables which are
441 ;; mutated+captured+unused, we may end up trying to `setq'
442 ;; on a closed-over variable, so just drop the setq.
443 (_ ;; (byte-compile-report-error
444 ;; (format "Internal error in cconv of (setq %s ..)"
449 `(progn .
,(nreverse prognlist
))
452 (`(,(and (or `funcall
`apply
) callsym
) ,fun .
,args
)
453 ;; These are not special forms but we treat them separately for the needs
454 ;; of lambda lifting.
455 (let ((mapping (cdr (assq fun env
))))
457 (`(apply-partially ,_ .
,(and fvs
`(,_ .
,_
)))
458 (assert (eq (cadr mapping
) fun
))
460 ,@(mapcar (lambda (fv)
461 (let ((exp (or (cdr (assq fv env
)) fv
)))
463 (`(car ,iexp .
,_
) iexp
)
466 ,@(mapcar (lambda (arg)
467 (cconv-convert arg env extend
))
469 (_ `(,callsym
,@(mapcar (lambda (arg)
470 (cconv-convert arg env extend
))
471 (cons fun args
)))))))
473 (`(interactive .
,forms
)
474 `(interactive .
,(mapcar (lambda (form)
475 (cconv-convert form nil nil
))
478 (`(declare .
,_
) form
) ;The args don't contain code.
481 ;; First element is function or whatever function-like forms are: or, and,
482 ;; if, progn, prog1, prog2, while, until
483 `(,func .
,(mapcar (lambda (form)
484 (cconv-convert form env extend
))
487 (_ (or (cdr (assq form env
)) form
))))
489 (unless (fboundp 'byte-compile-not-lexical-var-p
)
490 ;; Only used to test the code in non-lexbind Emacs.
491 (defalias 'byte-compile-not-lexical-var-p
'boundp
))
493 (defun cconv--analyse-use (vardata form varkind
)
494 "Analyze the use of a variable.
495 VARDATA should be (BINDER READ MUTATED CAPTURED CALLED).
496 VARKIND is the name of the kind of variable.
497 FORM is the parent form that binds this var."
498 ;; use = `(,binder ,read ,mutated ,captured ,called)
500 (`(,_ nil nil nil nil
) nil
)
501 (`((,(and (pred (lambda (var) (eq ?_
(aref (symbol-name var
) 0)))) var
) .
,_
)
503 (byte-compile-log-warning
504 (format "%s `%S' not left unused" varkind var
))))
506 (`((,var .
,_
) nil
,_
,_ nil
)
507 ;; FIXME: This gives warnings in the wrong order, with imprecise line
508 ;; numbers and without function name info.
509 (unless (or ;; Uninterned symbols typically come from macro-expansion, so
510 ;; it is often non-trivial for the programmer to avoid such
512 (not (intern-soft var
))
513 (eq ?_
(aref (symbol-name var
) 0))
514 ;; As a special exception, ignore "ignore".
516 (byte-compile-log-warning (format "Unused lexical %s `%S'"
518 ;; If it's unused, there's no point converting it into a cons-cell, even if
519 ;; it's captured and mutated.
520 (`(,binder
,_ t t
,_
)
521 (push (cons binder form
) cconv-captured
+mutated
))
522 (`(,(and binder
`(,_
(function (lambda .
,_
)))) nil nil nil t
)
523 (push (cons binder form
) cconv-lambda-candidates
))))
525 (defun cconv--analyse-function (args body env parentform
)
527 (freevars (list body
))
528 ;; We analyze the body within a new environment where all uses are
529 ;; nil, so we can distinguish uses within that function from uses
532 (mapcar (lambda (vdata) (list (car vdata
) nil nil nil nil
)) env
))
534 ;; Push it before recursing, so cconv-freevars-alist contains entries in
535 ;; the order they'll be used by closure-convert-rec.
536 (push freevars cconv-freevars-alist
)
539 ((byte-compile-not-lexical-var-p arg
)
540 (byte-compile-log-warning
541 (format "Argument %S is not a lexical variable" arg
)))
542 ((eq ?
& (aref (symbol-name arg
) 0)) nil
) ;Ignore &rest, &optional, ...
543 (t (let ((varstruct (list arg nil nil nil nil
)))
544 (push (cons (list arg
) (cdr varstruct
)) newvars
)
545 (push varstruct newenv
)))))
546 (dolist (form body
) ;Analyze body forms.
547 (cconv-analyse-form form newenv
))
548 ;; Summarize resulting data about arguments.
549 (dolist (vardata newvars
)
550 (cconv--analyse-use vardata parentform
"argument"))
551 ;; Transfer uses collected in `envcopy' (via `newenv') back to `env';
552 ;; and compute free variables.
554 (assert (and envcopy
(eq (caar env
) (caar envcopy
))))
557 (y (cdr (car envcopy
))))
559 (when (car y
) (setcar x t
) (setq free t
))
560 (setq x
(cdr x
) y
(cdr y
)))
562 (push (caar env
) (cdr freevars
))
563 (setf (nth 3 (car env
)) t
))
564 (setq env
(cdr env
) envcopy
(cdr envcopy
))))))
566 (defun cconv-analyse-form (form env
)
567 "Find mutated variables and variables captured by closure.
568 Analyze lambdas if they are suitable for lambda lifting.
569 - FORM is a piece of Elisp code after macroexpansion.
570 - ENV is an alist mapping each enclosing lexical variable to its info.
571 I.e. each element has the form (VAR . (READ MUTATED CAPTURED CALLED)).
572 This function does not return anything but instead fills the
573 `cconv-captured+mutated' and `cconv-lambda-candidates' variables
574 and updates the data stored in ENV."
577 (`(,(and (or `let
* `let
) letsym
) ,binders .
,body-forms
)
583 (dolist (binder binders
)
584 (if (not (consp binder
))
586 (setq var binder
) ; treat the form (let (x) ...) well
587 (setq binder
(list binder
))
589 (setq var
(car binder
))
590 (setq value
(cadr binder
))
592 (cconv-analyse-form value
(if (eq letsym
'let
*) env orig-env
)))
594 (unless (byte-compile-not-lexical-var-p var
)
595 (let ((varstruct (list var nil nil nil nil
)))
596 (push (cons binder
(cdr varstruct
)) newvars
)
597 (push varstruct env
))))
599 (dolist (form body-forms
) ; Analyze body forms.
600 (cconv-analyse-form form env
))
602 (dolist (vardata newvars
)
603 (cconv--analyse-use vardata form
"variable"))))
605 (`(function (lambda ,vrs .
,body-forms
))
606 (cconv--analyse-function vrs body-forms env form
))
609 ;; If a local variable (member of env) is modified by setq then
610 ;; it is a mutated variable.
612 (let ((v (assq (car forms
) env
))) ; v = non nil if visible
613 (when v
(setf (nth 2 v
) t
)))
614 (cconv-analyse-form (cadr forms
) env
)
615 (setq forms
(cddr forms
))))
617 (`((lambda .
,_
) .
,_
) ; First element is lambda expression.
618 (byte-compile-log-warning
619 "Use of deprecated ((lambda ...) ...) form" t
:warning
)
620 (dolist (exp `((function ,(car form
)) .
,(cdr form
)))
621 (cconv-analyse-form exp env
)))
623 (`(cond .
,cond-forms
) ; cond special form
624 (dolist (forms cond-forms
)
625 (dolist (form forms
) (cconv-analyse-form form env
))))
627 (`(quote .
,_
) nil
) ; quote form
628 (`(function .
,_
) nil
) ; same as quote
630 (`(condition-case ,var
,protected-form .
,handlers
)
631 ;; FIXME: The bytecode for condition-case forces us to wrap the
632 ;; form and handlers in closures (for handlers, it's understandable
633 ;; but not for the protected form).
634 (cconv--analyse-function () (list protected-form
) env form
)
635 (dolist (handler handlers
)
636 (cconv--analyse-function (if var
(list var
)) (cdr handler
) env form
)))
638 ;; FIXME: The bytecode for catch forces us to wrap the body.
639 (`(,(or `catch
`unwind-protect
) ,form .
,body
)
640 (cconv-analyse-form form env
)
641 (cconv--analyse-function () body env form
))
643 ;; FIXME: The lack of bytecode for track-mouse forces us to wrap the body.
644 ;; `track-mouse' really should be made into a macro.
645 (`(track-mouse .
,body
)
646 (cconv--analyse-function () body env form
))
648 (`(,(or `defconst
`defvar
) ,var
,value .
,_
)
649 (push var byte-compile-bound-variables
)
650 (cconv-analyse-form value env
))
652 (`(,(or `funcall
`apply
) ,fun .
,args
)
653 ;; Here we ignore fun because funcall and apply are the only two
654 ;; functions where we can pass a candidate for lambda lifting as
655 ;; argument. So, if we see fun elsewhere, we'll delete it from
656 ;; lambda candidate list.
657 (let ((fdata (and (symbolp fun
) (assq fun env
))))
659 (setf (nth 4 fdata
) t
)
660 (cconv-analyse-form fun env
)))
661 (dolist (form args
) (cconv-analyse-form form env
)))
663 (`(interactive .
,forms
)
664 ;; These appear within the function body but they don't have access
665 ;; to the function's arguments.
666 ;; We could extend this to allow interactive specs to refer to
667 ;; variables in the function's enclosing environment, but it doesn't
668 ;; seem worth the trouble.
669 (dolist (form forms
) (cconv-analyse-form form nil
)))
671 (`(declare .
,_
) nil
) ;The args don't contain code.
673 (`(,_ .
,body-forms
) ; First element is a function or whatever.
674 (dolist (form body-forms
) (cconv-analyse-form form env
)))
677 (let ((dv (assq form env
))) ; dv = declared and visible
679 (setf (nth 1 dv
) t
))))))
682 ;;; cconv.el ends here