diff options
| author | Stefan Monnier | 2011-02-26 10:19:08 -0500 |
|---|---|---|
| committer | Stefan Monnier | 2011-02-26 10:19:08 -0500 |
| commit | a9de04fa62f123413d82b7b7b1e7a77705eb82dd (patch) | |
| tree | 84292e07c3583dee99376669fb799d8c93cdd5ff | |
| parent | 876c194cbac17a6220dbf406b0a602325978011c (diff) | |
| download | emacs-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/ChangeLog | 33 | ||||
| -rw-r--r-- | lisp/Makefile.in | 8 | ||||
| -rw-r--r-- | lisp/emacs-lisp/byte-run.el | 10 | ||||
| -rw-r--r-- | lisp/emacs-lisp/bytecomp.el | 123 | ||||
| -rw-r--r-- | lisp/emacs-lisp/cconv.el | 468 | ||||
| -rw-r--r-- | lisp/emacs-lisp/debug.el | 1 | ||||
| -rw-r--r-- | lisp/emacs-lisp/macroexp.el | 11 | ||||
| -rw-r--r-- | lisp/follow.el | 3 | ||||
| -rw-r--r-- | lisp/vc/diff-mode.el | 4 | ||||
| -rw-r--r-- | src/bytecode.c | 2 |
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 @@ | |||
| 1 | 2011-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 | |||
| 1 | 2011-02-25 Stefan Monnier <monnier@iro.umontreal.ca> | 34 | 2011-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 | # |
| 77 | BIG_STACK_DEPTH = 1000 | 77 | BIG_STACK_DEPTH = 1200 |
| 78 | BIG_STACK_OPTS = --eval "(setq max-lisp-eval-depth $(BIG_STACK_DEPTH))" | 78 | BIG_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 | |||
| 123 | If provided, WHEN should be a string indicating when the function | 123 | If provided, WHEN should be a string indicating when the function |
| 124 | was first made obsolete, for example a date or a release number." | 124 | was 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 |
| 84 | is less than this number.") | 84 | is 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. | ||
| 93 | Each candidate has the form (VAR INCLOSURE BINDER PARENTFORM).") | ||
| 94 | |||
| 95 | (defun cconv-freevars (form &optional fvrs) | ||
| 96 | "Find all free variables of given form. | ||
| 97 | Arguments: | ||
| 98 | -- FORM is a piece of Elisp code after macroexpansion. | ||
| 99 | -- FVRS(optional) is a list of variables already found. Used for recursive tree | ||
| 100 | traversal | ||
| 101 | |||
| 102 | Returns 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 | ||
| 196 | Returns a form where all lambdas don't have any free variables." | 105 | Returns 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)))) |
| 713 | lambdas 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. | ||
| 670 | Analyse 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. | 674 | This 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 |
| 676 | and 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 | ||