aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorStefan Monnier2011-02-26 10:19:08 -0500
committerStefan Monnier2011-02-26 10:19:08 -0500
commita9de04fa62f123413d82b7b7b1e7a77705eb82dd (patch)
tree84292e07c3583dee99376669fb799d8c93cdd5ff
parent876c194cbac17a6220dbf406b0a602325978011c (diff)
downloademacs-a9de04fa62f123413d82b7b7b1e7a77705eb82dd.tar.gz
emacs-a9de04fa62f123413d82b7b7b1e7a77705eb82dd.zip
Compute freevars in cconv-analyse.
* lisp/emacs-lisp/cconv.el: Compute freevars in cconv-analyse. (cconv-mutated, cconv-captured): Remove. (cconv-captured+mutated, cconv-lambda-candidates): Don't give them a global value. (cconv-freevars-alist): New var. (cconv-freevars): Remove. (cconv--lookup-let): Remove. (cconv-closure-convert-function): Extract from cconv-closure-convert-rec. (cconv-closure-convert-rec): Adjust to above changes. (fboundp): New function. (cconv-analyse-function, form): Rewrite. * lisp/emacs-lisp/bytecomp.el (byte-compile-initial-macro-environment): Handle declare-function here. (byte-compile-obsolete): Remove. (byte-compile-arglist-warn): Check late defsubst here. (byte-compile-file-form): Simplify. (byte-compile-file-form-defsubst): Remove. (byte-compile-macroexpand-declare-function): Rename from byte-compile-declare-function, turn it into a macro-expander. (byte-compile-normal-call): Check obsolescence. (byte-compile-quote-form): Remove. (byte-compile-defmacro): Revert to trunk's definition which seems to work just as well and handles `declare'. * lisp/emacs-lisp/byte-run.el (make-obsolete): Don't modify byte-compile. * lisp/Makefile.in (BIG_STACK_DEPTH): Increase to 1200. (compile-onefile): Pass $(BIG_STACK_OPTS) before "-l bytecomp". * lisp/emacs-lisp/macroexp.el: Use lexbind. (macroexpand-all-1): Check macro obsolescence. * lisp/vc/diff-mode.el: Use lexbind. * lisp/follow.el (follow-calc-win-end): Simplify.
-rw-r--r--lisp/ChangeLog33
-rw-r--r--lisp/Makefile.in8
-rw-r--r--lisp/emacs-lisp/byte-run.el10
-rw-r--r--lisp/emacs-lisp/bytecomp.el123
-rw-r--r--lisp/emacs-lisp/cconv.el468
-rw-r--r--lisp/emacs-lisp/debug.el1
-rw-r--r--lisp/emacs-lisp/macroexp.el11
-rw-r--r--lisp/follow.el3
-rw-r--r--lisp/vc/diff-mode.el4
-rw-r--r--src/bytecode.c2
10 files changed, 309 insertions, 354 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index ee6944d8e07..1b5e9400a8c 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,36 @@
12011-02-26 Stefan Monnier <monnier@iro.umontreal.ca>
2
3 * emacs-lisp/cconv.el: Compute freevars in cconv-analyse.
4 (cconv-mutated, cconv-captured): Remove.
5 (cconv-captured+mutated, cconv-lambda-candidates): Don't give them
6 a global value.
7 (cconv-freevars-alist): New var.
8 (cconv-freevars): Remove.
9 (cconv--lookup-let): Remove.
10 (cconv-closure-convert-function): Extract from cconv-closure-convert-rec.
11 (cconv-closure-convert-rec): Adjust to above changes.
12 (fboundp): New function.
13 (cconv-analyse-function, form): Rewrite.
14 * emacs-lisp/bytecomp.el (byte-compile-initial-macro-environment):
15 Handle declare-function here.
16 (byte-compile-obsolete): Remove.
17 (byte-compile-arglist-warn): Check late defsubst here.
18 (byte-compile-file-form): Simplify.
19 (byte-compile-file-form-defsubst): Remove.
20 (byte-compile-macroexpand-declare-function): Rename from
21 byte-compile-declare-function, turn it into a macro-expander.
22 (byte-compile-normal-call): Check obsolescence.
23 (byte-compile-quote-form): Remove.
24 (byte-compile-defmacro): Revert to trunk's definition which seems to
25 work just as well and handles `declare'.
26 * emacs-lisp/byte-run.el (make-obsolete): Don't modify byte-compile.
27 * Makefile.in (BIG_STACK_DEPTH): Increase to 1200.
28 (compile-onefile): Pass $(BIG_STACK_OPTS) before "-l bytecomp".
29 * emacs-lisp/macroexp.el: Use lexbind.
30 (macroexpand-all-1): Check macro obsolescence.
31 * vc/diff-mode.el: Use lexbind.
32 * follow.el (follow-calc-win-end): Simplify.
33
12011-02-25 Stefan Monnier <monnier@iro.umontreal.ca> 342011-02-25 Stefan Monnier <monnier@iro.umontreal.ca>
2 35
3 * emacs-lisp/bytecomp.el (byte-compile-lapcode): Handle new form of 36 * emacs-lisp/bytecomp.el (byte-compile-lapcode): Handle new form of
diff --git a/lisp/Makefile.in b/lisp/Makefile.in
index 389d5b154aa..0182b7f5072 100644
--- a/lisp/Makefile.in
+++ b/lisp/Makefile.in
@@ -74,7 +74,7 @@ AUTOGENEL = loaddefs.el \
74# During bootstrapping the byte-compiler is run interpreted when compiling 74# During bootstrapping the byte-compiler is run interpreted when compiling
75# itself, and uses more stack than usual. 75# itself, and uses more stack than usual.
76# 76#
77BIG_STACK_DEPTH = 1000 77BIG_STACK_DEPTH = 1200
78BIG_STACK_OPTS = --eval "(setq max-lisp-eval-depth $(BIG_STACK_DEPTH))" 78BIG_STACK_OPTS = --eval "(setq max-lisp-eval-depth $(BIG_STACK_DEPTH))"
79 79
80# Files to compile before others during a bootstrap. This is done to 80# Files to compile before others during a bootstrap. This is done to
@@ -205,8 +205,8 @@ compile-onefile:
205 @echo Compiling $(THEFILE) 205 @echo Compiling $(THEFILE)
206 @# Use byte-compile-refresh-preloaded to try and work around some of 206 @# Use byte-compile-refresh-preloaded to try and work around some of
207 @# the most common bootstrapping problems. 207 @# the most common bootstrapping problems.
208 $(emacs) -l bytecomp.el -f byte-compile-refresh-preloaded \ 208 @$(emacs) $(BIG_STACK_OPTS) -l bytecomp $(BYTE_COMPILE_EXTRA_FLAGS) \
209 $(BIG_STACK_OPTS) $(BYTE_COMPILE_EXTRA_FLAGS) \ 209 -f byte-compile-refresh-preloaded \
210 -f batch-byte-compile $(THEFILE) 210 -f batch-byte-compile $(THEFILE)
211 211
212# Files MUST be compiled one by one. If we compile several files in a 212# Files MUST be compiled one by one. If we compile several files in a
@@ -222,7 +222,7 @@ compile-onefile:
222# cannot have prerequisites. 222# cannot have prerequisites.
223.el.elc: 223.el.elc:
224 @echo Compiling $< 224 @echo Compiling $<
225 $(emacs) $(BIG_STACK_OPTS) $(BYTE_COMPILE_EXTRA_FLAGS) \ 225 @$(emacs) $(BIG_STACK_OPTS) $(BYTE_COMPILE_EXTRA_FLAGS) \
226 -f batch-byte-compile $< 226 -f batch-byte-compile $<
227 227
228.PHONY: compile-first compile-main compile compile-always 228.PHONY: compile-first compile-main compile compile-always
diff --git a/lisp/emacs-lisp/byte-run.el b/lisp/emacs-lisp/byte-run.el
index 524f4f1b465..3fb3d841ed1 100644
--- a/lisp/emacs-lisp/byte-run.el
+++ b/lisp/emacs-lisp/byte-run.el
@@ -123,12 +123,10 @@ If CURRENT-NAME is a string, that is the `use instead' message
123If provided, WHEN should be a string indicating when the function 123If provided, WHEN should be a string indicating when the function
124was first made obsolete, for example a date or a release number." 124was first made obsolete, for example a date or a release number."
125 (interactive "aMake function obsolete: \nxObsoletion replacement: ") 125 (interactive "aMake function obsolete: \nxObsoletion replacement: ")
126 (let ((handler (get obsolete-name 'byte-compile))) 126 (put obsolete-name 'byte-obsolete-info
127 (if (eq 'byte-compile-obsolete handler) 127 ;; The second entry used to hold the `byte-compile' handler, but
128 (setq handler (nth 1 (get obsolete-name 'byte-obsolete-info))) 128 ;; is not used any more nowadays.
129 (put obsolete-name 'byte-compile 'byte-compile-obsolete)) 129 (list (purecopy current-name) nil (purecopy when)))
130 (put obsolete-name 'byte-obsolete-info
131 (list (purecopy current-name) handler (purecopy when))))
132 obsolete-name) 130 obsolete-name)
133(set-advertised-calling-convention 131(set-advertised-calling-convention
134 ;; New code should always provide the `when' argument. 132 ;; New code should always provide the `when' argument.
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index 6bc2b3b5617..4a53faefa3d 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -424,6 +424,7 @@ This list lives partly on the stack.")
424 '( 424 '(
425;; (byte-compiler-options . (lambda (&rest forms) 425;; (byte-compiler-options . (lambda (&rest forms)
426;; (apply 'byte-compiler-options-handler forms))) 426;; (apply 'byte-compiler-options-handler forms)))
427 (declare-function . byte-compile-macroexpand-declare-function)
427 (eval-when-compile . (lambda (&rest body) 428 (eval-when-compile . (lambda (&rest body)
428 (list 429 (list
429 'quote 430 'quote
@@ -1140,13 +1141,6 @@ Each function's symbol gets added to `byte-compile-noruntime-functions'."
1140 (byte-compile-log-warning 1141 (byte-compile-log-warning
1141 (error-message-string error-info) 1142 (error-message-string error-info)
1142 nil :error)) 1143 nil :error))
1143
1144;;; Used by make-obsolete.
1145(defun byte-compile-obsolete (form)
1146 (byte-compile-set-symbol-position (car form))
1147 (byte-compile-warn-obsolete (car form))
1148 (funcall (or (cadr (get (car form) 'byte-obsolete-info)) ; handler
1149 'byte-compile-normal-call) form))
1150 1144
1151;;; sanity-checking arglists 1145;;; sanity-checking arglists
1152 1146
@@ -1328,7 +1322,8 @@ extra args."
1328;; Warn if the function or macro is being redefined with a different 1322;; Warn if the function or macro is being redefined with a different
1329;; number of arguments. 1323;; number of arguments.
1330(defun byte-compile-arglist-warn (form macrop) 1324(defun byte-compile-arglist-warn (form macrop)
1331 (let ((old (byte-compile-fdefinition (nth 1 form) macrop))) 1325 (let* ((name (nth 1 form))
1326 (old (byte-compile-fdefinition name macrop)))
1332 (if (and old (not (eq old t))) 1327 (if (and old (not (eq old t)))
1333 (progn 1328 (progn
1334 (and (eq 'macro (car-safe old)) 1329 (and (eq 'macro (car-safe old))
@@ -1342,36 +1337,39 @@ extra args."
1342 (t '(&rest def))))) 1337 (t '(&rest def)))))
1343 (sig2 (byte-compile-arglist-signature (nth 2 form)))) 1338 (sig2 (byte-compile-arglist-signature (nth 2 form))))
1344 (unless (byte-compile-arglist-signatures-congruent-p sig1 sig2) 1339 (unless (byte-compile-arglist-signatures-congruent-p sig1 sig2)
1345 (byte-compile-set-symbol-position (nth 1 form)) 1340 (byte-compile-set-symbol-position name)
1346 (byte-compile-warn 1341 (byte-compile-warn
1347 "%s %s used to take %s %s, now takes %s" 1342 "%s %s used to take %s %s, now takes %s"
1348 (if (eq (car form) 'defun) "function" "macro") 1343 (if (eq (car form) 'defun) "function" "macro")
1349 (nth 1 form) 1344 name
1350 (byte-compile-arglist-signature-string sig1) 1345 (byte-compile-arglist-signature-string sig1)
1351 (if (equal sig1 '(1 . 1)) "argument" "arguments") 1346 (if (equal sig1 '(1 . 1)) "argument" "arguments")
1352 (byte-compile-arglist-signature-string sig2))))) 1347 (byte-compile-arglist-signature-string sig2)))))
1353 ;; This is the first definition. See if previous calls are compatible. 1348 ;; This is the first definition. See if previous calls are compatible.
1354 (let ((calls (assq (nth 1 form) byte-compile-unresolved-functions)) 1349 (let ((calls (assq name byte-compile-unresolved-functions))
1355 nums sig min max) 1350 nums sig min max)
1356 (if calls 1351 (when calls
1357 (progn 1352 (when (and (symbolp name)
1358 (setq sig (byte-compile-arglist-signature (nth 2 form)) 1353 (eq (get name 'byte-optimizer)
1359 nums (sort (copy-sequence (cdr calls)) (function <)) 1354 'byte-compile-inline-expand))
1360 min (car nums) 1355 (byte-compile-warn "defsubst `%s' was used before it was defined"
1361 max (car (nreverse nums))) 1356 name))
1362 (when (or (< min (car sig)) 1357 (setq sig (byte-compile-arglist-signature (nth 2 form))
1363 (and (cdr sig) (> max (cdr sig)))) 1358 nums (sort (copy-sequence (cdr calls)) (function <))
1364 (byte-compile-set-symbol-position (nth 1 form)) 1359 min (car nums)
1365 (byte-compile-warn 1360 max (car (nreverse nums)))
1366 "%s being defined to take %s%s, but was previously called with %s" 1361 (when (or (< min (car sig))
1367 (nth 1 form) 1362 (and (cdr sig) (> max (cdr sig))))
1368 (byte-compile-arglist-signature-string sig) 1363 (byte-compile-set-symbol-position name)
1369 (if (equal sig '(1 . 1)) " arg" " args") 1364 (byte-compile-warn
1370 (byte-compile-arglist-signature-string (cons min max)))) 1365 "%s being defined to take %s%s, but was previously called with %s"
1371 1366 name
1372 (setq byte-compile-unresolved-functions 1367 (byte-compile-arglist-signature-string sig)
1373 (delq calls byte-compile-unresolved-functions))))) 1368 (if (equal sig '(1 . 1)) " arg" " args")
1374 ))) 1369 (byte-compile-arglist-signature-string (cons min max))))
1370
1371 (setq byte-compile-unresolved-functions
1372 (delq calls byte-compile-unresolved-functions)))))))
1375 1373
1376(defvar byte-compile-cl-functions nil 1374(defvar byte-compile-cl-functions nil
1377 "List of functions defined in CL.") 1375 "List of functions defined in CL.")
@@ -1470,7 +1468,7 @@ symbol itself."
1470 (if any-value 1468 (if any-value
1471 (or (memq symbol byte-compile-const-variables) 1469 (or (memq symbol byte-compile-const-variables)
1472 ;; FIXME: We should provide a less intrusive way to find out 1470 ;; FIXME: We should provide a less intrusive way to find out
1473 ;; is a variable is "constant". 1471 ;; if a variable is "constant".
1474 (and (boundp symbol) 1472 (and (boundp symbol)
1475 (condition-case nil 1473 (condition-case nil
1476 (progn (set symbol (symbol-value symbol)) nil) 1474 (progn (set symbol (symbol-value symbol)) nil)
@@ -2198,9 +2196,8 @@ list that represents a doc string reference.
2198;; byte-hunk-handlers can call this. 2196;; byte-hunk-handlers can call this.
2199(defun byte-compile-file-form (form) 2197(defun byte-compile-file-form (form)
2200 (let (bytecomp-handler) 2198 (let (bytecomp-handler)
2201 (cond ((not (consp form)) 2199 (cond ((and (consp form)
2202 (byte-compile-keep-pending form)) 2200 (symbolp (car form))
2203 ((and (symbolp (car form))
2204 (setq bytecomp-handler (get (car form) 'byte-hunk-handler))) 2201 (setq bytecomp-handler (get (car form) 'byte-hunk-handler)))
2205 (cond ((setq form (funcall bytecomp-handler form)) 2202 (cond ((setq form (funcall bytecomp-handler form))
2206 (byte-compile-flush-pending) 2203 (byte-compile-flush-pending)
@@ -2212,16 +2209,6 @@ list that represents a doc string reference.
2212;; so make-docfile can recognise them. Most other things can be output 2209;; so make-docfile can recognise them. Most other things can be output
2213;; as byte-code. 2210;; as byte-code.
2214 2211
2215(put 'defsubst 'byte-hunk-handler 'byte-compile-file-form-defsubst)
2216(defun byte-compile-file-form-defsubst (form)
2217 (when (assq (nth 1 form) byte-compile-unresolved-functions)
2218 (setq byte-compile-current-form (nth 1 form))
2219 (byte-compile-warn "defsubst `%s' was used before it was defined"
2220 (nth 1 form)))
2221 (byte-compile-file-form form)
2222 ;; Return nil so the form is not output twice.
2223 nil)
2224
2225(put 'autoload 'byte-hunk-handler 'byte-compile-file-form-autoload) 2212(put 'autoload 'byte-hunk-handler 'byte-compile-file-form-autoload)
2226(defun byte-compile-file-form-autoload (form) 2213(defun byte-compile-file-form-autoload (form)
2227 (and (let ((form form)) 2214 (and (let ((form form))
@@ -2914,7 +2901,6 @@ If FORM is a lambda or a macro, byte-compile it as a function."
2914 2901
2915;; Given BYTECOMP-BODY, compile it and return a new body. 2902;; Given BYTECOMP-BODY, compile it and return a new body.
2916(defun byte-compile-top-level-body (bytecomp-body &optional for-effect) 2903(defun byte-compile-top-level-body (bytecomp-body &optional for-effect)
2917 ;; FIXME: lexbind. Check all callers!
2918 (setq bytecomp-body 2904 (setq bytecomp-body
2919 (byte-compile-top-level (cons 'progn bytecomp-body) for-effect t)) 2905 (byte-compile-top-level (cons 'progn bytecomp-body) for-effect t))
2920 (cond ((eq (car-safe bytecomp-body) 'progn) 2906 (cond ((eq (car-safe bytecomp-body) 'progn)
@@ -2922,20 +2908,18 @@ If FORM is a lambda or a macro, byte-compile it as a function."
2922 (bytecomp-body 2908 (bytecomp-body
2923 (list bytecomp-body)))) 2909 (list bytecomp-body))))
2924 2910
2925;; FIXME: Like defsubst's, this hunk-handler won't be called any more 2911;; Special macro-expander used during byte-compilation.
2926;; because the macro is expanded away before we see it. 2912(defun byte-compile-macroexpand-declare-function (fn file &rest args)
2927(put 'declare-function 'byte-hunk-handler 'byte-compile-declare-function) 2913 (push (cons fn
2928(defun byte-compile-declare-function (form) 2914 (if (and (consp args) (listp (car args)))
2929 (push (cons (nth 1 form) 2915 (list 'declared (car args))
2930 (if (and (> (length form) 3)
2931 (listp (nth 3 form)))
2932 (list 'declared (nth 3 form))
2933 t)) ; arglist not specified 2916 t)) ; arglist not specified
2934 byte-compile-function-environment) 2917 byte-compile-function-environment)
2935 ;; We are stating that it _will_ be defined at runtime. 2918 ;; We are stating that it _will_ be defined at runtime.
2936 (setq byte-compile-noruntime-functions 2919 (setq byte-compile-noruntime-functions
2937 (delq (nth 1 form) byte-compile-noruntime-functions)) 2920 (delq fn byte-compile-noruntime-functions))
2938 nil) 2921 ;; Delegate the rest to the normal macro definition.
2922 (macroexpand `(declare-function ,fn ,file ,@args)))
2939 2923
2940 2924
2941;; This is the recursive entry point for compiling each subform of an 2925;; This is the recursive entry point for compiling each subform of an
@@ -3005,6 +2989,8 @@ That command is designed for interactive use only" bytecomp-fn))
3005 '(custom-declare-group custom-declare-variable 2989 '(custom-declare-group custom-declare-variable
3006 custom-declare-face)) 2990 custom-declare-face))
3007 (byte-compile-nogroup-warn form)) 2991 (byte-compile-nogroup-warn form))
2992 (when (get (car form) 'byte-obsolete-info)
2993 (byte-compile-warn-obsolete (car form)))
3008 (byte-compile-callargs-warn form)) 2994 (byte-compile-callargs-warn form))
3009 (if byte-compile-generate-call-tree 2995 (if byte-compile-generate-call-tree
3010 (byte-compile-annotate-call-tree form)) 2996 (byte-compile-annotate-call-tree form))
@@ -3562,7 +3548,6 @@ discarding."
3562(byte-defop-compiler-1 setq) 3548(byte-defop-compiler-1 setq)
3563(byte-defop-compiler-1 setq-default) 3549(byte-defop-compiler-1 setq-default)
3564(byte-defop-compiler-1 quote) 3550(byte-defop-compiler-1 quote)
3565(byte-defop-compiler-1 quote-form)
3566 3551
3567(defun byte-compile-setq (form) 3552(defun byte-compile-setq (form)
3568 (let ((bytecomp-args (cdr form))) 3553 (let ((bytecomp-args (cdr form)))
@@ -3606,10 +3591,6 @@ discarding."
3606 3591
3607(defun byte-compile-quote (form) 3592(defun byte-compile-quote (form)
3608 (byte-compile-constant (car (cdr form)))) 3593 (byte-compile-constant (car (cdr form))))
3609
3610(defun byte-compile-quote-form (form)
3611 (byte-compile-constant (byte-compile-top-level (nth 1 form))))
3612
3613 3594
3614;;; control structures 3595;;; control structures
3615 3596
@@ -3845,6 +3826,7 @@ Return the offset in the form (VAR . OFFSET)."
3845 (byte-compile-push-constant nil))))) 3826 (byte-compile-push-constant nil)))))
3846 3827
3847(defun byte-compile-not-lexical-var-p (var) 3828(defun byte-compile-not-lexical-var-p (var)
3829 ;; FIXME: this doesn't catch defcustoms!
3848 (or (not (symbolp var)) 3830 (or (not (symbolp var))
3849 (special-variable-p var) 3831 (special-variable-p var)
3850 (memq var byte-compile-bound-variables) 3832 (memq var byte-compile-bound-variables)
@@ -4097,15 +4079,16 @@ binding slots have been popped."
4097 4079
4098(defun byte-compile-defmacro (form) 4080(defun byte-compile-defmacro (form)
4099 ;; This is not used for file-level defmacros with doc strings. 4081 ;; This is not used for file-level defmacros with doc strings.
4100 ;; FIXME handle decls, use defalias? 4082 (byte-compile-body-do-effect
4101 (let ((decls (byte-compile-defmacro-declaration form)) 4083 (let ((decls (byte-compile-defmacro-declaration form))
4102 (code (byte-compile-lambda (cdr (cdr form)) t)) 4084 (code (byte-compile-byte-code-maker
4103 (for-effect nil)) 4085 (byte-compile-lambda (cdr (cdr form)) t))))
4104 (byte-compile-push-constant (nth 1 form)) 4086 `((defalias ',(nth 1 form)
4105 (byte-compile-push-constant (cons 'macro code)) 4087 ,(if (eq (car-safe code) 'make-byte-code)
4106 (byte-compile-out 'byte-fset) 4088 `(cons 'macro ,code)
4107 (byte-compile-discard)) 4089 `'(macro . ,(eval code))))
4108 (byte-compile-constant (nth 1 form))) 4090 ,@decls
4091 ',(nth 1 form)))))
4109 4092
4110(defun byte-compile-defvar (form) 4093(defun byte-compile-defvar (form)
4111 ;; This is not used for file-level defvar/consts with doc strings. 4094 ;; This is not used for file-level defvar/consts with doc strings.
@@ -4153,7 +4136,7 @@ binding slots have been popped."
4153 `(if (not (default-boundp ',var)) (setq-default ,var ,value)))) 4136 `(if (not (default-boundp ',var)) (setq-default ,var ,value))))
4154 (when (eq fun 'defconst) 4137 (when (eq fun 'defconst)
4155 ;; This will signal an appropriate error at runtime. 4138 ;; This will signal an appropriate error at runtime.
4156 `(eval ',form))) ;FIXME: lexbind 4139 `(eval ',form)))
4157 `',var)))) 4140 `',var))))
4158 4141
4159(defun byte-compile-autoload (form) 4142(defun byte-compile-autoload (form)
diff --git a/lisp/emacs-lisp/cconv.el b/lisp/emacs-lisp/cconv.el
index bc7ecb1ad55..0e4b5d31699 100644
--- a/lisp/emacs-lisp/cconv.el
+++ b/lisp/emacs-lisp/cconv.el
@@ -82,110 +82,19 @@
82(defconst cconv-liftwhen 3 82(defconst cconv-liftwhen 3
83 "Try to do lambda lifting if the number of arguments + free variables 83 "Try to do lambda lifting if the number of arguments + free variables
84is less than this number.") 84is less than this number.")
85(defvar cconv-mutated nil 85;; List of all the variables that are both captured by a closure
86 "List of mutated variables in current form") 86;; and mutated. Each entry in the list takes the form
87(defvar cconv-captured nil 87;; (BINDER . PARENTFORM) where BINDER is the (VAR VAL) that introduces the
88 "List of closure captured variables in current form") 88;; variable (or is just (VAR) for variables not introduced by let).
89(defvar cconv-captured+mutated nil 89(defvar cconv-captured+mutated)
90 "An intersection between cconv-mutated and cconv-captured lists.")
91(defvar cconv-lambda-candidates nil
92 "List of candidates for lambda lifting.
93Each candidate has the form (VAR INCLOSURE BINDER PARENTFORM).")
94
95(defun cconv-freevars (form &optional fvrs)
96 "Find all free variables of given form.
97Arguments:
98-- FORM is a piece of Elisp code after macroexpansion.
99-- FVRS(optional) is a list of variables already found. Used for recursive tree
100traversal
101
102Returns a list of free variables."
103 ;; If a leaf in the tree is a symbol, but it is not a global variable, not a
104 ;; keyword, not 'nil or 't we consider this leaf as a variable.
105 ;; Free variables are the variables that are not declared above in this tree.
106 ;; For example free variables of (lambda (a1 a2 ..) body-forms) are
107 ;; free variables of body-forms excluding a1, a2 ..
108 ;; Free variables of (let ((v1 ..) (v2) ..)) body-forms) are
109 ;; free variables of body-forms excluding v1, v2 ...
110 ;; and so on.
111
112 ;; A list of free variables already found(FVRS) is passed in parameter
113 ;; to try to use cons or push where possible, and to minimize the usage
114 ;; of append.
115
116 ;; This function can return duplicates (because we use 'append instead
117 ;; of union of two sets - for performance reasons).
118 (pcase form
119 (`(let ,varsvalues . ,body-forms) ; let special form
120 (let ((fvrs-1 '()))
121 (dolist (exp body-forms)
122 (setq fvrs-1 (cconv-freevars exp fvrs-1)))
123 (dolist (elm varsvalues)
124 (setq fvrs-1 (delq (if (consp elm) (car elm) elm) fvrs-1)))
125 (setq fvrs (nconc fvrs-1 fvrs))
126 (dolist (exp varsvalues)
127 (when (consp exp) (setq fvrs (cconv-freevars (cadr exp) fvrs))))
128 fvrs))
129
130 (`(let* ,varsvalues . ,body-forms) ; let* special form
131 (let ((vrs '())
132 (fvrs-1 '()))
133 (dolist (exp varsvalues)
134 (if (consp exp)
135 (progn
136 (setq fvrs-1 (cconv-freevars (cadr exp) fvrs-1))
137 (dolist (elm vrs) (setq fvrs-1 (delq elm fvrs-1)))
138 (push (car exp) vrs))
139 (progn
140 (dolist (elm vrs) (setq fvrs-1 (delq elm fvrs-1)))
141 (push exp vrs))))
142 (dolist (exp body-forms)
143 (setq fvrs-1 (cconv-freevars exp fvrs-1)))
144 (dolist (elm vrs) (setq fvrs-1 (delq elm fvrs-1)))
145 (append fvrs fvrs-1)))
146
147 (`((lambda . ,_) . ,_) ; first element is lambda expression
148 (dolist (exp `((function ,(car form)) . ,(cdr form)))
149 (setq fvrs (cconv-freevars exp fvrs))) fvrs)
150 90
151 (`(cond . ,cond-forms) ; cond special form 91;; List of candidates for lambda lifting.
152 (dolist (exp1 cond-forms) 92;; Each candidate has the form (BINDER . PARENTFORM). A candidate
153 (dolist (exp2 exp1) 93;; is a variable that is only passed to `funcall' or `apply'.
154 (setq fvrs (cconv-freevars exp2 fvrs)))) fvrs) 94(defvar cconv-lambda-candidates)
155
156 (`(quote . ,_) fvrs) ; quote form
157 95
158 (`(function . ((lambda ,vars . ,body-forms))) 96;; Alist associating to each function body the list of its free variables.
159 (let ((functionform (cadr form)) (fvrs-1 '())) 97(defvar cconv-freevars-alist)
160 (dolist (exp body-forms)
161 (setq fvrs-1 (cconv-freevars exp fvrs-1)))
162 (dolist (elm vars) (setq fvrs-1 (delq elm fvrs-1)))
163 (append fvrs fvrs-1))) ; function form
164
165 (`(function . ,_) fvrs) ; same as quote
166 ;condition-case
167 (`(condition-case ,var ,protected-form . ,conditions-bodies)
168 (let ((fvrs-1 '()))
169 (dolist (exp conditions-bodies)
170 (setq fvrs-1 (cconv-freevars (cadr exp) fvrs-1)))
171 (setq fvrs-1 (delq var fvrs-1))
172 (setq fvrs-1 (cconv-freevars protected-form fvrs-1))
173 (append fvrs fvrs-1)))
174
175 (`(,(and sym (or `defun `defconst `defvar)) . ,_)
176 ;; We call cconv-freevars only for functions(lambdas)
177 ;; defun, defconst, defvar are not allowed to be inside
178 ;; a function (lambda).
179 ;; (error "Invalid form: %s inside a function" sym)
180 (cconv-freevars `(progn ,@(cddr form)) fvrs))
181
182 (`(,_ . ,body-forms) ; First element is (like) a function.
183 (dolist (exp body-forms)
184 (setq fvrs (cconv-freevars exp fvrs))) fvrs)
185
186 (_ (if (byte-compile-not-lexical-var-p form)
187 fvrs
188 (cons form fvrs)))))
189 98
190;;;###autoload 99;;;###autoload
191(defun cconv-closure-convert (form) 100(defun cconv-closure-convert (form)
@@ -195,16 +104,12 @@ Returns a list of free variables."
195 104
196Returns a form where all lambdas don't have any free variables." 105Returns a form where all lambdas don't have any free variables."
197 ;; (message "Entering cconv-closure-convert...") 106 ;; (message "Entering cconv-closure-convert...")
198 (let ((cconv-mutated '()) 107 (let ((cconv-freevars-alist '())
199 (cconv-lambda-candidates '()) 108 (cconv-lambda-candidates '())
200 (cconv-captured '())
201 (cconv-captured+mutated '())) 109 (cconv-captured+mutated '()))
202 ;; Analyse form - fill these variables with new information. 110 ;; Analyse form - fill these variables with new information.
203 (cconv-analyse-form form '() 0) 111 (cconv-analyse-form form '())
204 ;; Calculate an intersection of cconv-mutated and cconv-captured. 112 (setq cconv-freevars-alist (nreverse cconv-freevars-alist))
205 (dolist (mvr cconv-mutated)
206 (when (memq mvr cconv-captured) ;
207 (push mvr cconv-captured+mutated)))
208 (cconv-closure-convert-rec 113 (cconv-closure-convert-rec
209 form ; the tree 114 form ; the tree
210 '() ; 115 '() ;
@@ -213,15 +118,6 @@ Returns a form where all lambdas don't have any free variables."
213 '() 118 '()
214 ))) 119 )))
215 120
216(defun cconv--lookup-let (table var binder form)
217 (let ((res nil))
218 (dolist (elem table)
219 (when (and (eq (nth 2 elem) binder)
220 (eq (nth 3 elem) form))
221 (assert (eq (car elem) var))
222 (setq res elem)))
223 res))
224
225(defconst cconv--dummy-var (make-symbol "ignored")) 121(defconst cconv--dummy-var (make-symbol "ignored"))
226 122
227(defun cconv--set-diff (s1 s2) 123(defun cconv--set-diff (s1 s2)
@@ -261,6 +157,57 @@ Returns a form where all lambdas don't have any free variables."
261 (unless (memq (car b) s) (push b res))) 157 (unless (memq (car b) s) (push b res)))
262 (nreverse res))) 158 (nreverse res)))
263 159
160(defun cconv-closure-convert-function (fvrs vars emvrs envs lmenvs body-forms
161 parentform)
162 (assert (equal body-forms (caar cconv-freevars-alist)))
163 (let* ((fvrs-new (cconv--set-diff fvrs vars)) ; Remove vars from fvrs.
164 (fv (cdr (pop cconv-freevars-alist)))
165 (body-forms-new '())
166 (letbind '())
167 (envector nil))
168 (when fv
169 ;; Here we form our environment vector.
170
171 (dolist (elm fv)
172 (push
173 (cconv-closure-convert-rec
174 ;; Remove `elm' from `emvrs' for this call because in case
175 ;; `elm' is a variable that's wrapped in a cons-cell, we
176 ;; want to put the cons-cell itself in the closure, rather
177 ;; than just a copy of its current content.
178 elm (remq elm emvrs) fvrs envs lmenvs)
179 envector)) ; Process vars for closure vector.
180 (setq envector (reverse envector))
181 (setq envs fv)
182 (setq fvrs-new fv)) ; Update substitution list.
183
184 (setq emvrs (cconv--set-diff emvrs vars))
185 (setq lmenvs (cconv--map-diff-set lmenvs vars))
186
187 ;; The difference between envs and fvrs is explained
188 ;; in comment in the beginning of the function.
189 (dolist (var vars)
190 (when (member (cons (list var) parentform) cconv-captured+mutated)
191 (push var emvrs)
192 (push `(,var (list ,var)) letbind)))
193 (dolist (elm body-forms) ; convert function body
194 (push (cconv-closure-convert-rec
195 elm emvrs fvrs-new envs lmenvs)
196 body-forms-new))
197
198 (setq body-forms-new
199 (if letbind `((let ,letbind . ,(reverse body-forms-new)))
200 (reverse body-forms-new)))
201
202 (cond
203 ;if no freevars - do nothing
204 ((null envector)
205 `(function (lambda ,vars . ,body-forms-new)))
206 ; 1 free variable - do not build vector
207 (t
208 `(internal-make-closure
209 ,vars ,envector . ,body-forms-new)))))
210
264(defun cconv-closure-convert-rec (form emvrs fvrs envs lmenvs) 211(defun cconv-closure-convert-rec (form emvrs fvrs envs lmenvs)
265 ;; This function actually rewrites the tree. 212 ;; This function actually rewrites the tree.
266 "Eliminates all free variables of all lambdas in given forms. 213 "Eliminates all free variables of all lambdas in given forms.
@@ -303,15 +250,18 @@ Returns a form where all lambdas don't have any free variables."
303 (dolist (binder binders) 250 (dolist (binder binders)
304 (let* ((value nil) 251 (let* ((value nil)
305 (var (if (not (consp binder)) 252 (var (if (not (consp binder))
306 binder 253 (prog1 binder (setq binder (list binder)))
307 (setq value (cadr binder)) 254 (setq value (cadr binder))
308 (car binder))) 255 (car binder)))
309 (new-val 256 (new-val
310 (cond 257 (cond
311 ;; Check if var is a candidate for lambda lifting. 258 ;; Check if var is a candidate for lambda lifting.
312 ((cconv--lookup-let cconv-lambda-candidates var binder form) 259 ((member (cons binder form) cconv-lambda-candidates)
313 260 (assert (and (eq (car value) 'function)
314 (let* ((fv (delete-dups (cconv-freevars value '()))) 261 (eq (car (cadr value)) 'lambda)))
262 (assert (equal (cddr (cadr value))
263 (caar cconv-freevars-alist)))
264 (let* ((fv (cdr (pop cconv-freevars-alist)))
315 (funargs (cadr (cadr value))) 265 (funargs (cadr (cadr value)))
316 (funcvars (append fv funargs)) 266 (funcvars (append fv funargs))
317 (funcbodies (cddadr value)) ; function bodies 267 (funcbodies (cddadr value)) ; function bodies
@@ -338,7 +288,7 @@ Returns a form where all lambdas don't have any free variables."
338 ,(reverse funcbodies-new)))))))) 288 ,(reverse funcbodies-new))))))))
339 289
340 ;; Check if it needs to be turned into a "ref-cell". 290 ;; Check if it needs to be turned into a "ref-cell".
341 ((cconv--lookup-let cconv-captured+mutated var binder form) 291 ((member (cons binder form) cconv-captured+mutated)
342 ;; Declared variable is mutated and captured. 292 ;; Declared variable is mutated and captured.
343 (prog1 293 (prog1
344 `(list ,(cconv-closure-convert-rec 294 `(list ,(cconv-closure-convert-rec
@@ -404,13 +354,12 @@ Returns a form where all lambdas don't have any free variables."
404 )) ; end of dolist over binders 354 )) ; end of dolist over binders
405 (when (eq letsym 'let) 355 (when (eq letsym 'let)
406 356
407 (let (var fvrs-1 emvrs-1 lmenvs-1) 357 ;; Here we update emvrs, fvrs and lmenvs lists
408 ;; Here we update emvrs, fvrs and lmenvs lists 358 (setq fvrs (cconv--set-diff-map fvrs binders-new))
409 (setq fvrs (cconv--set-diff-map fvrs binders-new)) 359 (setq emvrs (cconv--set-diff-map emvrs binders-new))
410 (setq emvrs (cconv--set-diff-map emvrs binders-new)) 360 (setq emvrs (append emvrs emvrs-new))
411 (setq emvrs (append emvrs emvrs-new)) 361 (setq lmenvs (cconv--set-diff-map lmenvs binders-new))
412 (setq lmenvs (cconv--set-diff-map lmenvs binders-new)) 362 (setq lmenvs (append lmenvs lmenvs-new))
413 (setq lmenvs (append lmenvs lmenvs-new)))
414 363
415 ;; Here we do the same letbinding as for let* above 364 ;; Here we do the same letbinding as for let* above
416 ;; to avoid situation when a free variable of a lambda lifted 365 ;; to avoid situation when a free variable of a lambda lifted
@@ -478,56 +427,8 @@ Returns a form where all lambdas don't have any free variables."
478 (`(quote . ,_) form) 427 (`(quote . ,_) form)
479 428
480 (`(function (lambda ,vars . ,body-forms)) ; function form 429 (`(function (lambda ,vars . ,body-forms)) ; function form
481 (let* ((fvrs-new (cconv--set-diff fvrs vars)) ; Remove vars from fvrs. 430 (cconv-closure-convert-function
482 (fv (delete-dups (cconv-freevars form '()))) 431 fvrs vars emvrs envs lmenvs body-forms form))
483 (leave fvrs-new) ; leave=non-nil if we should leave env unchanged.
484 (body-forms-new '())
485 (letbind '())
486 (mv nil)
487 (envector nil))
488 (when fv
489 ;; Here we form our environment vector.
490
491 (dolist (elm fv)
492 (push
493 (cconv-closure-convert-rec
494 ;; Remove `elm' from `emvrs' for this call because in case
495 ;; `elm' is a variable that's wrapped in a cons-cell, we
496 ;; want to put the cons-cell itself in the closure, rather
497 ;; than just a copy of its current content.
498 elm (remq elm emvrs) fvrs envs lmenvs)
499 envector)) ; Process vars for closure vector.
500 (setq envector (reverse envector))
501 (setq envs fv)
502 (setq fvrs-new fv)) ; Update substitution list.
503
504 (setq emvrs (cconv--set-diff emvrs vars))
505 (setq lmenvs (cconv--map-diff-set lmenvs vars))
506
507 ;; The difference between envs and fvrs is explained
508 ;; in comment in the beginning of the function.
509 (dolist (elm cconv-captured+mutated) ; Find mutated arguments
510 (setq mv (car elm)) ; used in inner closures.
511 (when (and (memq mv vars) (eq form (caddr elm)))
512 (progn (push mv emvrs)
513 (push `(,mv (list ,mv)) letbind))))
514 (dolist (elm body-forms) ; convert function body
515 (push (cconv-closure-convert-rec
516 elm emvrs fvrs-new envs lmenvs)
517 body-forms-new))
518
519 (setq body-forms-new
520 (if letbind `((let ,letbind . ,(reverse body-forms-new)))
521 (reverse body-forms-new)))
522
523 (cond
524 ;if no freevars - do nothing
525 ((null envector)
526 `(function (lambda ,vars . ,body-forms-new)))
527 ; 1 free variable - do not build vector
528 (t
529 `(internal-make-closure
530 ,vars ,envector . ,body-forms-new)))))
531 432
532 (`(internal-make-closure . ,_) 433 (`(internal-make-closure . ,_)
533 (error "Internal byte-compiler error: cconv called twice")) 434 (error "Internal byte-compiler error: cconv called twice"))
@@ -548,21 +449,21 @@ Returns a form where all lambdas don't have any free variables."
548 ;defun, defmacro 449 ;defun, defmacro
549 (`(,(and sym (or `defun `defmacro)) 450 (`(,(and sym (or `defun `defmacro))
550 ,func ,vars . ,body-forms) 451 ,func ,vars . ,body-forms)
452
453 ;; The freevar data was pushed onto cconv-freevars-alist
454 ;; but we don't need it.
455 (assert (equal body-forms (caar cconv-freevars-alist)))
456 (assert (null (cdar cconv-freevars-alist)))
457 (setq cconv-freevars-alist (cdr cconv-freevars-alist))
458
551 (let ((body-new '()) ; The whole body. 459 (let ((body-new '()) ; The whole body.
552 (body-forms-new '()) ; Body w\o docstring and interactive. 460 (body-forms-new '()) ; Body w\o docstring and interactive.
553 (letbind '())) 461 (letbind '()))
554 ; Find mutable arguments. 462 ; Find mutable arguments.
555 (dolist (elm vars) 463 (dolist (elm vars)
556 (let ((lmutated cconv-captured+mutated) 464 (when (member (cons (list elm) form) cconv-captured+mutated)
557 (ismutated nil)) 465 (push elm letbind)
558 (while (and lmutated (not ismutated)) 466 (push elm emvrs)))
559 (when (and (eq (caar lmutated) elm)
560 (eq (caddar lmutated) form))
561 (setq ismutated t))
562 (setq lmutated (cdr lmutated)))
563 (when ismutated
564 (push elm letbind)
565 (push elm emvrs))))
566 ;Transform body-forms. 467 ;Transform body-forms.
567 (when (stringp (car body-forms)) ; Treat docstring well. 468 (when (stringp (car body-forms)) ; Treat docstring well.
568 (push (car body-forms) body-new) 469 (push (car body-forms) body-new)
@@ -629,12 +530,13 @@ Returns a form where all lambdas don't have any free variables."
629 (setq value 530 (setq value
630 (cconv-closure-convert-rec 531 (cconv-closure-convert-rec
631 (cadr forms) emvrs fvrs envs lmenvs)) 532 (cadr forms) emvrs fvrs envs lmenvs))
632 (if (memq sym emvrs) 533 (cond
633 (push `(setcar ,sym-new ,value) prognlist) 534 ((memq sym emvrs) (push `(setcar ,sym-new ,value) prognlist))
634 (if (symbolp sym-new) 535 ((symbolp sym-new) (push `(setq ,sym-new ,value) prognlist))
635 (push `(setq ,sym-new ,value) prognlist) 536 ;; This should never happen, but for variables which are
636 (debug) ;FIXME: When can this be right? 537 ;; mutated+captured+unused, we may end up trying to `setq'
637 (push `(set ,sym-new ,value) prognlist))) 538 ;; on a closed-over variable, so just drop the setq.
539 (t (push value prognlist)))
638 (setq forms (cddr forms))) 540 (setq forms (cddr forms)))
639 (if (cdr prognlist) 541 (if (cdr prognlist)
640 `(progn . ,(reverse prognlist)) 542 `(progn . ,(reverse prognlist))
@@ -697,54 +599,110 @@ Returns a form where all lambdas don't have any free variables."
697 `(car ,form) ; replace form => (car form) 599 `(car ,form) ; replace form => (car form)
698 form)))))) 600 form))))))
699 601
700(defun cconv-analyse-function (args body env parentform inclosure) 602(unless (fboundp 'byte-compile-not-lexical-var-p)
701 (dolist (arg args) 603 ;; Only used to test the code in non-lexbind Emacs.
702 (cond 604 (defalias 'byte-compile-not-lexical-var-p 'boundp))
703 ((byte-compile-not-lexical-var-p arg) 605
704 (byte-compile-report-error 606(defun cconv-analyse-use (vardata form)
705 (format "Argument %S is not a lexical variable" arg))) 607 ;; use = `(,binder ,read ,mutated ,captured ,called)
706 ((eq ?& (aref (symbol-name arg) 0)) nil) ;Ignore &rest, &optional, ... 608 (pcase vardata
707 (t (push (list arg inclosure parentform) env)))) ;Push vrs to vars. 609 (`(,binder nil ,_ ,_ nil)
708 (dolist (form body) ;Analyse body forms. 610 ;; FIXME: Don't warn about unused fun-args.
709 (cconv-analyse-form form env inclosure))) 611 ;; FIXME: Don't warn about uninterned vars or _ vars.
710 612 ;; FIXME: This gives warnings in the wrong order and with wrong line
711(defun cconv-analyse-form (form env inclosure) 613 ;; number and without function name info.
712 "Find mutated variables and variables captured by closure. Analyse 614 (byte-compile-log-warning (format "Unused variable %S" (car binder))))
713lambdas if they are suitable for lambda lifting. 615 ;; If it's unused, there's no point converting it into a cons-cell, even if
616 ;; it's captures and mutated.
617 (`(,binder ,_ t t ,_)
618 (push (cons binder form) cconv-captured+mutated))
619 (`(,(and binder `(,_ (function (lambda . ,_)))) nil nil nil t)
620 ;; This is very rare in typical Elisp code. It's probably not really
621 ;; worth the trouble to try and use lambda-lifting in Elisp, but
622 ;; since we coded it up, we might as well use it.
623 (push (cons binder form) cconv-lambda-candidates))
624 (`(,_ ,_ ,_ ,_ ,_) nil)
625 (dontcare)))
626
627(defun cconv-analyse-function (args body env parentform)
628 (let* ((newvars nil)
629 (freevars (list body))
630 ;; We analyze the body within a new environment where all uses are
631 ;; nil, so we can distinguish uses within that function from uses
632 ;; outside of it.
633 (envcopy
634 (mapcar (lambda (vdata) (list (car vdata) nil nil nil nil)) env))
635 (newenv envcopy))
636 ;; Push it before recursing, so cconv-freevars-alist contains entries in
637 ;; the order they'll be used by closure-convert-rec.
638 (push freevars cconv-freevars-alist)
639 (dolist (arg args)
640 (cond
641 ((byte-compile-not-lexical-var-p arg)
642 (byte-compile-report-error
643 (format "Argument %S is not a lexical variable" arg)))
644 ((eq ?& (aref (symbol-name arg) 0)) nil) ;Ignore &rest, &optional, ...
645 (t (let ((varstruct (list arg nil nil nil nil)))
646 (push (cons (list arg) (cdr varstruct)) newvars)
647 (push varstruct newenv)))))
648 (dolist (form body) ;Analyse body forms.
649 (cconv-analyse-form form newenv))
650 ;; Summarize resulting data about arguments.
651 (dolist (vardata newvars)
652 (cconv-analyse-use vardata parentform))
653 ;; Transfer uses collected in `envcopy' (via `newenv') back to `env';
654 ;; and compute free variables.
655 (while env
656 (assert (and envcopy (eq (caar env) (caar envcopy))))
657 (let ((free nil)
658 (x (cdr (car env)))
659 (y (cdr (car envcopy))))
660 (while x
661 (when (car y) (setcar x t) (setq free t))
662 (setq x (cdr x) y (cdr y)))
663 (when free
664 (push (caar env) (cdr freevars))
665 (setf (nth 3 (car env)) t))
666 (setq env (cdr env) envcopy (cdr envcopy))))))
667
668(defun cconv-analyse-form (form env)
669 "Find mutated variables and variables captured by closure.
670Analyse lambdas if they are suitable for lambda lifting.
714-- FORM is a piece of Elisp code after macroexpansion. 671-- FORM is a piece of Elisp code after macroexpansion.
715-- ENV is a list of variables visible in current lexical environment. 672-- ENV is an alist mapping each enclosing lexical variable to its info.
716 Each entry has the form (VAR INCLOSURE BINDER PARENTFORM) 673 I.e. each element has the form (VAR . (READ MUTATED CAPTURED CALLED)).
717 for let-bound vars and (VAR INCLOSURE PARENTFORM) for function arguments. 674This function does not return anything but instead fills the
718-- INCLOSURE is the nesting level within lambdas." 675`cconv-captured+mutated' and `cconv-lambda-candidates' variables
676and updates the data stored in ENV."
719 (pcase form 677 (pcase form
720 ; let special form 678 ; let special form
721 (`(,(and (or `let* `let) letsym) ,binders . ,body-forms) 679 (`(,(and (or `let* `let) letsym) ,binders . ,body-forms)
722 680
723 (let ((orig-env env) 681 (let ((orig-env env)
682 (newvars nil)
724 (var nil) 683 (var nil)
725 (value nil)) 684 (value nil))
726 (dolist (binder binders) 685 (dolist (binder binders)
727 (if (not (consp binder)) 686 (if (not (consp binder))
728 (progn 687 (progn
729 (setq var binder) ; treat the form (let (x) ...) well 688 (setq var binder) ; treat the form (let (x) ...) well
689 (setq binder (list binder))
730 (setq value nil)) 690 (setq value nil))
731 (setq var (car binder)) 691 (setq var (car binder))
732 (setq value (cadr binder)) 692 (setq value (cadr binder))
733 693
734 (cconv-analyse-form value (if (eq letsym 'let*) env orig-env) 694 (cconv-analyse-form value (if (eq letsym 'let*) env orig-env)))
735 inclosure))
736 695
737 (unless (byte-compile-not-lexical-var-p var) 696 (unless (byte-compile-not-lexical-var-p var)
738 (let ((varstruct (list var inclosure binder form))) 697 (let ((varstruct (list var nil nil nil nil)))
739 (push varstruct env) ; Push a new one. 698 (push (cons binder (cdr varstruct)) newvars)
699 (push varstruct env))))
740 700
741 (pcase value 701 (dolist (form body-forms) ; Analyse body forms.
742 (`(function (lambda . ,_)) 702 (cconv-analyse-form form env))
743 ;; If var is a function push it to lambda list.
744 (push varstruct cconv-lambda-candidates)))))))
745 703
746 (dolist (form body-forms) ; Analyse body forms. 704 (dolist (vardata newvars)
747 (cconv-analyse-form form env inclosure))) 705 (cconv-analyse-use vardata form))))
748 706
749 ; defun special form 707 ; defun special form
750 (`(,(or `defun `defmacro) ,func ,vrs . ,body-forms) 708 (`(,(or `defun `defmacro) ,func ,vrs . ,body-forms)
@@ -753,33 +711,28 @@ lambdas if they are suitable for lambda lifting.
753 (format "Function %S will ignore its context %S" 711 (format "Function %S will ignore its context %S"
754 func (mapcar #'car env)) 712 func (mapcar #'car env))
755 t :warning)) 713 t :warning))
756 (cconv-analyse-function vrs body-forms nil form 0)) 714 (cconv-analyse-function vrs body-forms nil form))
757 715
758 (`(function (lambda ,vrs . ,body-forms)) 716 (`(function (lambda ,vrs . ,body-forms))
759 (cconv-analyse-function vrs body-forms env form (1+ inclosure))) 717 (cconv-analyse-function vrs body-forms env form))
760 718
761 (`(setq . ,forms) 719 (`(setq . ,forms)
762 ;; If a local variable (member of env) is modified by setq then 720 ;; If a local variable (member of env) is modified by setq then
763 ;; it is a mutated variable. 721 ;; it is a mutated variable.
764 (while forms 722 (while forms
765 (let ((v (assq (car forms) env))) ; v = non nil if visible 723 (let ((v (assq (car forms) env))) ; v = non nil if visible
766 (when v 724 (when v (setf (nth 2 v) t)))
767 (push v cconv-mutated) 725 (cconv-analyse-form (cadr forms) env)
768 ;; Delete from candidate list for lambda lifting.
769 (setq cconv-lambda-candidates (delq v cconv-lambda-candidates))
770 (unless (eq inclosure (cadr v)) ;Bound in a different closure level.
771 (push v cconv-captured))))
772 (cconv-analyse-form (cadr forms) env inclosure)
773 (setq forms (cddr forms)))) 726 (setq forms (cddr forms))))
774 727
775 (`((lambda . ,_) . ,_) ; first element is lambda expression 728 (`((lambda . ,_) . ,_) ; first element is lambda expression
776 (dolist (exp `((function ,(car form)) . ,(cdr form))) 729 (dolist (exp `((function ,(car form)) . ,(cdr form)))
777 (cconv-analyse-form exp env inclosure))) 730 (cconv-analyse-form exp env)))
778 731
779 (`(cond . ,cond-forms) ; cond special form 732 (`(cond . ,cond-forms) ; cond special form
780 (dolist (forms cond-forms) 733 (dolist (forms cond-forms)
781 (dolist (form forms) 734 (dolist (form forms)
782 (cconv-analyse-form form env inclosure)))) 735 (cconv-analyse-form form env))))
783 736
784 (`(quote . ,_) nil) ; quote form 737 (`(quote . ,_) nil) ; quote form
785 (`(function . ,_) nil) ; same as quote 738 (`(function . ,_) nil) ; same as quote
@@ -788,63 +741,44 @@ lambdas if they are suitable for lambda lifting.
788 ;; FIXME: The bytecode for condition-case forces us to wrap the 741 ;; FIXME: The bytecode for condition-case forces us to wrap the
789 ;; form and handlers in closures (for handlers, it's probably 742 ;; form and handlers in closures (for handlers, it's probably
790 ;; unavoidable, but not for the protected form). 743 ;; unavoidable, but not for the protected form).
791 (setq inclosure (1+ inclosure)) 744 (cconv-analyse-function () (list protected-form) env form)
792 (cconv-analyse-form protected-form env inclosure)
793 (push (list var inclosure form) env)
794 (dolist (handler handlers) 745 (dolist (handler handlers)
795 (dolist (form (cdr handler)) 746 (cconv-analyse-function (if var (list var)) (cdr handler) env form)))
796 (cconv-analyse-form form env inclosure))))
797 747
798 ;; FIXME: The bytecode for catch forces us to wrap the body. 748 ;; FIXME: The bytecode for catch forces us to wrap the body.
799 (`(,(or `catch `unwind-protect) ,form . ,body) 749 (`(,(or `catch `unwind-protect) ,form . ,body)
800 (cconv-analyse-form form env inclosure) 750 (cconv-analyse-form form env)
801 (setq inclosure (1+ inclosure)) 751 (cconv-analyse-function () body env form))
802 (dolist (form body)
803 (cconv-analyse-form form env inclosure)))
804 752
805 ;; FIXME: The bytecode for save-window-excursion and the lack of 753 ;; FIXME: The bytecode for save-window-excursion and the lack of
806 ;; bytecode for track-mouse forces us to wrap the body. 754 ;; bytecode for track-mouse forces us to wrap the body.
807 (`(track-mouse . ,body) 755 (`(track-mouse . ,body)
808 (setq inclosure (1+ inclosure)) 756 (cconv-analyse-function () body env form))
809 (dolist (form body)
810 (cconv-analyse-form form env inclosure)))
811 757
812 (`(,(or `defconst `defvar) ,var ,value . ,_) 758 (`(,(or `defconst `defvar) ,var ,value . ,_)
813 (push var byte-compile-bound-variables) 759 (push var byte-compile-bound-variables)
814 (cconv-analyse-form value env inclosure)) 760 (cconv-analyse-form value env))
815 761
816 (`(,(or `funcall `apply) ,fun . ,args) 762 (`(,(or `funcall `apply) ,fun . ,args)
817 ;; Here we ignore fun because funcall and apply are the only two 763 ;; Here we ignore fun because funcall and apply are the only two
818 ;; functions where we can pass a candidate for lambda lifting as 764 ;; functions where we can pass a candidate for lambda lifting as
819 ;; argument. So, if we see fun elsewhere, we'll delete it from 765 ;; argument. So, if we see fun elsewhere, we'll delete it from
820 ;; lambda candidate list. 766 ;; lambda candidate list.
821 (if (symbolp fun) 767 (let ((fdata (and (symbolp fun) (assq fun env))))
822 (let ((lv (assq fun cconv-lambda-candidates))) 768 (if fdata
823 (when lv 769 (setf (nth 4 fdata) t)
824 (unless (eq (cadr lv) inclosure) 770 (cconv-analyse-form fun env)))
825 (push lv cconv-captured)
826 ;; If this funcall and the definition of fun are in
827 ;; different closures - we delete fun from candidate
828 ;; list, because it is too complicated to manage free
829 ;; variables in this case.
830 (setq cconv-lambda-candidates
831 (delq lv cconv-lambda-candidates)))))
832 (cconv-analyse-form fun env inclosure))
833 (dolist (form args) 771 (dolist (form args)
834 (cconv-analyse-form form env inclosure))) 772 (cconv-analyse-form form env)))
835 773
836 (`(,_ . ,body-forms) ; First element is a function or whatever. 774 (`(,_ . ,body-forms) ; First element is a function or whatever.
837 (dolist (form body-forms) 775 (dolist (form body-forms)
838 (cconv-analyse-form form env inclosure))) 776 (cconv-analyse-form form env)))
839 777
840 ((pred symbolp) 778 ((pred symbolp)
841 (let ((dv (assq form env))) ; dv = declared and visible 779 (let ((dv (assq form env))) ; dv = declared and visible
842 (when dv 780 (when dv
843 (unless (eq inclosure (cadr dv)) ; capturing condition 781 (setf (nth 1 dv) t))))))
844 (push dv cconv-captured))
845 ;; Delete lambda if it is found here, since it escapes.
846 (setq cconv-lambda-candidates
847 (delq dv cconv-lambda-candidates)))))))
848 782
849(provide 'cconv) 783(provide 'cconv)
850;;; cconv.el ends here 784;;; cconv.el ends here
diff --git a/lisp/emacs-lisp/debug.el b/lisp/emacs-lisp/debug.el
index 0b2ea81fb64..0bdab919434 100644
--- a/lisp/emacs-lisp/debug.el
+++ b/lisp/emacs-lisp/debug.el
@@ -269,6 +269,7 @@ That buffer should be current already."
269 (setq buffer-undo-list t) 269 (setq buffer-undo-list t)
270 (let ((standard-output (current-buffer)) 270 (let ((standard-output (current-buffer))
271 (print-escape-newlines t) 271 (print-escape-newlines t)
272 (print-quoted t) ;Doesn't seem to work :-(
272 (print-level 1000) ;8 273 (print-level 1000) ;8
273 ;; (print-length 50) 274 ;; (print-length 50)
274 ) 275 )
diff --git a/lisp/emacs-lisp/macroexp.el b/lisp/emacs-lisp/macroexp.el
index 781195d034a..4377797cba8 100644
--- a/lisp/emacs-lisp/macroexp.el
+++ b/lisp/emacs-lisp/macroexp.el
@@ -1,4 +1,4 @@
1;;; macroexp.el --- Additional macro-expansion support 1;;; macroexp.el --- Additional macro-expansion support -*- lexical-binding: t -*-
2;; 2;;
3;; Copyright (C) 2004-2011 Free Software Foundation, Inc. 3;; Copyright (C) 2004-2011 Free Software Foundation, Inc.
4;; 4;;
@@ -108,7 +108,14 @@ Assumes the caller has bound `macroexpand-all-environment'."
108 (macroexpand (macroexpand-all-forms form 1) 108 (macroexpand (macroexpand-all-forms form 1)
109 macroexpand-all-environment) 109 macroexpand-all-environment)
110 ;; Normal form; get its expansion, and then expand arguments. 110 ;; Normal form; get its expansion, and then expand arguments.
111 (setq form (macroexpand form macroexpand-all-environment)) 111 (let ((new-form (macroexpand form macroexpand-all-environment)))
112 (when (and (not (eq form new-form)) ;It was a macro call.
113 (car-safe form)
114 (symbolp (car form))
115 (get (car form) 'byte-obsolete-info)
116 (fboundp 'byte-compile-warn-obsolete))
117 (byte-compile-warn-obsolete (car form)))
118 (setq form new-form))
112 (pcase form 119 (pcase form
113 (`(cond . ,clauses) 120 (`(cond . ,clauses)
114 (maybe-cons 'cond (macroexpand-all-clauses clauses) form)) 121 (maybe-cons 'cond (macroexpand-all-clauses clauses) form))
diff --git a/lisp/follow.el b/lisp/follow.el
index 7e6d4e7ee35..7f4093dd442 100644
--- a/lisp/follow.el
+++ b/lisp/follow.el
@@ -871,8 +871,7 @@ Returns (end-pos end-of-buffer-p)"
871 ;; XEmacs can calculate the end of the window by using 871 ;; XEmacs can calculate the end of the window by using
872 ;; the 'guarantee options. GOOD! 872 ;; the 'guarantee options. GOOD!
873 (let ((end (window-end win t))) 873 (let ((end (window-end win t)))
874 (if (= end (funcall (symbol-function 'point-max) 874 (if (= end (point-max (window-buffer win)))
875 (window-buffer win)))
876 (list end t) 875 (list end t)
877 (list (+ end 1) nil))) 876 (list (+ end 1) nil)))
878 ;; Emacs: We have to calculate the end by ourselves. 877 ;; Emacs: We have to calculate the end by ourselves.
diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el
index 13d10f02b41..59e442a89c3 100644
--- a/lisp/vc/diff-mode.el
+++ b/lisp/vc/diff-mode.el
@@ -1,4 +1,4 @@
1;;; diff-mode.el --- a mode for viewing/editing context diffs 1;;; diff-mode.el --- a mode for viewing/editing context diffs -*- lexical-binding: t -*-
2 2
3;; Copyright (C) 1998-2011 Free Software Foundation, Inc. 3;; Copyright (C) 1998-2011 Free Software Foundation, Inc.
4 4
@@ -1278,7 +1278,7 @@ a diff with \\[diff-reverse-direction].
1278 (add-hook 'after-change-functions 'diff-after-change-function nil t) 1278 (add-hook 'after-change-functions 'diff-after-change-function nil t)
1279 (add-hook 'post-command-hook 'diff-post-command-hook nil t)) 1279 (add-hook 'post-command-hook 'diff-post-command-hook nil t))
1280 ;; Neat trick from Dave Love to add more bindings in read-only mode: 1280 ;; Neat trick from Dave Love to add more bindings in read-only mode:
1281 (lexical-let ((ro-bind (cons 'buffer-read-only diff-mode-shared-map))) 1281 (let ((ro-bind (cons 'buffer-read-only diff-mode-shared-map)))
1282 (add-to-list 'minor-mode-overriding-map-alist ro-bind) 1282 (add-to-list 'minor-mode-overriding-map-alist ro-bind)
1283 ;; Turn off this little trick in case the buffer is put in view-mode. 1283 ;; Turn off this little trick in case the buffer is put in view-mode.
1284 (add-hook 'view-mode-hook 1284 (add-hook 'view-mode-hook
diff --git a/src/bytecode.c b/src/bytecode.c
index 464bc3d12de..9693a5a9196 100644
--- a/src/bytecode.c
+++ b/src/bytecode.c
@@ -51,7 +51,7 @@ by Hallvard:
51 * 51 *
52 * define BYTE_CODE_METER to enable generation of a byte-op usage histogram. 52 * define BYTE_CODE_METER to enable generation of a byte-op usage histogram.
53 */ 53 */
54/* #define BYTE_CODE_SAFE */ 54#define BYTE_CODE_SAFE 1
55/* #define BYTE_CODE_METER */ 55/* #define BYTE_CODE_METER */
56 56
57 57