Current File : //usr/local/share/emacs/27.2/lisp/obsolete/cl.elc
;ELC
;;; Compiled
;;; in Emacs version 27.2
;;; with all optimizations.
;;; This file uses dynamic docstrings, first added in Emacs 19.29.
;;; This file does not contain utf-8 non-ASCII characters,
;;; and so can be loaded in Emacs versions earlier than 23.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(byte-code "\300\301!\210\300\302!\210\300\303!\207" [require cl-lib macroexp gv] 2)
#@47 Stop unloading of the Common Lisp extensions.
(defalias 'cl-unload-function #[0 "\300\301!\210\302\207" [message "Cannot unload the feature `cl'" t] 2 (#$ . 493)])
(byte-code "\300\211\203 \211@\301\302\303\304\"!\"\210A\266\202\202 \210\305\211\203A \211@\211:\203. \211A@\262\2024 \302\303\304\"!\306\"\266A\266\202\202 \207" [(float-negative-epsilon float-epsilon least-negative-normalized-float least-positive-normalized-float least-negative-float least-positive-float most-negative-float most-positive-float) defvaralias intern format "cl-%s" ((get* . cl-get) (random* . cl-random) (rem* . cl-rem) (mod* . cl-mod) (round* . cl-round) (truncate* . cl-truncate) (ceiling* . cl-ceiling) (floor* . cl-floor) (rassoc* . cl-rassoc) (assoc* . cl-assoc) (member* . cl-member) (delete* . cl-delete) (remove* . cl-remove) (defsubst* . cl-defsubst) (sort* . cl-sort) (function* . cl-function) (defmacro* . cl-defmacro) (defun* . cl-defun) (mapcar* . cl-mapcar) remprop getf tailp list-length nreconc revappend concatenate subseq random-state-p make-random-state signum isqrt lcm gcd notevery notany every some mapcon mapl maplist map equalp coerce tree-equal nsublis sublis nsubst-if-not nsubst-if nsubst subst-if-not subst-if subsetp nset-exclusive-or set-exclusive-or nset-difference set-difference nintersection intersection nunion union rassoc-if-not rassoc-if assoc-if-not assoc-if member-if-not member-if merge stable-sort search mismatch count-if-not count-if count position-if-not position-if position find-if-not find-if find nsubstitute-if-not nsubstitute-if nsubstitute substitute-if-not substitute-if substitute delete-duplicates remove-duplicates delete-if-not delete-if remove-if-not remove-if replace fill reduce compiler-macroexpand define-compiler-macro assert check-type typep deftype defstruct callf2 callf letf* letf rotatef shiftf remf psetf (define-setf-method . define-setf-expander) the locally multiple-value-setq multiple-value-bind symbol-macrolet macrolet progv psetq do-all-symbols do-symbols do* do loop return-from return block etypecase typecase ecase case load-time-value eval-when destructuring-bind gentemp pairlis acons subst adjoin copy-list ldiff list* tenth ninth eighth seventh sixth fifth fourth third endp rest second first svref copy-seq evenp oddp minusp plusp floatp-safe declaim proclaim nth-value multiple-value-call multiple-value-apply multiple-value-list values-list values pushnew decf incf) defalias] 8)
#@23
(fn FUN &rest ARGS)
(defalias 'cl--wrap-in-nil-block #[385 "\300\301\302\"E\207" [cl-block nil apply] 7 (#$ . 2962)])
(byte-code "\300\301\302\303#\210\300\304\302\303#\207" [advice-add dolist :around cl--wrap-in-nil-block dotimes] 4)
#@20
(fn &rest SPECS)
(defalias 'cl--pass-args-to-cl-declare #[128 "\300\301B!\207" [macroexpand cl-declare] 4 (#$ . 3207)])
(advice-add 'declare :after 'cl--pass-args-to-cl-declare)
(defvar cl-closure-vars nil)
(defvar cl--function-convert-cache nil)
#@239 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'.
(fn F)
(defalias 'cl--function-convert #[257 "\302\303!\210\211@=\203 A\207\211\242\304=\203\234 \305\306AA\" \203\213 \307 \"\203\213 \305\310 \"\311 \"\312@;\204= @\242\313=\203L \314\211A\262\242DB\262\202/ \315\316 !@\317\320#\210\321\322\323\324\325\237\"\321\326\321\327\330\304\324A@\"\325\"BBDE\305\331 \"\332\244BBBC\"BBB\266\203\202\233 \304A@BB\330DB\262\207\333!\207" [cl--function-convert-cache cl-closure-vars require cl-macs lambda mapcar #[257 "\301\"\207" [macroexpand-all-environment macroexpand-all] 4 "\n\n(fn F)"] cl--expr-contains-any cl-gensym cl-pairlis nil interactive quote put last used t list 'lambda '(&rest --cl-rest--) append cl-sublis 'apply 'function function #[257 "\300\301E\207" [list 'quote] 4 "\n\n(fn X)"] ('--cl-rest--) cl--labels-convert] 20 (#$ . 3464)])
#@159 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)
(defalias 'lexical-let '(macro . #[385 "\302\303\"\304\305\302\306\"BB\307\310B B\"\311!@\312N\204: \313\314\302\315\"\316\302\317\"\320\302\321 \"\"EC\"B\202K \316\302\322\"\323\324\314\302\325\"\"BF)\207" [cl-closure-vars macroexpand-all-environment mapcar #[257 "\211:\204 \211C\262\301\302\303@\"!B\211@\304L\210\211@A@@E\207" [cl-closure-vars make-symbol format "--cl-%s--" [bad-lexical-ref]] 6 "\n\n(fn X)"] macroexpand-all cl-symbol-macrolet #[257 "\211@\300\3018DD\207" [symbol-value 2] 5 "\n\n(fn X)"] function cl--function-convert last used progn append #[257 "\300\3018D\207" [defvar 2] 4 "\n\n(fn X)"] let #[257 "\3008A@D\207" [2] 3 "\n\n(fn X)"] cl-sublis #[257 "\3008\301\3008DB\207" [2 quote] 5 "\n\n(fn X)"] #[257 "\3008\301\302\303@\"DD\207" [2 make-symbol format "--%s--"] 6 "\n\n(fn X)"] setf apply #[257 "\300\3018DA@D\207" [symbol-value 2] 4 "\n\n(fn X)"]] 13 (#$ . 4534)]))
(byte-code "\300\301\302\303#\304\301\305\306#\207" [function-put lexical-let lisp-indent-function 1 put edebug-form-spec let] 5)
#@264 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)
(defalias 'lexical-let* '(macro . #[385 "\204 \300B\207\301!\262\203\" \302\211A\262\242CBBC\262\202
\211@\207" [progn reverse lexical-let] 5 (#$ . 5758)]))
(byte-code "\300\301\302\303#\304\301\305\306#\207" [function-put lexical-let* lisp-indent-function 1 put edebug-form-spec let] 5)
#@461 Make temporary overriding function definitions.
This is an analogue of a dynamically scoped `let' that operates on the function
cell of FUNCs rather than their value cell.
If you want the Common-Lisp style of `flet', you should use `cl-flet'.
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...)
(defalias 'flet '(macro . #[385 "\300\301\302\"BB\207" [letf mapcar #[257 "\302@!\203 \211@K\242\303=\204 \211@\236A\203 \304\305!\210\306\307A@\310@AABBED\311 \203N @\312N\203? \304\313\314@!\"\210\315\301!\203N @\316!B B\317\320@DDD\207" [macroexpand-all-environment byte-compile-function-environment fboundp macro error "Use `labels', not `flet', to rebind macro names" cl-function lambda cl-block cl--compiling-file byte-compile "Byte-compiling a redefinition of `%s' will not work - use `labels' instead" symbol-name boundp eval symbol-function quote] 7 "\n\n(fn X)"]] 6 (#$ . 6327)]))
(byte-code "\300\301\302\303#\304\301\305\306#\210\307\301\310\311#\207" [function-put flet lisp-indent-function 1 put edebug-form-spec cl-flet make-obsolete "use either `cl-flet' or `cl-letf'." "24.3"] 5)
#@181 Make temporary function bindings.
Like `cl-labels' except that the lexical scoping is handled via `lexical-let'
rather than relying on `lexical-binding'.
(fn BINDINGS &rest BODY)
(defalias 'labels '(macro . #[385 "\301\211\211\203L \211@\302\303\304@\"!\211B\262\305\306ABDB\262\211B\262@\306\307\310\311\312\313\314DE\315\316\314 D\317BBBFEBB\262\210A\266\202\202 \210\320\321\322BBBB\"\207" [macroexpand-all-environment nil make-symbol format "--cl-%s--" cl-function lambda (&rest cl-labels-args) if (eq (car cl-labels-args) cl--labels-magic) list cl--labels-magic quote cl-list* 'funcall (cl-labels-args) macroexpand-all lexical-let setq] 18 (#$ . 7608)]))
(byte-code "\300\301\302\303#\304\301\305\306#\210\307\301\310\311#\207" [function-put labels lisp-indent-function 1 put edebug-form-spec cl-flet make-obsolete cl-labels "24.3"] 5)
#@17
(fn CL-GV DO)
(defalias 'cl--gv-adapt #[514 "@A@\300\211C\203= \301@!\203) \211\211A\262\242\211A\262\242B\242B\240\210\202 \211A\262\242\211A\262\242DB\262\202 \302\303\242\304 8\"\305\306\307\310\311\n\"\312\"\313\314%\"\"\207" [nil macroexp-copyable-p macroexp-let* cl-sublis 4 make-byte-code 257 "\211\302!\203 \211\202 \303\304!\305\306\3008@B\301\242B\307\3008\"=\203& \211\202- \310DC\"\207" vconcat vector [macroexp-copyable-p make-symbol "v" cl-sublis 2 3 macroexp-let*] 7 "\n\n(fn EXP)"] 17 (#$ . 8480)])
#@537 Define a `setf' method.
This method shows how to handle `setf's to places of the form
(NAME ARGS...). The argument forms ARGS are bound according to
ARGLIST, as if NAME were going to be expanded as a macro, then
the BODY forms are executed and must return a list of five elements:
a temporary-variables list, a value-forms list, a store-variables list
(of length one), a store-form, and an access-form.
See `gv-define-expander', and `gv-define-setter' for better and
simpler ways to define setf-methods.
(fn NAME ARGLIST &rest BODY)
(defalias 'define-setf-expander '(macro . #[642 "\300\301@;\205 \302\303D\304\211A\262\242FC\305\306\307\310 B\311\300\nB\312BBEDEC\"B\207" [progn append put quote 'setf-documentation gv-define-expander cl-function lambda do cl--gv-adapt (do)] 14 (#$ . 9038)]))
(put 'define-setf-expander 'edebug-form-spec '(&define name cl-lambda-list cl-declarations-or-string def-body))
#@984 Define a `setf' method.
This macro is an easy-to-use substitute for `define-setf-expander'
that works well for simple place forms.
In the simple `defsetf' form, `setf's of the form (setf (NAME
ARGS...) VAL) are transformed to function or macro calls of the
form (FUNC ARGS... VAL). For example:
(defsetf aref aset)
You can replace this form with `gv-define-simple-setter'.
Alternate form: (defsetf NAME ARGLIST (STORE) BODY...).
Here, the above `setf' call is expanded by binding the argument
forms ARGS according to ARGLIST, binding the value form VAL to
STORE, then executing BODY, which must return a Lisp form that
does the necessary `setf' operation. Actually, ARGLIST and STORE
may be bound to temporary variables which are introduced
automatically to preserve proper execution order of the arguments.
For example:
(defsetf nth (n x) (v) \=`(setcar (nthcdr ,n ,x) ,v))
You can replace this form with `gv-define-setter'.
(fn NAME [FUNC | ARGLIST (STORE) BODY...])
(defalias 'defsetf '(macro . #[642 "<\203) \211:\203) \300\301\302\303\304D\305\301\306 @ \" ABBD\307BBBEE\207\310@F\207" [gv-define-expander lambda (do &rest args) gv--defsetter quote cl-function append (do args) gv-define-simple-setter] 14 (#$ . 9965)]))
(byte-code "\300\301\302\303#\210\304\305\306\307#\207" [put defsetf edebug-form-spec (&define name [&or [symbolp &optional stringp] [cl-lambda-list (symbolp)]] cl-declarations-or-string def-body) make-obsolete get-setf-method gv-letplace "24.3"] 4)
#@286 Define a `setf'-like modify macro.
If NAME is called, it combines its PLACE argument with the other
arguments from ARGLIST using FUNC. For example:
(define-modify-macro incf (&optional (n 1)) +)
You can replace this macro with `gv-letplace'.
(fn NAME ARGLIST FUNC &optional DOC)
(defalias 'define-modify-macro '(macro . #[1027 "\300>\203\n \301\302!\210\303\304!\210\305\306!\307B\310>\203# \311\202$ \312\313\314 D\315\f!BBBB\257\207" [&key error "&key not allowed in define-modify-macro" require cl-macs make-symbol "--cl-place--" cl-defmacro &rest cl-list* list #'cl-callf quote cl--arglist-args] 15 (#$ . 11472)]))
(byte-code "\300\301\302\303#\210\304\305\306\307#\210\310\305\306\311#\210\312\313\314\307#\210\315\211\203: \211@\313N\2033 \314N\2043 \300\314\313N#\210A\266\202\202 \210\316\313\314\311#\210\304\317\320\307#\210\310\317\320\311#\207" [put define-modify-macro edebug-form-spec (&define name cl-lambda-list symbolp &optional stringp) defalias cl-macroexpand macroexpand nil make-obsolete "24.3" defvaralias cl-macro-environment macroexpand-all-environment (saved-value saved-variable-comment) make-obsolete-variable cl-macroexpand-all macroexpand-all] 7)
#@30
(fn X &optional Y &rest Z)
(defalias 'cl-not-hash-table #[641 "\300\301\302\206 D\"\207" [signal wrong-type-argument cl-hash-table-p] 7 (#$ . 12679)])
(make-obsolete 'cl-not-hash-table nil "24.3")
(defvar cl-builtin-gethash (symbol-function 'gethash))
(make-obsolete-variable 'cl-builtin-gethash nil "24.3")
(defvar cl-builtin-remhash (symbol-function 'remhash))
(make-obsolete-variable 'cl-builtin-remhash nil "24.3")
(defvar cl-builtin-clrhash (symbol-function 'clrhash))
(make-obsolete-variable 'cl-builtin-clrhash nil "24.3")
(defvar cl-builtin-maphash (symbol-function 'maphash))
(byte-code "\300\301\302\303#\210\304\305\306\302#\210\307\305\306\303#\210\304\310\311\302#\210\307\310\311\303#\210\304\312\313\302#\210\307\312\313\303#\210\304\314\315\302#\210\307\314\315\303#\210\304\316\317\302#\210\307\316\317\303#\210\304\320\321\302#\210\307\320\321\303#\210\304\322\323\302#\210\307\322\323\303#\210\304\324\325\302#\210\307\324\325\303#\210\304\326\327\302#\210\307\326\327\303#\210\304\330\331\302#\210\307\330\331\303#\210\304\332\333\302#\210\307\332\333\303#\210\304\334\335\302#\210\307\334\335\303#\210\304\336\337\302#\210\307\336\337\303#\210\304\340\341\302#\210\307\340\341\303#\207" [make-obsolete-variable cl-builtin-maphash nil "24.3" defalias cl-map-keymap map-keymap make-obsolete cl-copy-tree copy-tree cl-gethash gethash cl-puthash puthash cl-remhash remhash cl-clrhash clrhash cl-maphash maphash cl-make-hash-table make-hash-table cl-hash-table-p hash-table-p cl-hash-table-count hash-table-count cl-map-keymap-recursively cl--map-keymap-recursively cl-map-intervals cl--map-intervals cl-map-extents cl--map-overlays cl-set-getf cl--set-getf] 4)
#@18
(fn ITEM LIST)
(defalias 'cl-maclisp-member #[514 "\211\203 @\232\204 \211A\262\202 \207" [] 4 (#$ . 14368)])
(make-obsolete 'cl-maclisp-member 'member "24.3")
#@38
(fn X NAME ACCESSOR PRED-FORM POS)
(defalias 'cl-struct-setf-expander #[1285 "\300\301!\300\302!CCC\303\304\205' \305\306\307\f#\310\311\312#DEC \313N@\314=\203< \315\n F\202h \316 \317X\203_ \nS\211\262\f\320Y\203Y \321D\262\202F \211\262\202e \322\n\nEEC\"BD\257\207" [make-symbol "--cl-x--" "--cl-store--" progn append or cl-subst cl-x error format "%s storing a non-%s" cl-struct-type vector aset setcar 5 0 cdr nthcdr] 19 (#$ . 14542)])
(byte-code "\300\301\302\303#\210\304\305!\210\306\307!\207" [make-obsolete cl-struct-setf-expander nil "24.3" provide cl run-hooks cl-load-hook] 4)
Mini Shell