;ELC ;;; compiled by kwzh@nutrimat.gnu.ai.mit.edu on Thu Jun 15 18:22:53 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/cl-extra.el ;;; emacs version 19.28.94.3. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.28.90"))) (error "`cl-extra.el' was compiled for Emacs 19.29 or later")) (byte-code " >\n!" [cl-19 features error "Tried to load `cl-extra' before `cl'!"] 2) (defalias 'cl-push '(macro . #[(x place) " EE" [setq place cons x] 5])) (defalias 'cl-pop '(macro . #[(place) "\n\n\nDEED" [car prog1 place setq cdr] 7])) (byte-code " B" [cl-emacs-type current-load-list] 2) #@67 Coerce OBJECT to type TYPE. TYPE is a Common Lisp type specifier. (defalias 'coerce #[(x type) "=\n< \n\n\"=$\n! \n\n!=5\n;1\n\n=G\n!C\n\n!=]\n;]\nGU]\nH=o\n9o\n!\"=y\n!\n\"\n\n#" [type list x append nil vector vectorp vconcat string array arrayp character 1 0 coerce symbol-name float typep error "Can't coerce %s to type %s"] 4 (#$ . 798)]) #@218 T if two Lisp objects have similar structures and contents. This is like `equal', except that it accepts numerically equal numbers of different types (float vs. integer), and also compares strings case-insensitively. (defalias 'equalp #[(x y) " =‡;& ;G GU % 4  U:]:R :RA@ A@\"9:? \"! !G GUG SY H H\"t W) " [x y t equalp vectorp i 0] 4 (#$ . 1226)]) (defalias 'cl-mapcar-many #[(cl-func cl-seqs) "AAz\"\" ! \f ! Wu\f  \fc \f@:N\f@@\f@AT\f@ H\fA\f A 2 \"\nB T %\n.@A@GG^  T W:A@ H:A@ H\"\nB*\n+" [cl-seqs nil cl-res apply min mapcar length cl-n 0 cl-i copy-sequence cl-args cl-p1 cl-p2 cl-func cl-y cl-x -1] 6]) #@164 Map a function across one or more sequences, returning a sequence. TYPE is the sequence type to return, FUNC is the function, and SEQS are the argument sequences. (defalias 'map #[(cl-type cl-func cl-seq &rest cl-rest) "\n \f$ \")" [apply mapcar* cl-func cl-seq cl-rest cl-res cl-type coerce] 5 (#$ . 2065)]) #@139 Map FUNC to each sublist of LIST or LISTS. Like `mapcar', except applies to lists and their cdr's rather than to the elements themselves. (defalias 'maplist #[(cl-func cl-list &rest cl-rest) "6\n!B >1 \"B \f\fA@A!+\nM\n!B\nA=)" [cl-rest nil cl-list copy-sequence cl-p cl-args cl-res apply cl-func] 5 (#$ . 2393)]) #@73 Like `mapcar', but does not accumulate values returned by the function. (defalias 'mapc #[(cl-func cl-seq &rest cl-rest) "\f %\f \" " [cl-rest apply map nil cl-func cl-seq mapcar] 6 (#$ . 2768)]) #@74 Like `maplist', but does not accumulate values returned by the function. (defalias 'mapl #[(cl-func cl-list &rest cl-rest) " \f$ \f ! A)\f" [cl-rest apply maplist cl-func cl-list cl-p] 6 (#$ . 2985)]) #@74 Like `mapcar', but nconc's together the values returned by the function. (defalias 'mapcan #[(cl-func cl-seq &rest cl-rest) " \f $\"" [apply nconc mapcar* cl-func cl-seq cl-rest] 7 (#$ . 3215)]) #@75 Like `maplist', but nconc's together the values returned by the function. (defalias 'mapcon #[(cl-func cl-list &rest cl-rest) " \f $\"" [apply nconc maplist cl-func cl-list cl-rest] 7 (#$ . 3421)]) #@127 Return true if PREDICATE is true of any element of SEQ or SEQs. If so, return the true (non-nil) value returned by PREDICATE. (defalias 'some #[(cl-pred cl-seq &rest cl-rest) " < Í  A@! )" [cl-rest cl-seq cl-some (byte-code "\f %‡" [apply map nil #[(&rest cl-x) " \n\" \")" [apply cl-pred cl-x cl-res throw cl-some] 4] cl-seq cl-rest] 6) nil cl-x cl-pred] 3 (#$ . 3631)]) #@67 Return true if PREDICATE is true of every element of SEQ or SEQs. (defalias 'every #[(cl-pred cl-seq &rest cl-rest) " < Í \f @! A ?" [cl-rest cl-seq cl-every (byte-code "\f %Ƈ" [apply map nil #[(&rest cl-x) " \n\" \"" [apply cl-pred cl-x throw cl-every nil] 3] cl-seq cl-rest t] 6) cl-pred] 3 (#$ . 4048)]) #@68 Return true if PREDICATE is false of every element of SEQ or SEQs. (defalias 'notany #[(cl-pred cl-seq &rest cl-rest) "\n \f$?" [apply some cl-pred cl-seq cl-rest] 5 (#$ . 4395)]) #@67 Return true if PREDICATE is false of some element of SEQ or SEQs. (defalias 'notevery #[(cl-pred cl-seq &rest cl-rest) "\n \f$?" [apply every cl-pred cl-seq cl-rest] 5 (#$ . 4584)]) (defalias 'cl-map-keymap #[(cl-func cl-map) "9\fK =\f\" A@! - A@!\f\f \" _)\f)" [0 args abs 1 a b gcd] 4 (#$ . 7115)]) #@49 Return the integer square root of the argument. (defalias 'isqrt #[(a) "LVLYÂ*YĂ*Y)ł*  \\ʥ WH 0 *=T\"" [a 0 1000000 10000 1000 100 10 nil g2 g 2 signal arith-error] 4 (#$ . 7296)]) #@71 Return X raised to the power of Y. Works only for integer arguments. (defalias 'cl-expt #[(x y) "XU‡ > ŦU$‚% _ť\"_" [y 0 1 x (-1 1) 2 cl-expt] 5 (#$ . 7545)]) (byte-code "! K!\"" [fboundp expt subrp defalias cl-expt] 3) #@129 Return a list of the floor of X and the fractional part of X. With two arguments, return floor and remainder of their quotient. (defalias 'floor* #[(x &optional y) " \n\" \n\n _ Z)D" [floor x y q] 5 (#$ . 7819)]) #@133 Return a list of the ceiling of X and the fractional part of X. With two arguments, return ceiling and remainder of their quotient. (defalias 'ceiling* #[(x &optional y) " \n\"A@U  @T A@\nZD)" [floor* x y res 0 1] 4 (#$ . 8049)]) #@141 Return a list of the integer part of X and the fractional part of X. With two arguments, return truncation and remainder of their quotient. (defalias 'truncate* #[(x &optional y) "Y\n? \nY=\n\"\n\"" [x 0 y floor* ceiling*] 3 (#$ . 8301)]) #@139 Return a list of X rounded to the nearest integer and the remainder. With two arguments, return rounding and remainder of their quotient. (defalias 'round* #[(x &optional y) "U DD¥ \\\"A@U: \\U: @¦U: @S DB @ A@ ZD* ! _Z)D ^ D ! Z)D" [y x 2 hy floor* res 0 round q] 5 (#$ . 8561)]) #@59 The remainder of X divided by Y, with the same sign as Y. (defalias 'mod* #[(x y) " \n\"A@" [floor* x y] 3 (#$ . 8902)]) #@59 The remainder of X divided by Y, with the same sign as X. (defalias 'rem* #[(x y) " \n\"A@" [truncate* x y] 3 (#$ . 9031)]) #@55 Return 1 if A is positive, -1 if negative, 0 if zero. (defalias 'signum #[(a) "V‡WÇ" [a 0 1 -1] 2 (#$ . 9163)]) (byte-code " B" [*random-state* current-load-list] 2) #@124 Return a random nonnegative number less than LIM, an integer or float. Optional second arg STATE is a random-state object. (defalias 'random* #[(lim &optional state) " Hg !ǦZ\n \f \"I \fI \\Ϧ VS   \f Z \fI1 T Wf\"S,HTϦI HTϦI\f   H \fHZI\"XV\"\"\\SW\\T\"W\")ݥ_," [state *random-state* 3 vec 0 1357335 abs 1357333 1 nil ii k j i make-vector 55 21 200 random* 2 logand 8388607 n lim 512 lsh 9 1023 mask 8388608.0] 7 (#$ . 9354)]) #@143 Return a copy of random-state STATE, or of `*random-state*' if omitted. If STATE is t, return a new state object seeded from the time of day. (defalias 'make-random-state #[(&optional state) "\n!!\"$ !" [state make-random-state *random-state* vectorp cl-copy-tree t vector cl-random-state-tag -1 30 cl-random-time] 5 (#$ . 9955)]) #@46 Return t if OBJECT is a random-state object. (defalias 'random-state-p #[(object) " ! GU H=" [vectorp object 4 0 cl-random-state-tag] 2 (#$ . 10321)]) (defalias 'cl-finite-do #[(func a b) "" [err (byte-code " \n\" ĥU? )" [func a b res 2] 4) ((arith-error))] 3]) (byte-code " B B B B B B B B" [most-positive-float current-load-list most-negative-float least-positive-float least-negative-float least-positive-normalized-float least-negative-normalized-float float-epsilon float-negative-epsilon] 2) (defalias 'cl-float-limits #[nil "É#\"_ɥ#8ɥ_\"#J\\8ɥ #r \\Ur \\ ɥR[ \f\f _Ϗɥ ɥ  [\fԏɥ[\\Uɥ\\ZUɥ\\+Ç" [most-positive-float 20.0 2.0 nil z y x cl-finite-do * 2 + most-negative-float 16 err (byte-code "_U\nV" [x 2 y 0] 3) ((arith-error)) least-positive-normalized-float least-negative-normalized-float 1 (byte-code "V" [x 2 0] 2) ((arith-error)) least-positive-float least-negative-float 1.0 1.0 1.0 float-epsilon 1.0 1.0 1.0 float-negative-epsilon] 6]) #@165 Return the subsequence of SEQ from START to END. If END is omitted, it defaults to the length of the sequence. If START or END is negative, it counts from the end. (defalias 'subseq #[(seq start &optional end) ";\n \nO\n\nW\nG\\ W. \f,G\\A@ >A@='!' !E V7 \"C!L)F*" [:test cl-keys eql :size 20 cl-size cl-test eq fboundp make-hashtable cl-hash-table-tag 1 make-vector 0 make-symbol "--hashsym--" sym nil] 6 (#$ . 14432)]) (byte-code "! !!!!H! B " [boundp cl-lucid-hash-tag fboundp make-hashtable vectorp 1 0 make-symbol "--cl-hash-tag--" current-load-list] 3) #@37 Return t if OBJECT is a hash table. (defalias 'hash-table-p #[(x) "=%!GUH =%!%!" [x cl-hash-table-tag vectorp 4 0 cl-lucid-hash-tag fboundp hashtablep] 2 (#$ . 15169)]) (defalias 'cl-not-hash-table #[(x &optional y &rest z) " \fD\"" [signal wrong-type-argument hash-table-p y x] 4]) (defalias 'cl-hash-lookup #[(key table) "= !8A@ \f9)\fJ :>!HGVH˜+;\\ =9k!VW!\"H\f\"J  = = > \" $ E," [table cl-hash-table-tag cl-not-hash-table 2 array test key str nil sym vectorp 0 equalp symbol-name -8000000 8000000 truncate ["0" "1" "2" "3" "4" "5" "6" "7" "8" "9" "10" "11" "12" "13" "14" "15"] logand 15 "*" intern-soft eq eql (eql equal) assoc assoc* :test] 6]) (byte-code "!!K!KB!;!8K!8K9B!\\!YK!YKZ B!}!zK!zK{ B" [boundp cl-builtin-gethash fboundp gethash subrp cl-not-hash-table current-load-list cl-builtin-remhash remhash cl-builtin-clrhash clrhash cl-builtin-maphash maphash] 2) #@68 Look up KEY in HASH-TABLE; return corresponding value, or DEFAULT. (defalias 'cl-gethash #[(key table &optional def) ":\n\"@ @A\f) \n\f#" [table cl-hash-lookup key found def cl-builtin-gethash] 5 (#$ . 16350)]) (defalias (quote gethash) (quote cl-gethash)) (defalias 'cl-puthash #[(key val table) ":o\n\"@ @\fk 8U88G_VA8\" 8\"AA ) 88\"\n\fB A@BLa8\n\fB A@BLAAA8T)u\n\f#\f" [table cl-hash-lookup key found val 2 3 make-vector 0 new-table mapatoms #[(sym) "\n! \"\nJL" [intern symbol-name sym new-table] 3] intern puthash] 5]) #@29 Remove KEY from HASH-TABLE. (defalias 'cl-remhash #[(key table) ":?\n\"@= @ A@\"AAA8S 85 88\" L;8 L))\n\n#=?\f\n\"" [table cl-hash-lookup key found delq del 3 2 intern t cl-builtin-gethash --cl-- cl-builtin-remhash] 5 (#$ . 16960)]) (defalias (quote remhash) (quote cl-remhash)) #@19 Clear HASH-TABLE. (defalias 'cl-clrhash #[(table) ":5!!898L+AA8G\"AAAƠ:!ć" [table hash-table-p cl-not-hash-table 2 nil make-vector 0 cl-builtin-clrhash] 4 (#$ . 17284)]) (defalias (quote clrhash) (quote cl-clrhash)) #@51 Call FUNCTION on keys and values from HASH-TABLE. (defalias 'cl-maphash #[(cl-func cl-table) " !\n ! :% 89 8!# 8\" \"" [hash-table-p cl-table cl-not-hash-table mapatoms #[(cl-x) "J @@@A\"A‡" [cl-x cl-func nil] 4] 2 vector cl-builtin-maphash cl-func] 5 (#$ . 17545)]) (defalias (quote maphash) (quote cl-maphash)) #@45 Return the number of entries in HASH-TABLE. (defalias 'hash-table-count #[(table) " !\n ! : 8 !" [hash-table-p table cl-not-hash-table 3 hashtable-fullness] 2 (#$ . 17904)]) #@69 Insert a pretty-printed rendition of a Lisp FORM in current buffer. (defalias 'cl-prettyprint #[(form) "` !ñ`\nTb #+!c !\nTb *" [nil last pt "\n" prin1-to-string form search-forward "(quote " t delete-backward-char 7 "'" forward-sexp delete-char 1 cl-do-prettyprint] 4 (#$ . 18096)]) (defalias 'cl-do-prettyprint #[nil "w!!%!%!%!%!!.!!7!!WW iY u n!n |!| !?c |u), " [" " nil looking-at "(" "((" "(prog" "(unwind-protect " "(function (" "(cl-block-wrapper " "(defun " "(defmacro " "(let\\*? " "(while " "(p?set[qf] " set let two skip forward-sexp 78 backward-sexp t nl 1 cl-do-prettyprint ")" "\n" lisp-indent-line] 6]) (byte-code "! B! B‡" [boundp cl-macroexpand-cmacs nil current-load-list cl-closure-vars] 2) #@114 Expand all macro calls through a Lisp FORM. This also does some trivial optimizations to make the form prettier. (defalias 'cl-macroexpand-all #[(form &optional env) "\n\"= !=: @>A@6!B\n\"ɉ! \f   @:l !\n\"9^  !\n\")B @\n\"9~ D)\fB\f A F @=͂Ղ@\f!\n\"#+@=@A\"B@=@A@8\n\"!\"$@>A@=!\n\" !~@=~ !\"~!\"%!%\"'( @;1 @=B A @D(B(!!!@#E'(\"%!\"' \"#DE!\"$C#+@! #D)@>@A@!\n\"#@=!A@\n\"@=A\n\":;;@9;!;;:B!:B*@A\n\"B" [form macroexpand env cl-macroexpand-cmacs compiler-macroexpand (let let*) cl-macroexpand-all progn cddr nil cadr lets res letf caar exp t cl-macroexpand-body cdar list* let letf* cond mapcar #[(x) " \n\"" [cl-macroexpand-body x env] 3] condition-case 2 #[(x) "@A\n\"B" [x cl-macroexpand-body env] 4] cdddr (quote function) lambda cddadr body cl-closure-vars function cl-expr-contains-any gensym new pairlis sub decls interactive quote put last used append list (quote lambda) (quote (&rest --cl-rest--)) sublis (quote apply) (quote quote) cadadr #[(x) "\nE" [list (quote quote) x] 3] ((quote --cl-rest--)) (defun defmacro) setq args p setf] 16 (#$ . 18985)]) (defalias 'cl-macroexpand-body #[(body &optional env) "\n\"" [mapcar #[(x) " \n\"" [cl-macroexpand-all x env] 3] body] 3]) (defalias 'cl-prettyexpand #[(form &optional full) "!\n\n?\"!!!+" [message "Expanding..." full nil byte-compile-macro-environment cl-compiling-file cl-macroexpand-cmacs cl-macroexpand-all form ((block) (eval-when)) "Formatting..." cl-prettyprint ""] 3]) (run-hooks (quote cl-extra-load-hook))