procyberian/emacs
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Let cconv use :fun-body in special forms that need it.

Browse source 
* 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.
This commit is contained in:
Stefan Monnier 2011-02-11 17:30:02 -05:00
parent 43e67019df
commit 295fb2ac59
7 changed files with 198 additions and 199 deletions
Download patch file Download diff file Expand all files Collapse all files

20
lisp/ChangeLog
View file

@ -1,3 +1,23 @@
2011-02-11 Stefan Monnier <monnier@iro.umontreal.ca>
* 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 <monnier@iro.umontreal.ca>
* emacs-lisp/bytecomp.el (byte-compile-lambda): Fix `fun' that was not

11
lisp/dired.el
View file

@ -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

1
lisp/emacs-lisp/byte-lexbind.el
View file

@ -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

11
lisp/emacs-lisp/byte-opt.el
View file

@ -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)))

10
lisp/emacs-lisp/bytecomp.el
View file

@ -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

341
lisp/emacs-lisp/cconv.el
View file

@ -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 <value(s)>
;; 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))
(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)
;; 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 '()))
(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)))))))))
`(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))))
;; 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)))
(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 nil)
body-forms-new))
(setq body-forms-new (reverse 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))
(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)))

3
lisp/mpc.el
View file

@ -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.