From 295fb2ac59b66c0e2470325a42c8e58c135ed044 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 11 Feb 2011 17:30:02 -0500 Subject: [PATCH] Let cconv use :fun-body in special forms that need it. * lisp/emacs-lisp/cconv.el (cconv-closure-convert): Drop `toplevel' arg. (cconv-closure-convert-toplevel): Remove. (cconv-lookup-let): New fun. (cconv-closure-convert-rec): Don't bother with defs-are-legal. Use :fun-body to handle special forms that require closing their forms. * lisp/emacs-lisp/bytecomp.el (byte-compile-file-form, byte-compile): Use cconv-closure-convert instead of cconv-closure-convert-toplevel. (byte-compile-lambda, byte-compile-make-closure): * lisp/emacs-lisp/byte-lexbind.el (byte-compile-maybe-push-heap-environment): Make sure cconv did its job. * lisp/emacs-lisp/byte-opt.el (byte-optimize-lapcode): Check stack-depth before using it. * lisp/dired.el (dired-desktop-buffer-misc-data): Don't use a dynamic var as function argument. --- lisp/ChangeLog | 20 ++ lisp/dired.el | 11 +- lisp/emacs-lisp/byte-lexbind.el | 1 + lisp/emacs-lisp/byte-opt.el | 11 +- lisp/emacs-lisp/bytecomp.el | 10 +- lisp/emacs-lisp/cconv.el | 347 +++++++++++++++----------------- lisp/mpc.el | 3 +- 7 files changed, 201 insertions(+), 202 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 6a47a2626a..c3451d9b26 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,23 @@ +2011-02-11 Stefan Monnier + + * emacs-lisp/cconv.el (cconv-closure-convert): Drop `toplevel' arg. + (cconv-closure-convert-toplevel): Remove. + (cconv-lookup-let): New fun. + (cconv-closure-convert-rec): Don't bother with defs-are-legal. + Use :fun-body to handle special forms that require closing their forms. + + * emacs-lisp/bytecomp.el (byte-compile-file-form, byte-compile): + Use cconv-closure-convert instead of cconv-closure-convert-toplevel. + (byte-compile-lambda, byte-compile-make-closure): + * emacs-lisp/byte-lexbind.el (byte-compile-maybe-push-heap-environment): + Make sure cconv did its job. + + * emacs-lisp/byte-opt.el (byte-optimize-lapcode): Check stack-depth + before using it. + + * dired.el (dired-desktop-buffer-misc-data): Don't use a dynamic var as + function argument. + 2011-02-11 Stefan Monnier * emacs-lisp/bytecomp.el (byte-compile-lambda): Fix `fun' that was not diff --git a/lisp/dired.el b/lisp/dired.el index f98ad641fe..92cbdd32c8 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -1,5 +1,4 @@ -;;; -*- lexical-binding: t -*- -;;; dired.el --- directory-browsing commands +;;; dired.el --- directory-browsing commands -*- lexical-binding: t -*- ;; Copyright (C) 1985-1986, 1992-1997, 2000-2011 ;; Free Software Foundation, Inc. @@ -3507,21 +3506,21 @@ Ask means pop up a menu for the user to select one of copy, move or link." (eval-when-compile (require 'desktop)) -(defun dired-desktop-buffer-misc-data (desktop-dirname) +(defun dired-desktop-buffer-misc-data (dirname) "Auxiliary information to be saved in desktop file." (cons ;; Value of `dired-directory'. (if (consp dired-directory) ;; Directory name followed by list of files. - (cons (desktop-file-name (car dired-directory) desktop-dirname) + (cons (desktop-file-name (car dired-directory) dirname) (cdr dired-directory)) ;; Directory name, optionally with shell wildcard. - (desktop-file-name dired-directory desktop-dirname)) + (desktop-file-name dired-directory dirname)) ;; Subdirectories in `dired-subdir-alist'. (cdr (nreverse (mapcar - (function (lambda (f) (desktop-file-name (car f) desktop-dirname))) + (function (lambda (f) (desktop-file-name (car f) dirname))) dired-subdir-alist))))) (defun dired-restore-desktop-buffer (desktop-buffer-file-name diff --git a/lisp/emacs-lisp/byte-lexbind.el b/lisp/emacs-lisp/byte-lexbind.el index 313c4b6ad0..06353e2eea 100644 --- a/lisp/emacs-lisp/byte-lexbind.el +++ b/lisp/emacs-lisp/byte-lexbind.el @@ -585,6 +585,7 @@ proper scope)." (= nclosures byte-compile-current-num-closures)) ;; No need to push a heap environment. nil + (error "Should have been handled by cconv") ;; Have to push one. A heap environment is really just a vector, so ;; we emit bytecodes to create a vector. However, the size is not ;; fixed yet (the vector can grow if subforms use it to store diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index 02107b0e11..97ed6a01c2 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -1863,7 +1863,7 @@ If FOR-EFFECT is non-nil, the return value is assumed to be of no importance." ;; ;; stack-ref-N --> dup ; where N is TOS ;; - ((and (eq (car lap0) 'byte-stack-ref) + ((and stack-depth (eq (car lap0) 'byte-stack-ref) (= (cdr lap0) (1- stack-depth))) (setcar lap0 'byte-dup) (setcdr lap0 nil) @@ -2093,7 +2093,8 @@ If FOR-EFFECT is non-nil, the return value is assumed to be of no importance." ;; stack-set-M [discard/discardN ...] --> discardN-preserve-tos ;; stack-set-M [discard/discardN ...] --> discardN ;; - ((and (eq (car lap0) 'byte-stack-set) + ((and stack-depth ;Make sure we know the stack depth. + (eq (car lap0) 'byte-stack-set) (memq (car lap1) '(byte-discard byte-discardN)) (progn ;; See if enough discard operations follow to expose or @@ -2161,7 +2162,8 @@ If FOR-EFFECT is non-nil, the return value is assumed to be of no importance." ;; dup return --> return ;; stack-set-N return --> return ; where N is TOS-1 ;; - ((and (eq (car lap1) 'byte-return) + ((and stack-depth ;Make sure we know the stack depth. + (eq (car lap1) 'byte-return) (or (memq (car lap0) '(byte-discardN-preserve-tos byte-dup)) (and (eq (car lap0) 'byte-stack-set) (= (cdr lap0) (- stack-depth 2))))) @@ -2174,7 +2176,8 @@ If FOR-EFFECT is non-nil, the return value is assumed to be of no importance." ;; ;; dup stack-set-N return --> return ; where N is TOS ;; - ((and (eq (car lap0) 'byte-dup) + ((and stack-depth ;Make sure we know the stack depth. + (eq (car lap0) 'byte-dup) (eq (car lap1) 'byte-stack-set) (eq (car (car (cdr (cdr rest)))) 'byte-return) (= (cdr lap1) (1- stack-depth))) diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index f37d7489e9..33940ec160 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -134,7 +134,7 @@ ;; `eval-when-compile' is defined in byte-run.el, so it must come after the ;; preceding load expression. (provide 'bytecomp-preload) -(eval-when-compile (require 'byte-lexbind)) +(eval-when-compile (require 'byte-lexbind nil 'noerror)) ;; The feature of compiling in a specific target Emacs version ;; has been turned off because compile time options are a bad idea. @@ -2240,7 +2240,7 @@ list that represents a doc string reference. bytecomp-handler) (setq form (macroexpand-all form byte-compile-macro-environment)) (if lexical-binding - (setq form (cconv-closure-convert-toplevel form))) + (setq form (cconv-closure-convert form))) (cond ((not (consp form)) (byte-compile-keep-pending form)) ((and (symbolp (car form)) @@ -2592,7 +2592,7 @@ If FORM is a lambda or a macro, byte-compile it as a function." (macroexpand-all fun byte-compile-initial-macro-environment)) (if lexical-binding - (setq fun (cconv-closure-convert-toplevel fun))) + (setq fun (cconv-closure-convert fun))) ;; get rid of the `function' quote added by the `lambda' macro (setq fun (cadr fun)) (setq fun (if macro @@ -2753,7 +2753,8 @@ If FORM is a lambda or a macro, byte-compile it as a function." ;; containing lexical environment are closed over). (and lexical-binding (byte-compile-closure-initial-lexenv-p - byte-compile-lexical-environment))) + byte-compile-lexical-environment) + (error "Should have been handled by cconv"))) (byte-compile-current-heap-environment nil) (byte-compile-current-num-closures 0) (compiled @@ -2791,6 +2792,7 @@ If FORM is a lambda or a macro, byte-compile it as a function." (eq (car-safe code) 'closure)) (defun byte-compile-make-closure (code) + (error "Should have been handled by cconv") ;; A real closure requires that the constant be curried with an ;; environment vector to make a closure object. (if for-effect diff --git a/lisp/emacs-lisp/cconv.el b/lisp/emacs-lisp/cconv.el index af42a2864c..efb9d061b5 100644 --- a/lisp/emacs-lisp/cconv.el +++ b/lisp/emacs-lisp/cconv.el @@ -87,7 +87,9 @@ Each candidate has the form (VAR INCLOSURE BINDER PARENTFORM).") (defun cconv-not-lexical-var-p (var) (or (not (symbolp var)) ; form is not a list - (special-variable-p var) + (if (eval-when-compile (fboundp 'special-variable-p)) + (special-variable-p var) + (boundp var)) ;; byte-compile-bound-variables normally holds both the ;; dynamic and lexical vars, but the bytecomp.el should ;; only call us at the top-level so there shouldn't be @@ -192,14 +194,8 @@ Returns a list of free variables." (cons form fvrs))))) ;;;###autoload -(defun cconv-closure-convert (form &optional toplevel) - ;; cconv-closure-convert-rec has a lot of parameters that are - ;; whether useless for user, whether they should contain - ;; specific data like a list of closure mutables or the list - ;; of lambdas suitable for lifting. - ;; - ;; That's why this function exists. - "Main entry point for non-toplevel forms. +(defun cconv-closure-convert (form) + "Main entry point for closure conversion. -- FORM is a piece of Elisp code after macroexpansion. -- TOPLEVEL(optional) is a boolean variable, true if we are at the root of AST @@ -221,19 +217,21 @@ Returns a form where all lambdas don't have any free variables." '() ; fvrs initially empty '() ; envs initially empty '() - toplevel))) ; true if the tree is a toplevel form + ))) -;;;###autoload -(defun cconv-closure-convert-toplevel (form) - "Entry point for toplevel forms. --- FORM is a piece of Elisp code after macroexpansion. +(defun cconv-lookup-let (table var binder form) + (let ((res nil)) + (dolist (elem table) + (when (and (eq (nth 2 elem) binder) + (eq (nth 3 elem) form)) + (assert (eq (car elem) var)) + (setq res elem))) + res)) -Returns a form where all lambdas don't have any free variables." - ;; we distinguish toplevel forms to treat def(un|var|const) correctly. - (cconv-closure-convert form t)) +(defconst cconv--dummy-var (make-symbol "ignored")) (defun cconv-closure-convert-rec - (form emvrs fvrs envs lmenvs defs-are-legal) + (form emvrs fvrs envs lmenvs) ;; This function actually rewrites the tree. "Eliminates all free variables of all lambdas in given forms. Arguments: @@ -245,8 +243,6 @@ within current environment. Initially empty. -- FVRS is a list of variables to substitute in each context. Initially empty. --- DEFS-ARE-LEGAL is a boolean variable, true if def(un|var|const) -can be used in this form(e.g. toplevel form) Returns a form where all lambdas don't have any free variables." ;; What's the difference between fvrs and envs? @@ -261,11 +257,11 @@ Returns a form where all lambdas don't have any free variables." ;; so we never touch it(unless we enter to the other closure). ;;(if (listp form) (print (car form)) form) (pcase form - (`(,(and letsym (or `let* `let)) ,varsvalues . ,body-forms) + (`(,(and letsym (or `let* `let)) ,binders . ,body-forms) ; let and let* special forms (let ((body-forms-new '()) - (varsvalues-new '()) + (binders-new '()) ;; next for variables needed for delayed push ;; because we should process ;; before we change any arguments @@ -274,83 +270,58 @@ Returns a form where all lambdas don't have any free variables." (emvr-push) ;needed only in case of let* (lmenv-push)) ;needed only in case of let* - (dolist (elm varsvalues) ;begin of dolist over varsvalues - (let (var value elm-new iscandidate ismutated) - (if (consp elm) ; (let (v1) ...) => (let ((v1 nil)) ...) - (progn - (setq var (car elm)) - (setq value (cadr elm))) - (setq var elm)) - - ;; Check if var is a candidate for lambda lifting - (let ((lcandid cconv-lambda-candidates)) - (while (and lcandid (not iscandidate)) - (when (and (eq (caar lcandid) var) - (eq (caddar lcandid) elm) - (eq (cadr (cddar lcandid)) form)) - (setq iscandidate t)) - (setq lcandid (cdr lcandid)))) - - ; declared variable is a candidate - ; for lambda lifting - (if iscandidate - (let* ((func (cadr elm)) ; function(lambda) itself - ; free variables - (fv (delete-dups (cconv-freevars func '()))) - (funcvars (append fv (cadadr func))) ;function args - (funcbodies (cddadr func)) ; function bodies - (funcbodies-new '())) + (dolist (binder binders) + (let* ((value nil) + (var (if (not (consp binder)) + binder + (setq value (cadr binder)) + (car binder))) + (new-val + (cond + ;; Check if var is a candidate for lambda lifting. + ((cconv-lookup-let cconv-lambda-candidates var binder form) + + (let* ((fv (delete-dups (cconv-freevars value '()))) + (funargs (cadr (cadr value))) + (funcvars (append fv funargs)) + (funcbodies (cddadr value)) ; function bodies + (funcbodies-new '())) ; lambda lifting condition - (if (or (not fv) (< cconv-liftwhen (length funcvars))) + (if (or (not fv) (< cconv-liftwhen (length funcvars))) ; do not lift - (setq - elm-new - `(,var - ,(cconv-closure-convert-rec - func emvrs fvrs envs lmenvs nil))) + (cconv-closure-convert-rec + value emvrs fvrs envs lmenvs) ; lift - (progn - (dolist (elm2 funcbodies) - (push ; convert function bodies - (cconv-closure-convert-rec - elm2 emvrs nil envs lmenvs nil) - funcbodies-new)) - (if (eq letsym 'let*) - (setq lmenv-push (cons var fv)) - (push (cons var fv) lmenvs-new)) + (progn + (dolist (elm2 funcbodies) + (push ; convert function bodies + (cconv-closure-convert-rec + elm2 emvrs nil envs lmenvs) + funcbodies-new)) + (if (eq letsym 'let*) + (setq lmenv-push (cons var fv)) + (push (cons var fv) lmenvs-new)) ; push lifted function - (setq elm-new - `(,var - (function . - ((lambda ,funcvars . - ,(reverse funcbodies-new))))))))) - - ;declared variable is not a function - (progn - ;; Check if var is mutated - (let ((lmutated cconv-captured+mutated)) - (while (and lmutated (not ismutated)) - (when (and (eq (caar lmutated) var) - (eq (caddar lmutated) elm) - (eq (cadr (cddar lmutated)) form)) - (setq ismutated t)) - (setq lmutated (cdr lmutated)))) - (if ismutated - (progn ; declared variable is mutated - (setq elm-new - `(,var (list ,(cconv-closure-convert-rec - value emvrs - fvrs envs lmenvs nil)))) + `(function . + ((lambda ,funcvars . + ,(reverse funcbodies-new)))))))) + + ;; Check if it needs to be turned into a "ref-cell". + ((cconv-lookup-let cconv-captured+mutated var binder form) + ;; Declared variable is mutated and captured. + (prog1 + `(list ,(cconv-closure-convert-rec + value emvrs + fvrs envs lmenvs)) (if (eq letsym 'let*) (setq emvr-push var) - (push var emvrs-new))) - (progn - (setq - elm-new - `(,var ; else - ,(cconv-closure-convert-rec - value emvrs fvrs envs lmenvs nil))))))) + (push var emvrs-new)))) + + ;; Normal default case. + (t + (cconv-closure-convert-rec + value emvrs fvrs envs lmenvs))))) ;; this piece of code below letbinds free ;; variables of a lambda lifted function @@ -384,12 +355,12 @@ Returns a form where all lambdas don't have any free variables." (when new-lmenv (setq lmenvs (remq old-lmenv lmenvs)) (push new-lmenv lmenvs) - (push `(,closedsym ,var) varsvalues-new)))) + (push `(,closedsym ,var) binders-new)))) ;; we push the element after redefined free variables ;; are processes. this is important to avoid the bug ;; when free variable and the function have the same ;; name - (push elm-new varsvalues-new) + (push (list var new-val) binders-new) (when (eq letsym 'let*) ; update fvrs (setq fvrs (remq var fvrs)) @@ -405,23 +376,23 @@ Returns a form where all lambdas don't have any free variables." (when lmenv-push (push lmenv-push lmenvs) (setq lmenv-push nil))) - )) ; end of dolist over varsvalues + )) ; end of dolist over binders (when (eq letsym 'let) (let (var fvrs-1 emvrs-1 lmenvs-1) ;; Here we update emvrs, fvrs and lmenvs lists (dolist (vr fvrs) ; safely remove - (when (not (assq vr varsvalues-new)) (push vr fvrs-1))) + (when (not (assq vr binders-new)) (push vr fvrs-1))) (setq fvrs fvrs-1) (dolist (vr emvrs) ; safely remove - (when (not (assq vr varsvalues-new)) (push vr emvrs-1))) + (when (not (assq vr binders-new)) (push vr emvrs-1))) (setq emvrs emvrs-1) ; push new (setq emvrs (append emvrs emvrs-new)) (dolist (vr lmenvs) - (when (not (assq (car vr) varsvalues-new)) + (when (not (assq (car vr) binders-new)) (push vr lmenvs-1))) (setq lmenvs (append lmenvs lmenvs-new))) @@ -432,10 +403,9 @@ Returns a form where all lambdas don't have any free variables." (let ((new-lmenv) (var nil) (closedsym nil) - (letbinds '()) - (fvrs-new)) ; list of (closed-var var) - (dolist (elm varsvalues) - (setq var (if (consp elm) (car elm) elm)) + (letbinds '())) + (dolist (binder binders) + (setq var (if (consp binder) (car binder) binder)) (let ((lmenvs-1 lmenvs)) ; just to avoid manipulating (dolist (lmenv lmenvs-1) ; the counter inside the loop @@ -453,13 +423,13 @@ Returns a form where all lambdas don't have any free variables." (push new-lmenv lmenvs) (push `(,closedsym ,var) letbinds) )))) - (setq varsvalues-new (append varsvalues-new letbinds)))) + (setq binders-new (append binders-new letbinds)))) (dolist (elm body-forms) ; convert body forms (push (cconv-closure-convert-rec - elm emvrs fvrs envs lmenvs nil) + elm emvrs fvrs envs lmenvs) body-forms-new)) - `(,letsym ,(reverse varsvalues-new) . ,(reverse body-forms-new)))) + `(,letsym ,(reverse binders-new) . ,(reverse body-forms-new)))) ;end of let let* forms ; first element is lambda expression @@ -468,13 +438,12 @@ Returns a form where all lambdas don't have any free variables." (let ((other-body-forms-new '())) (dolist (elm other-body-forms) (push (cconv-closure-convert-rec - elm emvrs fvrs envs lmenvs nil) + elm emvrs fvrs envs lmenvs) other-body-forms-new)) - (cons - (cadr - (cconv-closure-convert-rec - (list 'function fun) emvrs fvrs envs lmenvs nil)) - (reverse other-body-forms-new)))) + `(funcall + ,(cconv-closure-convert-rec + (list 'function fun) emvrs fvrs envs lmenvs) + ,@(nreverse other-body-forms-new)))) (`(cond . ,cond-forms) ; cond special form (let ((cond-forms-new '())) @@ -483,7 +452,7 @@ Returns a form where all lambdas don't have any free variables." (dolist (elm-2 elm) (push (cconv-closure-convert-rec - elm-2 emvrs fvrs envs lmenvs nil) + elm-2 emvrs fvrs envs lmenvs) elm-new)) (reverse elm-new)) cond-forms-new)) @@ -523,7 +492,7 @@ Returns a form where all lambdas don't have any free variables." (dolist (elm fv) (push (cconv-closure-convert-rec - elm (remq elm emvrs) fvrs envs lmenvs nil) + elm (remq elm emvrs) fvrs envs lmenvs) envector)) ; process vars for closure vector (setq envector (reverse envector)) (setq envs fv)) @@ -539,7 +508,7 @@ Returns a form where all lambdas don't have any free variables." (push `(,mv (list ,mv)) letbind)))) (dolist (elm body-forms) ; convert function body (push (cconv-closure-convert-rec - elm emvrs fvrs envs lmenvs nil) + elm emvrs fvrs envs lmenvs) body-forms-new)) (setq body-forms-new @@ -566,83 +535,89 @@ Returns a form where all lambdas don't have any free variables." ;defconst, defvar (`(,(and sym (or `defconst `defvar)) ,definedsymbol . ,body-forms) - (if defs-are-legal - (let ((body-forms-new '())) - (dolist (elm body-forms) - (push (cconv-closure-convert-rec - elm emvrs fvrs envs lmenvs nil) - body-forms-new)) - (setq body-forms-new (reverse body-forms-new)) - `(,sym ,definedsymbol . ,body-forms-new)) - (error "Invalid form: %s inside a function" sym))) + (let ((body-forms-new '())) + (dolist (elm body-forms) + (push (cconv-closure-convert-rec + elm emvrs fvrs envs lmenvs) + body-forms-new)) + (setq body-forms-new (reverse body-forms-new)) + `(,sym ,definedsymbol . ,body-forms-new))) ;defun, defmacro (`(,(and sym (or `defun `defmacro)) ,func ,vars . ,body-forms) - (if defs-are-legal - (let ((body-new '()) ; the whole body - (body-forms-new '()) ; body w\o docstring and interactive - (letbind '())) + (let ((body-new '()) ; the whole body + (body-forms-new '()) ; body w\o docstring and interactive + (letbind '())) ; find mutable arguments - (let ((lmutated cconv-captured+mutated) ismutated) - (dolist (elm vars) - (setq ismutated nil) - (while (and lmutated (not ismutated)) - (when (and (eq (caar lmutated) elm) - (eq (cadar lmutated) form)) - (setq ismutated t)) - (setq lmutated (cdr lmutated))) - (when ismutated - (push elm letbind) - (push elm emvrs)))) + (let ((lmutated cconv-captured+mutated) ismutated) + (dolist (elm vars) + (setq ismutated nil) + (while (and lmutated (not ismutated)) + (when (and (eq (caar lmutated) elm) + (eq (cadar lmutated) form)) + (setq ismutated t)) + (setq lmutated (cdr lmutated))) + (when ismutated + (push elm letbind) + (push elm emvrs)))) ;transform body-forms - (when (stringp (car body-forms)) ; treat docstring well - (push (car body-forms) body-new) - (setq body-forms (cdr body-forms))) - (when (eq (car-safe (car body-forms)) 'interactive) - (push - (cconv-closure-convert-rec - (car body-forms) - emvrs fvrs envs lmenvs nil) body-new) - (setq body-forms (cdr body-forms))) - - (dolist (elm body-forms) - (push (cconv-closure-convert-rec - elm emvrs fvrs envs lmenvs nil) - body-forms-new)) - (setq body-forms-new (reverse body-forms-new)) + (when (stringp (car body-forms)) ; treat docstring well + (push (car body-forms) body-new) + (setq body-forms (cdr body-forms))) + (when (eq (car-safe (car body-forms)) 'interactive) + (push (cconv-closure-convert-rec + (car body-forms) + emvrs fvrs envs lmenvs) + body-new) + (setq body-forms (cdr body-forms))) + + (dolist (elm body-forms) + (push (cconv-closure-convert-rec + elm emvrs fvrs envs lmenvs) + body-forms-new)) + (setq body-forms-new (reverse body-forms-new)) - (if letbind + (if letbind ; letbind mutable arguments - (let ((varsvalues-new '())) - (dolist (elm letbind) (push `(,elm (list ,elm)) - varsvalues-new)) - (push `(let ,(reverse varsvalues-new) . - ,body-forms-new) body-new) - (setq body-new (reverse body-new))) - (setq body-new (append (reverse body-new) body-forms-new))) + (let ((binders-new '())) + (dolist (elm letbind) (push `(,elm (list ,elm)) + binders-new)) + (push `(let ,(reverse binders-new) . + ,body-forms-new) body-new) + (setq body-new (reverse body-new))) + (setq body-new (append (reverse body-new) body-forms-new))) - `(,sym ,func ,vars . ,body-new)) + `(,sym ,func ,vars . ,body-new))) - (error "Invalid form: defun inside a function"))) ;condition-case - (`(condition-case ,var ,protected-form . ,conditions-bodies) - (let ((conditions-bodies-new '())) + (`(condition-case ,var ,protected-form . ,handlers) + (let ((handlers-new '()) + (newform (cconv-closure-convert-rec + `(function (lambda () ,protected-form)) + emvrs fvrs envs lmenvs))) (setq fvrs (remq var fvrs)) - (dolist (elm conditions-bodies) - (push (let ((elm-new '())) - (dolist (elm-2 (cdr elm)) - (push - (cconv-closure-convert-rec - elm-2 emvrs fvrs envs lmenvs nil) - elm-new)) - (cons (car elm) (reverse elm-new))) - conditions-bodies-new)) - `(condition-case - ,var - ,(cconv-closure-convert-rec - protected-form emvrs fvrs envs lmenvs nil) - . ,(reverse conditions-bodies-new)))) + (dolist (handler handlers) + (push (list (car handler) + (cconv-closure-convert-rec + `(function (lambda (,(or var cconv--dummy-var)) + ,@(cdr handler))) + emvrs fvrs envs lmenvs)) + handlers-new)) + `(condition-case :fun-body ,newform + ,@(nreverse handlers-new)))) + + (`(,(and head (or `catch `unwind-protect)) ,form . ,body) + `(,head ,(cconv-closure-convert-rec form emvrs fvrs envs lmenvs) + :fun-body + ,(cconv-closure-convert-rec `(function (lambda () ,@body)) + emvrs fvrs envs lmenvs))) + + (`(,(and head (or `save-window-excursion `track-mouse)) . ,body) + `(,head + :fun-body + ,(cconv-closure-convert-rec `(function (lambda () ,@body)) + emvrs fvrs envs lmenvs))) (`(setq . ,forms) ; setq special form (let (prognlist sym sym-new value) @@ -650,10 +625,10 @@ Returns a form where all lambdas don't have any free variables." (setq sym (car forms)) (setq sym-new (cconv-closure-convert-rec sym - (remq sym emvrs) fvrs envs lmenvs nil)) + (remq sym emvrs) fvrs envs lmenvs)) (setq value (cconv-closure-convert-rec - (cadr forms) emvrs fvrs envs lmenvs nil)) + (cadr forms) emvrs fvrs envs lmenvs)) (if (memq sym emvrs) (push `(setcar ,sym-new ,value) prognlist) (if (symbolp sym-new) @@ -678,21 +653,21 @@ Returns a form where all lambdas don't have any free variables." (dolist (fvr fv) (push (cconv-closure-convert-rec fvr (remq fvr emvrs) - fvrs envs lmenvs nil) + fvrs envs lmenvs) processed-fv)) (setq processed-fv (reverse processed-fv)) (dolist (elm args) (push (cconv-closure-convert-rec - elm emvrs fvrs envs lmenvs nil) + elm emvrs fvrs envs lmenvs) args-new)) (setq args-new (append processed-fv (reverse args-new))) (setq fun (cconv-closure-convert-rec - fun emvrs fvrs envs lmenvs nil)) + fun emvrs fvrs envs lmenvs)) `(,callsym ,fun . ,args-new)) (let ((cdr-new '())) (dolist (elm (cdr form)) (push (cconv-closure-convert-rec - elm emvrs fvrs envs lmenvs nil) + elm emvrs fvrs envs lmenvs) cdr-new)) `(,callsym . ,(reverse cdr-new)))))) @@ -703,7 +678,7 @@ Returns a form where all lambdas don't have any free variables." (let ((body-forms-new '())) (dolist (elm body-forms) (push (cconv-closure-convert-rec - elm emvrs fvrs envs lmenvs defs-are-legal) + elm emvrs fvrs envs lmenvs) body-forms-new)) (setq body-forms-new (reverse body-forms-new)) `(,func . ,body-forms-new))) diff --git a/lisp/mpc.el b/lisp/mpc.el index 4f21a162c0..548fd17d03 100644 --- a/lisp/mpc.el +++ b/lisp/mpc.el @@ -1,5 +1,4 @@ -;;; -*- lexical-binding: t -*- -;;; mpc.el --- A client for the Music Player Daemon -*- coding: utf-8 -*- +;;; mpc.el --- A client for the Music Player Daemon -*- coding: utf-8; lexical-binding: t -*- ;; Copyright (C) 2006-2011 Free Software Foundation, Inc. -- 2.20.1