;ELC ;;; compiled by roland@churchy.gnu.ai.mit.edu on Sat Jun 18 13:26:58 1994 ;;; from file /gd/gnu/emacs/19.0/lisp/cl-extra.el ;;; emacs version 19.25.9. ;;; 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"))) (error "`/gd/gnu/emacs/19.0/lisp/cl-extra.el' was compiled for Emacs 19")) (byte-code " >\n!\"\"" [cl-19 features error "Tried to load `cl-extra' before `cl'!" defalias cl-push (macro . #[(x place) " EE" [setq place cons x] 5]) cl-pop (macro . #[(place) "\n\n\nDEED" [car prog1 place setq cdr] 7])] 3) (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 "\ Coerce OBJECT to type TYPE. TYPE is a Common Lisp type specifier."]) (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 "\ 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 (quote 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]) (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 "\ 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 '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 "\ 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 'mapc #[(cl-func cl-seq &rest cl-rest) "\f %\f \" " [cl-rest apply map nil cl-func cl-seq mapcar] 6 "\ Like `mapcar', 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 "\ Like `maplist', but does not accumulate 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 "\ Like `mapcar', 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 "\ Like `maplist', but nconc's together the values returned by the function."]) (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 "\ 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 '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 "\ Return true if PREDICATE is true 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 "\ Return true if PREDICATE is false of every 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 "\ Return true if PREDICATE is false of some element of SEQ or SEQs."]) (byte-code "\"\"\"\"\"\"\"" [defalias cl-map-keymap #[(cl-func cl-map) "9\fK =\f\" A@! - A@!\f\f \" _)\f)" [0 args abs 1 a b gcd] 4 "\ Return the least common multiple of the arguments."]) (defalias 'isqrt #[(a) "LVLYÂ*YĂ*Y)ł*  \\ʥ WH 0 *=T\"" [a 0 1000000 10000 1000 100 10 nil g2 g 2 signal arith-error] 4 "\ Return the integer square root of the argument."]) (defalias 'cl-expt #[(x y) "XU‡ > ŦU$‚% _ť\"_" [y 0 1 x (-1 1) 2 cl-expt] 5 "\ Return X raised to the power of Y. Works only for integer arguments."]) (byte-code "! K!\"" [fboundp expt subrp defalias cl-expt] 3) (defalias 'floor* #[(x &optional y) " \n\" \n\n _ Z)D" [floor x y q] 5 "\ 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 'ceiling* #[(x &optional y) " \n\"A@U  @T A@\nZD)" [floor* x y res 0 1] 4 "\ 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 'truncate* #[(x &optional y) "Y\n? \nY=\n\"\n\"" [x 0 y floor* ceiling*] 3 "\ 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 '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 "\ Return a list of X rounded to the nearest integer and the remainder. With two arguments, return rounding and remainder of their quotient."]) (defalias 'mod* #[(x y) " \n\"A@" [floor* x y] 3 "\ The remainder of X divided by Y, with the same sign as Y."]) (defalias 'rem* #[(x y) " \n\"A@" [truncate* x y] 3 "\ The remainder of X divided by Y, with the same sign as X."]) (defalias 'signum #[(a) "V‡WÇ" [a 0 1 -1] 2 "\ Return 1 if A is positive, -1 if negative, 0 if zero."]) (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 "\ Return a random nonnegative number less than LIM, an integer or float. Optional second arg STATE is a random-state object."]) (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 "\ 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 'random-state-p #[(object) " ! GU H=" [vectorp object 4 0 cl-random-state-tag] 2 "\ Return t if OBJECT is a random-state object."]) (byte-code "\"\"" [defalias cl-finite-do #[(func a b) "" [err (byte-code " \n\" ĥU? )" [func a b res 2] 4) ((arith-error))] 3] 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]] 3) (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 "\ Make an empty Common Lisp-style hash-table. If :test is `eq', this can use Lucid Emacs built-in hash-tables. In non-Lucid Emacs, or with non-`eq' test, this internally uses a-lists. Keywords supported: :test :size The Common Lisp keywords :rehash-size and :rehash-threshold are ignored."]) (byte-code "! !!!!H!" [boundp cl-lucid-hash-tag fboundp make-hashtable vectorp 1 0 make-symbol "--cl-hash-tag--"] 3) (defalias 'hash-table-p #[(x) "=%!GUH =%!%!" [x cl-hash-table-tag vectorp 4 0 cl-lucid-hash-tag fboundp hashtablep] 2 "\ Return t if OBJECT is a hash table."]) (byte-code "\"\"!%!\"K!\"K#!@!=K!=K>\n![!XK!XKY\f!v!sK!sKt" [defalias cl-not-hash-table #[(x &optional y &rest z) " \fD\"" [signal wrong-type-argument hash-table-p y x] 4] 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] boundp cl-builtin-gethash fboundp gethash subrp cl-builtin-remhash remhash cl-builtin-clrhash clrhash cl-builtin-maphash maphash] 3) (defalias 'cl-gethash #[(key table &optional def) ":\n\"@ @A\f) \n\f#" [table cl-hash-lookup key found def cl-builtin-gethash] 5 "\ Look up KEY in HASH-TABLE; return corresponding value, or DEFAULT."]) (byte-code "\"\"" [defalias gethash cl-gethash 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]] 3) (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 "\ Remove KEY from HASH-TABLE."]) (defalias (quote remhash) (quote cl-remhash)) (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 "\ Clear HASH-TABLE."]) (defalias (quote clrhash) (quote cl-clrhash)) (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 "\ Call FUNCTION on keys and values from HASH-TABLE."]) (defalias (quote maphash) (quote cl-maphash)) (defalias 'hash-table-count #[(table) " !\n ! : 8 !" [hash-table-p table cl-not-hash-table 3 hashtable-fullness] 2 "\ Return the number of entries in HASH-TABLE."]) (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 "\ Insert a pretty-printed rendition of a Lisp FORM in current buffer."]) (byte-code "\"! !Ň" [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] boundp cl-macroexpand-cmacs nil cl-closure-vars] 3) (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 "\ Expand all macro calls through a Lisp FORM. This also does some trivial optimizations to make the form prettier."]) (byte-code "\"\"!" [defalias cl-macroexpand-body #[(body &optional env) "\n\"" [mapcar #[(x) " \n\"" [cl-macroexpand-all x env] 3] body] 3] 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 cl-extra-load-hook] 3)