Mercurial > hg > xemacs-beta

comparison lisp/cl-macs.el @ 5580:a0e81357194e

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Move macros with shadows in bytecomp.el to the end of the files, cl-macs lisp/ChangeLog addition: 2011-10-08 Aidan Kehoe <kehoea@parhasard.net> * cl-macs.el: * cl-macs.el (load-time-value): * cl-macs.el (flet): * cl-macs.el (labels): * cl-macs.el (the): * cl-macs.el (declare): Move all these macros to the end of the file, since they're in byte-compile-initial-macro-environment, and we don't want their definitions to override that for the rest of the file during byte-compilation. Happens not to matter right now, but avoids surprises for anyone using the macros elsewhere in cl-macs down the line.
author Aidan Kehoe <kehoea@parhasard.net>
date Sat, 08 Oct 2011 12:26:09 +0100
parents d4f334808463
children 3152c2c21461
comparison
equal deleted inserted replaced
5579:3e621ba12d36 5580:a0e81357194e
619 (if (or (memq 'eval when) (memq :execute when)) 619 (if (or (memq 'eval when) (memq :execute when))
620 (list* 'eval-when (cons 'compile when) (cddr form)) 620 (list* 'eval-when (cons 'compile when) (cddr form))
621 form))) 621 form)))
622 (t (eval form) form))) 622 (t (eval form) form)))
623 623
624 ;;;###autoload
625 (defmacro load-time-value (form &optional read-only)
626 "Like `progn', but evaluates the body at load time.
627 The result of the body appears to the compiler as a quoted constant."
628 (list 'progn form))
629
630 ;;; Conditional control structures. 624 ;;; Conditional control structures.
631 625
632 ;;;###autoload 626 ;;;###autoload
633 (defmacro case (expr &rest clauses) 627 (defmacro case (expr &rest clauses)
634 "Evals EXPR, chooses from CLAUSES on that value. 628 "Evals EXPR, chooses from CLAUSES on that value.
1713 (list 'unwind-protect 1707 (list 'unwind-protect
1714 (list* 'progn (list 'cl-progv-before symbols values) body) 1708 (list* 'progn (list 'cl-progv-before symbols values) body)
1715 '(cl-progv-after)))) 1709 '(cl-progv-after))))
1716 1710
1717 ;;;###autoload 1711 ;;;###autoload
1718 (defmacro flet (functions &rest form)
1719 "Make temporary function definitions.
1720
1721 This is an analogue of `let' that operates on the function cell of FUNC
1722 rather than its value cell. The FORMs are evaluated with the specified
1723 function definitions in place, then the definitions are undone (the FUNCs go
1724 back to their previous definitions, or lack thereof). This is in
1725 contravention of Common Lisp, where `flet' makes a lexical, not a dynamic,
1726 function binding.
1727
1728 Normally you should use `labels', not `flet'; `labels' does not have the
1729 problems caused by dynamic scope, is less expensive when byte-compiled, and
1730 allows lexical shadowing of functions with byte-codes and byte-compile
1731 methods, where `flet' will fail. The byte-compiler will warn when this
1732 happens.
1733
1734 If you need to shadow some existing function at run time, and that function
1735 has no associated byte code or compiler macro, then `flet' is appropriate.
1736
1737 arguments: (((FUNCTION ARGLIST &body BODY) &rest FUNCTIONS) &body FORM)"
1738 ;; XEmacs; leave warnings, errors and modifications of
1739 ;; byte-compile-function-environment to the byte compiler. See
1740 ;; byte-compile-initial-macro-environment in bytecomp.el.
1741 (list*
1742 'letf*
1743 (mapcar
1744 (function*
1745 (lambda ((function . definition))
1746 `((symbol-function ',function)
1747 ,(cons 'lambda (cdr (cl-transform-lambda definition function))))))
1748 functions) form))
1749
1750 ;;;###autoload
1751 (defmacro labels (bindings &rest body)
1752 "Make temporary function bindings.
1753
1754 This is like `flet', except the bindings are lexical instead of dynamic.
1755 Unlike `flet', this macro is compliant with the Common Lisp standard with
1756 regard to the scope and extent of the function bindings.
1757
1758 Each function may be called from within FORM, from within the BODY of the
1759 function itself (that is, recursively), and from any other function bodies
1760 in FUNCTIONS.
1761
1762 Within FORM, to access the function definition of a bound function (for
1763 example, to pass it as a FUNCTION argument to `map'), quote its symbol name
1764 using `function'.
1765
1766 arguments: (((FUNCTION ARGLIST &body BODY) &rest FUNCTIONS) &body FORM)
1767 "
1768 ;; XEmacs; the byte-compiler has a much better implementation of `labels'
1769 ;; in `byte-compile-initial-macro-environment' that is used in compiled
1770 ;; code.
1771 (let ((vars nil) (sets nil)
1772 (byte-compile-macro-environment byte-compile-macro-environment))
1773 (while bindings
1774 (let ((var (gensym)))
1775 (push var vars)
1776 (push `#'(lambda ,@(cdr (cl-transform-lambda (cdar bindings)
1777 (caar bindings)))) sets)
1778 (push var sets)
1779 (push (list (car (pop bindings)) 'lambda '(&rest cl-labels-args)
1780 (list 'list* '(quote funcall) (list 'quote var)
1781 'cl-labels-args))
1782 byte-compile-macro-environment)))
1783 (cl-macroexpand-all (list* 'lexical-let vars (cons (cons 'setq sets) body))
1784 byte-compile-macro-environment)))
1785
1786 ;;;###autoload
1787 (defmacro* macrolet ((&rest macros) &body form) 1712 (defmacro* macrolet ((&rest macros) &body form)
1788 "Make temporary macro definitions. 1713 "Make temporary macro definitions.
1789 This is like `flet', but for macros instead of functions." 1714 This is like `flet', but for macros instead of functions."
1790 (cl-macroexpand-all (cons 'progn form) 1715 (cl-macroexpand-all (cons 'progn form)
1791 (nconc 1716 (nconc
1936 1861
1937 ;;; Declarations. 1862 ;;; Declarations.
1938 1863
1939 ;;;###autoload 1864 ;;;###autoload
1940 (defmacro locally (&rest body) (cons 'progn body)) 1865 (defmacro locally (&rest body) (cons 'progn body))
1941 ;;;###autoload
1942 (defmacro the (type form)
1943 "Assert that FORM gives a result of type TYPE, and return that result.
1944
1945 TYPE is a Common Lisp type specifier.
1946
1947 If macro expansion of a `the' form happens during byte compilation, and the
1948 byte compiler customization variable `byte-compile-delete-errors' is
1949 non-nil, `the' is equivalent to FORM without any type checks."
1950 (if (cl-safe-expr-p form)
1951 `(prog1 ,form (assert ,(cl-make-type-test form type) t))
1952 (let ((saved (gensym)))
1953 `(let ((,saved ,form))
1954 (prog1 ,saved (assert ,(cl-make-type-test saved type) t))))))
1955 1866
1956 (defvar cl-proclaim-history t) ; for future compilers 1867 (defvar cl-proclaim-history t) ; for future compilers
1957 (defvar cl-declare-stack t) ; for future compilers 1868 (defvar cl-declare-stack t) ; for future compilers
1958 1869
1959 (defun cl-do-proclaim (spec hist) 1870 (defun cl-do-proclaim (spec hist)
2029 ;;; Process any proclamations made before cl-macs was loaded. 1940 ;;; Process any proclamations made before cl-macs was loaded.
2030 (defvar cl-proclaims-deferred) 1941 (defvar cl-proclaims-deferred)
2031 (let ((p (reverse cl-proclaims-deferred))) 1942 (let ((p (reverse cl-proclaims-deferred)))
2032 (while p (cl-do-proclaim (pop p) t)) 1943 (while p (cl-do-proclaim (pop p) t))
2033 (setq cl-proclaims-deferred nil)) 1944 (setq cl-proclaims-deferred nil))
2034
2035 ;;;###autoload
2036 (defmacro declare (&rest specs)
2037 nil)
2038 1945
2039 ;;; Generalized variables. 1946 ;;; Generalized variables.
2040 1947
2041 ;;;###autoload 1948 ;;;###autoload
2042 (defmacro define-setf-method (name arglist &rest body) 1949 (defmacro define-setf-method (name arglist &rest body)
3952 ;;; Things that are inline. XEmacs; the functions that used to be here have 3859 ;;; Things that are inline. XEmacs; the functions that used to be here have
3953 ;;; compiler macros or are built-in. 3860 ;;; compiler macros or are built-in.
3954 (proclaim '(inline cl-set-elt)) 3861 (proclaim '(inline cl-set-elt))
3955 3862
3956 ;;; Things that are side-effect-free. Moved to byte-optimize.el 3863 ;;; Things that are side-effect-free. Moved to byte-optimize.el
3957 ;(mapcar (function (lambda (x) (put x 'side-effect-free t))) 3864 ;[...]
3958 ; '(oddp evenp signum last butlast ldiff pairlis gcd lcm
3959 ; isqrt floor* ceiling* truncate* round* mod* rem* subseq
3960 ; list-length get* getf))
3961 3865
3962 ;;; Things that are side-effect-and-error-free. Moved to byte-optimize.el 3866 ;;; Things that are side-effect-and-error-free. Moved to byte-optimize.el
3963 ;(mapcar (function (lambda (x) (put x 'side-effect-free 'error-free))) 3867 ;[...]
3964 ; '(eql list* subst acons equalp random-state-p 3868
3965 ; copy-tree sublis)) 3869 ;; XEmacs; move the following macros to the end of this file, since the
3966 3870 ;; override the versions in byte-compile-initial-macro-environment for the
3871 ;; duration of the file they're defined in.
3872
3873 ;;;###autoload
3874 (defmacro the (type form)
3875 "Assert that FORM gives a result of type TYPE, and return that result.
3876
3877 TYPE is a Common Lisp type specifier.
3878
3879 If macro expansion of a `the' form happens during byte compilation, and the
3880 byte compiler customization variable `byte-compile-delete-errors' is
3881 non-nil, `the' is equivalent to FORM without any type checks."
3882 (if (cl-safe-expr-p form)
3883 `(prog1 ,form (assert ,(cl-make-type-test form type) t))
3884 (let ((saved (gensym)))
3885 `(let ((,saved ,form))
3886 (prog1 ,saved (assert ,(cl-make-type-test saved type) t))))))
3887
3888 ;;;###autoload
3889 (defmacro declare (&rest specs)
3890 nil)
3891
3892 ;;;###autoload
3893 (defmacro load-time-value (form &optional read-only)
3894 "Like `progn', but evaluates the body at load time.
3895 The result of the body appears to the compiler as a quoted constant."
3896 (list 'progn form))
3897
3898 ;;;###autoload
3899 (defmacro labels (bindings &rest body)
3900 "Make temporary function bindings.
3901
3902 This is like `flet', except the bindings are lexical instead of dynamic.
3903 Unlike `flet', this macro is compliant with the Common Lisp standard with
3904 regard to the scope and extent of the function bindings.
3905
3906 Each function may be called from within FORM, from within the BODY of the
3907 function itself (that is, recursively), and from any other function bodies
3908 in FUNCTIONS.
3909
3910 Within FORM, to access the function definition of a bound function (for
3911 example, to pass it as a FUNCTION argument to `map'), quote its symbol name
3912 using `function'.
3913
3914 arguments: (((FUNCTION ARGLIST &body BODY) &rest FUNCTIONS) &body FORM)
3915 "
3916 ;; XEmacs; the byte-compiler has a much better implementation of `labels'
3917 ;; in `byte-compile-initial-macro-environment' that is used in compiled
3918 ;; code.
3919 (let ((vars nil) (sets nil)
3920 (byte-compile-macro-environment byte-compile-macro-environment))
3921 (while bindings
3922 (let ((var (gensym)))
3923 (push var vars)
3924 (push `#'(lambda ,@(cdr (cl-transform-lambda (cdar bindings)
3925 (caar bindings)))) sets)
3926 (push var sets)
3927 (push (list (car (pop bindings)) 'lambda '(&rest cl-labels-args)
3928 (list 'list* '(quote funcall) (list 'quote var)
3929 'cl-labels-args))
3930 byte-compile-macro-environment)))
3931 (cl-macroexpand-all (list* 'lexical-let vars (cons (cons 'setq sets) body))
3932 byte-compile-macro-environment)))
3933
3934 ;;;###autoload
3935 (defmacro flet (functions &rest form)
3936 "Make temporary function definitions.
3937
3938 This is an analogue of `let' that operates on the function cell of FUNC
3939 rather than its value cell. The FORMs are evaluated with the specified
3940 function definitions in place, then the definitions are undone (the FUNCs go
3941 back to their previous definitions, or lack thereof). This is in
3942 contravention of Common Lisp, where `flet' makes a lexical, not a dynamic,
3943 function binding.
3944
3945 Normally you should use `labels', not `flet'; `labels' does not have the
3946 problems caused by dynamic scope, is less expensive when byte-compiled, and
3947 allows lexical shadowing of functions with byte-codes and byte-compile
3948 methods, where `flet' will fail. The byte-compiler will warn when this
3949 happens.
3950
3951 If you need to shadow some existing function at run time, and that function
3952 has no associated byte code or compiler macro, then `flet' is appropriate.
3953
3954 arguments: (((FUNCTION ARGLIST &body BODY) &rest FUNCTIONS) &body FORM)"
3955 ;; XEmacs; leave warnings, errors and modifications of
3956 ;; byte-compile-function-environment to the byte compiler. See
3957 ;; byte-compile-initial-macro-environment in bytecomp.el.
3958 (list*
3959 'letf*
3960 (mapcar
3961 (function*
3962 (lambda ((function . definition))
3963 `((symbol-function ',function)
3964 ,(cons 'lambda (cdr (cl-transform-lambda definition function))))))
3965 functions) form))
3967 3966
3968 (run-hooks 'cl-macs-load-hook) 3967 (run-hooks 'cl-macs-load-hook)
3969 3968
3970 ;;; arch-tag: afd947a6-b553-4df1-bba5-000be6388f46 3969 ;;; arch-tag: afd947a6-b553-4df1-bba5-000be6388f46
3971 ;;; cl-macs.el ends here 3970 ;;; cl-macs.el ends here