[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] /srv/bzr/emacs/emacs-24 r108517: Get rid of cl-lexical-let
|
From: |
Stefan Monnier |
|
Subject: |
[Emacs-diffs] /srv/bzr/emacs/emacs-24 r108517: Get rid of cl-lexical-let, keeping only lexical-let for compatibility. |
|
Date: |
Fri, 02 Nov 2012 02:22:35 -0000 |
|
User-agent: |
Bazaar (2.5.0) |
------------------------------------------------------------
revno: 108517
committer: Stefan Monnier <address@hidden>
branch nick: trunk
timestamp: Thu 2012-06-07 22:54:35 -0400
message:
Get rid of cl-lexical-let, keeping only lexical-let for compatibility.
* lisp/emacs-lisp/cl-macs.el: Provide itself.
(cl--labels-convert-cache): New var.
(cl--labels-convert): New function.
(cl-flet, cl-labels): New implementation with new semantics, relying on
lexical-binding.
* lisp/emacs-lisp/cl.el: Mark compatibility aliases as obsolete.
(cl-closure-vars, cl--function-convert-cache)
(cl--function-convert): Move from cl-macs.el.
(lexical-let, lexical-let*, flet, labels): Move from cl-macs.el and
rename by removing the "cl-" prefix.
* lisp/emacs-lisp/macroexp.el (macroexp-unprogn): New function.
modified:
lisp/ChangeLog
lisp/emacs-lisp/cl-loaddefs.el
lisp/emacs-lisp/cl-macs.el
lisp/emacs-lisp/cl.el
lisp/emacs-lisp/macroexp.el
=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog 2012-06-07 19:48:22 +0000
+++ b/lisp/ChangeLog 2012-06-08 02:54:35 +0000
@@ -1,3 +1,18 @@
+2012-06-08 Stefan Monnier <address@hidden>
+
+ Get rid of cl-lexical-let, keeping only lexical-let for compatibility.
+ * emacs-lisp/cl-macs.el: Provide itself.
+ (cl--labels-convert-cache): New var.
+ (cl--labels-convert): New function.
+ (cl-flet, cl-labels): New implementation with new semantics, relying on
+ lexical-binding.
+ * emacs-lisp/cl.el: Mark compatibility aliases as obsolete.
+ (cl-closure-vars, cl--function-convert-cache)
+ (cl--function-convert): Move from cl-macs.el.
+ (lexical-let, lexical-let*, flet, labels): Move from cl-macs.el and
+ rename by removing the "cl-" prefix.
+ * emacs-lisp/macroexp.el (macroexp-unprogn): New function.
+
2012-06-07 Stefan Monnier <address@hidden>
* emacs-lisp/cl.el (cl-macroexpand, cl-macro-environment)
=== modified file 'lisp/emacs-lisp/cl-loaddefs.el'
--- a/lisp/emacs-lisp/cl-loaddefs.el 2012-06-07 19:48:22 +0000
+++ b/lisp/emacs-lisp/cl-loaddefs.el 2012-06-08 02:54:35 +0000
@@ -258,13 +258,12 @@
;;;;;; cl-letf cl-rotatef cl-shiftf cl-remf cl-do-pop cl-psetf cl-setf
;;;;;; cl-get-setf-method cl-defsetf cl-define-setf-expander cl-declare
;;;;;; cl-the cl-locally cl-multiple-value-setq cl-multiple-value-bind
-;;;;;; cl-lexical-let* cl-lexical-let cl-symbol-macrolet cl-macrolet
-;;;;;; cl-labels cl-flet cl-progv cl-psetq cl-do-all-symbols cl-do-symbols
-;;;;;; cl-dotimes cl-dolist cl-do* cl-do cl-loop cl-return-from
-;;;;;; cl-return cl-block cl-etypecase cl-typecase cl-ecase cl-case
-;;;;;; cl-load-time-value cl-eval-when cl-destructuring-bind cl-function
-;;;;;; cl-defmacro cl-defun cl-gentemp cl-gensym) "cl-macs" "cl-macs.el"
-;;;;;; "c1e8e5391e374630452ab3d78e527086")
+;;;;;; cl-symbol-macrolet cl-macrolet cl-labels cl-flet cl-progv
+;;;;;; cl-psetq cl-do-all-symbols cl-do-symbols cl-dotimes cl-dolist
+;;;;;; cl-do* cl-do cl-loop cl-return-from cl-return cl-block cl-etypecase
+;;;;;; cl-typecase cl-ecase cl-case cl-load-time-value cl-eval-when
+;;;;;; cl-destructuring-bind cl-function cl-defmacro cl-defun cl-gentemp
+;;;;;; cl-gensym) "cl-macs" "cl-macs.el" "4c0f605e3c7454488cc9d498b611f422")
;;; Generated autoloads from cl-macs.el
(autoload 'cl-gensym "cl-macs" "\
@@ -485,10 +484,7 @@
(autoload 'cl-flet "cl-macs" "\
Make temporary function definitions.
-This is an analogue of `let' that operates on the function cell of FUNC
-rather than its value cell. The FORMs are evaluated with the specified
-function definitions in place, then the definitions are undone (the FUNCs
-go back to their previous definitions, or lack thereof).
+Like `cl-labels' but the definitions are not recursive.
\(fn ((FUNC ARGLIST BODY...) ...) FORM...)" nil t)
@@ -496,8 +492,7 @@
(autoload 'cl-labels "cl-macs" "\
Make temporary function bindings.
-This is like `cl-flet', except the bindings are lexical instead of dynamic.
-Unlike `cl-flet', this macro is fully compliant with the Common Lisp standard.
+The bindings can be recursive. Assumes the use of `lexical-binding'.
\(fn ((FUNC ARGLIST BODY...) ...) FORM...)" nil t)
@@ -520,26 +515,6 @@
(put 'cl-symbol-macrolet 'lisp-indent-function '1)
-(autoload 'cl-lexical-let "cl-macs" "\
-Like `let', but lexically scoped.
-The main visible difference is that lambdas inside BODY will create
-lexical closures as in Common Lisp.
-
-\(fn BINDINGS BODY)" nil t)
-
-(put 'cl-lexical-let 'lisp-indent-function '1)
-
-(autoload 'cl-lexical-let* "cl-macs" "\
-Like `let*', but lexically scoped.
-The main visible difference is that lambdas inside BODY, and in
-successive bindings within BINDINGS, will create lexical closures
-as in Common Lisp. This is similar to the behavior of `let*' in
-Common Lisp.
-
-\(fn BINDINGS BODY)" nil t)
-
-(put 'cl-lexical-let* 'lisp-indent-function '1)
-
(autoload 'cl-multiple-value-bind "cl-macs" "\
Collect multiple return values.
FORM must return a list; the BODY is then executed with the first N elements
=== modified file 'lisp/emacs-lisp/cl-macs.el'
--- a/lisp/emacs-lisp/cl-macs.el 2012-06-07 19:48:22 +0000
+++ b/lisp/emacs-lisp/cl-macs.el 2012-06-08 02:54:35 +0000
@@ -1611,63 +1611,70 @@
(progn (cl-progv-before ,symbols ,values) ,@body)
(cl-progv-after))))
+(defvar cl--labels-convert-cache nil)
+
+(defun cl--labels-convert (f)
+ "Special macro-expander to rename (function F) references in `cl-labels'."
+ (cond
+ ;; ¡¡Big Ugly Hack!! We can't use a compiler-macro because those are checked
+ ;; *after* handling `function', but we want to stop macroexpansion from
+ ;; being applied infinitely, so we use a cache to return the exact `form'
+ ;; being expanded even though we don't receive it.
+ ((eq f (car cl--labels-convert-cache)) (cdr cl--labels-convert-cache))
+ (t
+ (let ((found (assq f macroexpand-all-environment)))
+ (if (and found (ignore-errors
+ (eq (cadr (cl-caddr found)) 'cl-labels-args)))
+ (cadr (cl-caddr (cl-cadddr found)))
+ (let ((res `(function ,f)))
+ (setq cl--labels-convert-cache (cons f res))
+ res))))))
+
;;; This should really have some way to shadow 'byte-compile properties, etc.
;;;###autoload
(defmacro cl-flet (bindings &rest body)
"Make temporary function definitions.
-This is an analogue of `let' that operates on the function cell of FUNC
-rather than its value cell. The FORMs are evaluated with the specified
-function definitions in place, then the definitions are undone (the FUNCs
-go back to their previous definitions, or lack thereof).
+Like `cl-labels' but the definitions are not recursive.
\(fn ((FUNC ARGLIST BODY...) ...) FORM...)"
(declare (indent 1) (debug ((&rest (cl-defun)) cl-declarations body)))
- `(cl-letf* ,(mapcar
- (lambda (x)
- (if (or (and (fboundp (car x))
- (eq (car-safe (symbol-function (car x))) 'macro))
- (cdr (assq (car x) macroexpand-all-environment)))
- (error "Use `cl-labels', not `cl-flet', to rebind macro
names"))
- (let ((func `(cl-function
- (lambda ,(cadr x)
- (cl-block ,(car x) ,@(cddr x))))))
- (when (cl-compiling-file)
- ;; Bug#411. It would be nice to fix this.
- (and (get (car x) 'byte-compile)
- (error "Byte-compiling a redefinition of `%s' \
-will not work - use `cl-labels' instead" (symbol-name (car x))))
- ;; FIXME This affects the rest of the file, when it
- ;; should be restricted to the cl-flet body.
- (and (boundp 'byte-compile-function-environment)
- (push (cons (car x) (eval func))
- byte-compile-function-environment)))
- (list `(symbol-function ',(car x)) func)))
- bindings)
- ,@body))
+ (let ((binds ()) (newenv macroexpand-all-environment))
+ (dolist (binding bindings)
+ (let ((var (make-symbol (format "--cl-%s--" (car binding)))))
+ (push (list var `(cl-function (lambda . ,(cdr binding)))) binds)
+ (push (cons (car binding)
+ `(lambda (&rest cl-labels-args)
+ (cl-list* 'funcall ',var
+ cl-labels-args)))
+ newenv)))
+ `(let ,(nreverse binds)
+ ,@(macroexp-unprogn
+ (macroexpand-all
+ `(progn ,@body)
+ ;; Don't override lexical-let's macro-expander.
+ (if (assq 'function newenv) newenv
+ (cons (cons 'function #'cl--labels-convert) newenv)))))))
;;;###autoload
(defmacro cl-labels (bindings &rest body)
"Make temporary function bindings.
-This is like `cl-flet', except the bindings are lexical instead of dynamic.
-Unlike `cl-flet', this macro is fully compliant with the Common Lisp standard.
+The bindings can be recursive. Assumes the use of `lexical-binding'.
\(fn ((FUNC ARGLIST BODY...) ...) FORM...)"
(declare (indent 1) (debug cl-flet))
- (let ((vars nil) (sets nil) (newenv macroexpand-all-environment))
- (while bindings
- ;; Use `cl-gensym' rather than `make-symbol'. It's important that
- ;; (not (eq (symbol-name var1) (symbol-name var2))) because these
- ;; vars get added to the cl-macro-environment.
- (let ((var (cl-gensym "--cl-var--")))
- (push var vars)
- (push `(cl-function (lambda . ,(cdar bindings))) sets)
- (push var sets)
- (push (cons (car (pop bindings))
+ (let ((binds ()) (newenv macroexpand-all-environment))
+ (dolist (binding bindings)
+ (let ((var (make-symbol (format "--cl-%s--" (car binding)))))
+ (push (list var `(cl-function (lambda . ,(cdr binding)))) binds)
+ (push (cons (car binding)
`(lambda (&rest cl-labels-args)
(cl-list* 'funcall ',var
cl-labels-args)))
newenv)))
- (macroexpand-all `(cl-lexical-let ,vars (setq ,@sets) ,@body) newenv)))
+ (macroexpand-all `(letrec ,(nreverse binds) ,@body)
+ ;; Don't override lexical-let's macro-expander.
+ (if (assq 'function newenv) newenv
+ (cons (cons 'function #'cl--labels-convert) newenv)))))
;; The following ought to have a better definition for use with newer
;; byte compilers.
@@ -1750,119 +1757,6 @@
macroexpand-all-environment)))
(fset 'macroexpand previous-macroexpand))))))
-(defvar cl-closure-vars nil)
-(defvar cl--function-convert-cache nil)
-
-(defun cl--function-convert (f)
- "Special macro-expander for special cases of (function F).
-The two cases that are handled are:
-- closure-conversion of lambda expressions for `cl-lexical-let'.
-- renaming of F when it's a function defined via `cl-labels'."
- (cond
- ;; ¡¡Big Ugly Hack!! We can't use a compiler-macro because those are checked
- ;; *after* handling `function', but we want to stop macroexpansion from
- ;; being applied infinitely, so we use a cache to return the exact `form'
- ;; being expanded even though we don't receive it.
- ((eq f (car cl--function-convert-cache)) (cdr cl--function-convert-cache))
- ((eq (car-safe f) 'lambda)
- (let ((body (mapcar (lambda (f)
- (macroexpand-all f macroexpand-all-environment))
- (cddr f))))
- (if (and cl-closure-vars
- (cl--expr-contains-any body cl-closure-vars))
- (let* ((new (mapcar 'cl-gensym cl-closure-vars))
- (sub (cl-pairlis cl-closure-vars new)) (decls nil))
- (while (or (stringp (car body))
- (eq (car-safe (car body)) 'interactive))
- (push (list 'quote (pop body)) decls))
- (put (car (last cl-closure-vars)) 'used t)
- `(list 'lambda '(&rest --cl-rest--)
- ,@(cl-sublis sub (nreverse decls))
- (list 'apply
- (list 'quote
- #'(lambda ,(append new (cadr f))
- ,@(cl-sublis sub body)))
- ,@(nconc (mapcar (lambda (x) `(list 'quote ,x))
- cl-closure-vars)
- '((quote --cl-rest--))))))
- (let* ((newf `(lambda ,(cadr f) ,@body))
- (res `(function ,newf)))
- (setq cl--function-convert-cache (cons newf res))
- res))))
- (t
- (let ((found (assq f macroexpand-all-environment)))
- (if (and found (ignore-errors
- (eq (cadr (cl-caddr found)) 'cl-labels-args)))
- (cadr (cl-caddr (cl-cadddr found)))
- (let ((res `(function ,f)))
- (setq cl--function-convert-cache (cons f res))
- res))))))
-
-;;;###autoload
-(defmacro cl-lexical-let (bindings &rest body)
- "Like `let', but lexically scoped.
-The main visible difference is that lambdas inside BODY will create
-lexical closures as in Common Lisp.
-\n(fn BINDINGS BODY)"
- (declare (indent 1) (debug let))
- (let* ((cl-closure-vars cl-closure-vars)
- (vars (mapcar (function
- (lambda (x)
- (or (consp x) (setq x (list x)))
- (push (make-symbol (format "--cl-%s--" (car x)))
- cl-closure-vars)
- (set (car cl-closure-vars) [bad-lexical-ref])
- (list (car x) (cadr x) (car cl-closure-vars))))
- bindings))
- (ebody
- (macroexpand-all
- `(cl-symbol-macrolet
- ,(mapcar (lambda (x)
- `(,(car x) (symbol-value ,(cl-caddr x))))
- vars)
- ,@body)
- (cons (cons 'function #'cl--function-convert)
- macroexpand-all-environment))))
- (if (not (get (car (last cl-closure-vars)) 'used))
- ;; Turn (let ((foo (cl-gensym)))
- ;; (set foo <val>) ...(symbol-value foo)...)
- ;; into (let ((foo <val>)) ...(symbol-value 'foo)...).
- ;; This is good because it's more efficient but it only works with
- ;; dynamic scoping, since with lexical scoping we'd need
- ;; (let ((foo <val>)) ...foo...).
- `(progn
- ,@(mapcar (lambda (x) `(defvar ,(cl-caddr x))) vars)
- (let ,(mapcar (lambda (x) (list (cl-caddr x) (cadr x))) vars)
- ,(cl-sublis (mapcar (lambda (x)
- (cons (cl-caddr x)
- `',(cl-caddr x)))
- vars)
- ebody)))
- `(let ,(mapcar (lambda (x)
- (list (cl-caddr x)
- `(make-symbol ,(format "--%s--" (car x)))))
- vars)
- (cl-setf ,@(apply #'append
- (mapcar (lambda (x)
- (list `(symbol-value ,(cl-caddr x)) (cadr
x)))
- vars)))
- ,ebody))))
-
-;;;###autoload
-(defmacro cl-lexical-let* (bindings &rest body)
- "Like `let*', but lexically scoped.
-The main visible difference is that lambdas inside BODY, and in
-successive bindings within BINDINGS, will create lexical closures
-as in Common Lisp. This is similar to the behavior of `let*' in
-Common Lisp.
-\n(fn BINDINGS BODY)"
- (declare (indent 1) (debug let))
- (if (null bindings) (cons 'progn body)
- (setq bindings (reverse bindings))
- (while bindings
- (setq body (list `(cl-lexical-let (,(pop bindings)) ,@body))))
- (car body)))
-
;;; Multiple values.
;;;###autoload
@@ -3211,4 +3105,6 @@
;; generated-autoload-file: "cl-loaddefs.el"
;; End:
+(provide 'cl-macs)
+
;;; cl-macs.el ends here
=== modified file 'lisp/emacs-lisp/cl.el'
--- a/lisp/emacs-lisp/cl.el 2012-06-07 19:48:22 +0000
+++ b/lisp/emacs-lisp/cl.el 2012-06-08 02:54:35 +0000
@@ -28,6 +28,7 @@
;;; Code:
(require 'cl-lib)
+(require 'macroexp)
;; (defun cl--rename ()
;; (let ((vdefs ())
@@ -226,11 +227,8 @@
locally
multiple-value-setq
multiple-value-bind
- lexical-let*
- lexical-let
symbol-macrolet
macrolet
- labels
flet
progv
psetq
@@ -330,12 +328,181 @@
(if (get new prop)
(put fun prop (get new prop))))))
+(defvar cl-closure-vars nil)
+(defvar cl--function-convert-cache nil)
+
+(defun cl--function-convert (f)
+ "Special macro-expander for special cases of (function F).
+The two cases that are handled are:
+- closure-conversion of lambda expressions for `lexical-let'.
+- renaming of F when it's a function defined via `cl-labels' or `labels'."
+ (require 'cl-macs)
+ (cond
+ ;; ¡¡Big Ugly Hack!! We can't use a compiler-macro because those are checked
+ ;; *after* handling `function', but we want to stop macroexpansion from
+ ;; being applied infinitely, so we use a cache to return the exact `form'
+ ;; being expanded even though we don't receive it.
+ ((eq f (car cl--function-convert-cache)) (cdr cl--function-convert-cache))
+ ((eq (car-safe f) 'lambda)
+ (let ((body (mapcar (lambda (f)
+ (macroexpand-all f macroexpand-all-environment))
+ (cddr f))))
+ (if (and cl-closure-vars
+ (cl--expr-contains-any body cl-closure-vars))
+ (let* ((new (mapcar 'cl-gensym cl-closure-vars))
+ (sub (cl-pairlis cl-closure-vars new)) (decls nil))
+ (while (or (stringp (car body))
+ (eq (car-safe (car body)) 'interactive))
+ (push (list 'quote (pop body)) decls))
+ (put (car (last cl-closure-vars)) 'used t)
+ `(list 'lambda '(&rest --cl-rest--)
+ ,@(cl-sublis sub (nreverse decls))
+ (list 'apply
+ (list 'quote
+ #'(lambda ,(append new (cadr f))
+ ,@(cl-sublis sub body)))
+ ,@(nconc (mapcar (lambda (x) `(list 'quote ,x))
+ cl-closure-vars)
+ '((quote --cl-rest--))))))
+ (let* ((newf `(lambda ,(cadr f) ,@body))
+ (res `(function ,newf)))
+ (setq cl--function-convert-cache (cons newf res))
+ res))))
+ (t
+ (let ((found (assq f macroexpand-all-environment)))
+ (if (and found (ignore-errors
+ (eq (cadr (cl-caddr found)) 'cl-labels-args)))
+ (cadr (cl-caddr (cl-cadddr found)))
+ (let ((res `(function ,f)))
+ (setq cl--function-convert-cache (cons f res))
+ res))))))
+
+(defmacro lexical-let (bindings &rest body)
+ "Like `let', but lexically scoped.
+The main visible difference is that lambdas inside BODY will create
+lexical closures as in Common Lisp.
+\n(fn BINDINGS BODY)"
+ (declare (indent 1) (debug let))
+ (let* ((cl-closure-vars cl-closure-vars)
+ (vars (mapcar (function
+ (lambda (x)
+ (or (consp x) (setq x (list x)))
+ (push (make-symbol (format "--cl-%s--" (car x)))
+ cl-closure-vars)
+ (set (car cl-closure-vars) [bad-lexical-ref])
+ (list (car x) (cadr x) (car cl-closure-vars))))
+ bindings))
+ (ebody
+ (macroexpand-all
+ `(cl-symbol-macrolet
+ ,(mapcar (lambda (x)
+ `(,(car x) (symbol-value ,(cl-caddr x))))
+ vars)
+ ,@body)
+ (cons (cons 'function #'cl--function-convert)
+ macroexpand-all-environment))))
+ (if (not (get (car (last cl-closure-vars)) 'used))
+ ;; Turn (let ((foo (cl-gensym)))
+ ;; (set foo <val>) ...(symbol-value foo)...)
+ ;; into (let ((foo <val>)) ...(symbol-value 'foo)...).
+ ;; This is good because it's more efficient but it only works with
+ ;; dynamic scoping, since with lexical scoping we'd need
+ ;; (let ((foo <val>)) ...foo...).
+ `(progn
+ ,@(mapcar (lambda (x) `(defvar ,(cl-caddr x))) vars)
+ (let ,(mapcar (lambda (x) (list (cl-caddr x) (cadr x))) vars)
+ ,(cl-sublis (mapcar (lambda (x)
+ (cons (cl-caddr x)
+ `',(cl-caddr x)))
+ vars)
+ ebody)))
+ `(let ,(mapcar (lambda (x)
+ (list (cl-caddr x)
+ `(make-symbol ,(format "--%s--" (car x)))))
+ vars)
+ (cl-setf ,@(apply #'append
+ (mapcar (lambda (x)
+ (list `(symbol-value ,(cl-caddr x)) (cadr
x)))
+ vars)))
+ ,ebody))))
+
+(defmacro lexical-let* (bindings &rest body)
+ "Like `let*', but lexically scoped.
+The main visible difference is that lambdas inside BODY, and in
+successive bindings within BINDINGS, will create lexical closures
+as in Common Lisp. This is similar to the behavior of `let*' in
+Common Lisp.
+\n(fn BINDINGS BODY)"
+ (declare (indent 1) (debug let))
+ (if (null bindings) (cons 'progn body)
+ (setq bindings (reverse bindings))
+ (while bindings
+ (setq body (list `(lexical-let (,(pop bindings)) ,@body))))
+ (car body)))
+
+;; This should really have some way to shadow 'byte-compile properties, etc.
+;;;###autoload
+(defmacro flet (bindings &rest body)
+ "Make temporary function definitions.
+This is an analogue of `let' that operates on the function cell of FUNC
+rather than its value cell. The FORMs are evaluated with the specified
+function definitions in place, then the definitions are undone (the FUNCs
+go back to their previous definitions, or lack thereof).
+
+\(fn ((FUNC ARGLIST BODY...) ...) FORM...)"
+ (declare (indent 1) (debug cl-flet))
+ `(cl-letf* ,(mapcar
+ (lambda (x)
+ (if (or (and (fboundp (car x))
+ (eq (car-safe (symbol-function (car x))) 'macro))
+ (cdr (assq (car x) macroexpand-all-environment)))
+ (error "Use `labels', not `flet', to rebind macro names"))
+ (let ((func `(cl-function
+ (lambda ,(cadr x)
+ (cl-block ,(car x) ,@(cddr x))))))
+ (when (cl-compiling-file)
+ ;; Bug#411. It would be nice to fix this.
+ (and (get (car x) 'byte-compile)
+ (error "Byte-compiling a redefinition of `%s' \
+will not work - use `labels' instead" (symbol-name (car x))))
+ ;; FIXME This affects the rest of the file, when it
+ ;; should be restricted to the flet body.
+ (and (boundp 'byte-compile-function-environment)
+ (push (cons (car x) (eval func))
+ byte-compile-function-environment)))
+ (list `(symbol-function ',(car x)) func)))
+ bindings)
+ ,@body))
+
+(defmacro labels (bindings &rest body)
+ "Make temporary function bindings.
+This is like `flet', except the bindings are lexical instead of dynamic.
+Unlike `flet', this macro is fully compliant with the Common Lisp standard.
+
+\(fn ((FUNC ARGLIST BODY...) ...) FORM...)"
+ (declare (indent 1) (debug cl-flet))
+ (let ((vars nil) (sets nil) (newenv macroexpand-all-environment))
+ (dolist (binding bindings)
+ ;; It's important that (not (eq (symbol-name var1) (symbol-name var2)))
+ ;; because these var's *names* get added to the macro-environment.
+ (let ((var (make-symbol (format "--cl-%s--" (car binding)))))
+ (push var vars)
+ (push `(cl-function (lambda . ,(cdr binding))) sets)
+ (push var sets)
+ (push (cons (car binding)
+ `(lambda (&rest cl-labels-args)
+ (cl-list* 'funcall ',var
+ cl-labels-args)))
+ newenv)))
+ (macroexpand-all `(lexical-let ,vars (setq ,@sets) ,@body) newenv)))
+
;;; Additional compatibility code
;; For names that were clean but really aren't needed any more.
-(defalias 'cl-macroexpand 'macroexpand)
-(defvaralias 'cl-macro-environment 'macroexpand-all-environment)
-(defalias 'cl-macroexpand-all 'macroexpand-all)
+(define-obsolete-function-alias 'cl-macroexpand 'macroexpand "24.2")
+(define-obsolete-variable-alias 'cl-macro-environment
+ 'macroexpand-all-environment "24.2")
+(define-obsolete-function-alias 'cl-macroexpand-all 'macroexpand-all "24.2")
;;; Hash tables.
;; This is just kept for compatibility with code byte-compiled by Emacs-20.
@@ -343,24 +510,29 @@
;; No idea if this might still be needed.
(defun cl-not-hash-table (x &optional y &rest z)
(signal 'wrong-type-argument (list 'cl-hash-table-p (or y x))))
+(make-obsolete 'cl-not-hash-table nil "24.2")
(defvar cl-builtin-gethash (symbol-function 'gethash))
+(make-obsolete-variable 'cl-builtin-gethash nil "24.2")
(defvar cl-builtin-remhash (symbol-function 'remhash))
+(make-obsolete-variable 'cl-builtin-remhash nil "24.2")
(defvar cl-builtin-clrhash (symbol-function 'clrhash))
+(make-obsolete-variable 'cl-builtin-clrhash nil "24.2")
(defvar cl-builtin-maphash (symbol-function 'maphash))
-(defalias 'cl-map-keymap 'map-keymap)
-(defalias 'cl-copy-tree 'copy-tree)
-(defalias 'cl-gethash 'gethash)
-(defalias 'cl-puthash 'puthash)
-(defalias 'cl-remhash 'remhash)
-(defalias 'cl-clrhash 'clrhash)
-(defalias 'cl-maphash 'maphash)
-(defalias 'cl-make-hash-table 'make-hash-table)
-(defalias 'cl-hash-table-p 'hash-table-p)
-(defalias 'cl-hash-table-count 'hash-table-count)
+(make-obsolete-variable 'cl-builtin-maphash nil "24.2")
+(define-obsolete-function-alias 'cl-map-keymap 'map-keymap "24.2")
+(define-obsolete-function-alias 'cl-copy-tree 'copy-tree "24.2")
+(define-obsolete-function-alias 'cl-gethash 'gethash "24.2")
+(define-obsolete-function-alias 'cl-puthash 'puthash "24.2")
+(define-obsolete-function-alias 'cl-remhash 'remhash "24.2")
+(define-obsolete-function-alias 'cl-clrhash 'clrhash "24.2")
+(define-obsolete-function-alias 'cl-maphash 'maphash "24.2")
+(define-obsolete-function-alias 'cl-make-hash-table 'make-hash-table "24.2")
+(define-obsolete-function-alias 'cl-hash-table-p 'hash-table-p "24.2")
+(define-obsolete-function-alias 'cl-hash-table-count 'hash-table-count "24.2")
-;; FIXME: More candidates: define-modify-macro, define-setf-expander,
lexical-let.
+;; FIXME: More candidates: define-modify-macro, define-setf-expander.
(provide 'cl)
;;; cl.el ends here
=== modified file 'lisp/emacs-lisp/macroexp.el'
--- a/lisp/emacs-lisp/macroexp.el 2012-06-07 19:25:48 +0000
+++ b/lisp/emacs-lisp/macroexp.el 2012-06-08 02:54:35 +0000
@@ -231,6 +231,10 @@
"Return an expression equivalent to `(progn ,@EXPS)."
(if (cdr exps) `(progn ,@exps) (car exps)))
+(defun macroexp-unprogn (exp)
+ "Turn EXP into a list of expressions to execute in sequence."
+ (if (eq (car-safe exp) 'progn) (cdr exp) (list exp)))
+
(defun macroexp-let* (bindings exp)
"Return an expression equivalent to `(let* ,bindings ,exp)."
(cond
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Emacs-diffs] /srv/bzr/emacs/emacs-24 r108517: Get rid of cl-lexical-let, keeping only lexical-let for compatibility.,
Stefan Monnier <=