(provide (quote mini-cl)) (defmacro defkeyword (x &optional docstring) "Make symbol X a keyword (symbol whose value is itself). Optional second argument is a documentation string for it." (byte-code "9ƒÂÃDE‚ÄÅÆ!\"‡" [x t defconst quote error "`%s' is not a symbol" prin1-to-string] 4)) (defun keywordp (sym) "\ Return `t' if SYM is a keyword." (byte-code "9… ÃÄ!ÅHÆ\"ƒL‚‡" [sym t nil char-equal symbol-name 0 58] 4)) (defun keyword-of (sym) "\ Return a keyword that is naturally associated with symbol SYM. If SYM is keyword, the value is SYM. Otherwise it is a keyword whose name is `:' followed by SYM's name." (byte-code "Ã!ƒ ‚$9ƒÄÅÆ!P! L)‚$ÇÈÉ!\"‡" [sym newsym t keywordp intern ":" symbol-name error "Expected a symbol, not `%s'" prin1-to-string] 7)) (defvar *gentemp-index* 0 "\ Integer used by gentemp to produce new names.") (defvar *gentemp-prefix* "T$$_" "\ Names generated by gentemp begin with this string by default.") (defun gentemp (&optional prefix oblist) "\ Generate a fresh interned symbol. There are 2 optional arguments, PREFIX and OBLIST. PREFIX is the string that begins the new name, OBLIST is the obarray used to search for old names. The defaults are just right, YOU SHOULD NEVER NEED THESE ARGUMENTS IN YOUR OWN CODE." (byte-code "?… ‰ˆ ?… ‰ˆÅÅ ?…@P‰ˆÈ\\‰ˆÉ \"?…<Ê \"‰ˆ‚ˆ *‡" [prefix *gentemp-prefix* oblist obarray newsymbol nil newname *gentemp-index* 1 intern-soft intern] 5)) (defvar *gensym-index* 0 "\ Integer used by gensym to produce new names.") (defvar *gensym-prefix* "G$$_" "\ Names generated by gensym begin with this string by default.") (defun gensym (&optional prefix) "\ Generate a fresh uninterned symbol. There is an optional argument, PREFIX. PREFIX is the string that begins the new name. Most people take just the default, except when debugging needs suggest otherwise." (byte-code "?… ‰ˆÃÆ ?…. P‰ˆ Ç\\‰ˆÈ !?…*É !‰ˆ‚ ˆ *‡" [prefix *gensym-prefix* newsymbol nil newname *gensym-index* "" 1 intern-soft make-symbol] 5)) (defkeyword :setf-update-fn "Property, its value is the function setf must invoke to update a generalized variable whose access form is a function call of the symbol that has this property.") (defkeyword :setf-update-doc "Property of symbols that have a `defsetf' update function on them, installed by the `defsetf' from its optional third argument.") (defmacro setf (&rest pairs) "Generalized `setq' that can set things other than variable values. A use of `setf' looks like (setf {PLACE VALUE}...). The behavior of (setf PLACE VALUE) is to access the generalized variable at PLACE and store VALUE there. It returns VALUE. If there is more than one PLACE and VALUE, each PLACE is set from its VALUE before the next PLACE is evaluated." (byte-code " GÒÓÔ\"Õ\"ƒÖ×!‚*ÕUƒ‚*ÔVƒ\\Ø  @Ù !ÂÚ !?…RÛ EB‰ˆÜ ! @Ù !‰ˆ‚0ˆÝ!,B‚* @Ù ! 9ƒuÞ E‚) <… @‰…9… N‰ ƒ# :…ž @ß=†Æ 9…Æà !…Æ K á !†Å :…Å @ß=)ƒÕ â A C\"B‚ ‰ ˆã äâ A C\"!Lˆ ƒöå!‚æ‰ ˆJC‰ˆå!) æ 8Õ 8ç BE+‚)Öèé !\",)‡" [nforms pairs nil args place value result t head updatefn :setf-update-fn defn T$$_2 *mvalues-count* it *mvalues-values* newsyms bindings /= % 2 0 error "Odd number of arguments to `setf'" progn cadr endp setf cddr nreverse setq lambda fboundp subrp append gensym pair-with-newsyms copy-sequence 1 let "No `setf' update-function for `%s'" prin1-to-string] 21)) (defmacro defsetf (accessfn updatefn &optional docstring) "Define how `setf' works on a certain kind of generalized variable. A use of `defsetf' looks like (defsetf ACCESSFN UPDATEFN [DOCSTRING]). ACCESSFN is a symbol. UPDATEFN is a function or macro which takes one more argument than ACCESSFN does. DEFSETF defines the translation of (SETF (ACCESFN . ARGS) NEWVAL) to be a form like (UPDATEFN ARGS... NEWVAL). The function UPDATEFN must return its last arg, after performing the updating called for." (byte-code "9??ƒ Á‚ÆÇÈ!\"ˆÉ #ˆÉ #‡" [accessfn nil :setf-update-fn updatefn :setf-update-doc docstring error "First argument of `defsetf' must be a symbol, not `%s'" prin1-to-string put] 7)) (defsetf apply (lambda (&rest args) (let* ((fnform (car args)) (applyargs (append (apply (quote list*) (butlast (cdr args))) (last args))) (newupdater nil)) (cond ((and (symbolp fnform) (setq newupdater (get fnform :setf-update-fn))) (apply newupdater applyargs)) (t (error "Can't `setf' to `%s'" (prin1-to-string fnform)))))) "`apply' is a special case for `setf'") (defsetf aref aset "`setf' inversion for `aref'") (defsetf nth setnth "`setf' inversion for `nth'") (defsetf nthcdr setnthcdr "`setf' inversion for `nthcdr'") (defsetf elt setelt "`setf' inversion for `elt'") (defsetf first (lambda (list val) (setnth 0 list val)) "`setf' inversion for `first'") (defsetf second (lambda (list val) (setnth 1 list val)) "`setf' inversion for `second'") (defsetf third (lambda (list val) (setnth 2 list val)) "`setf' inversion for `third'") (defsetf fourth (lambda (list val) (setnth 3 list val)) "`setf' inversion for `fourth'") (defsetf fifth (lambda (list val) (setnth 4 list val)) "`setf' inversion for `fifth'") (defsetf sixth (lambda (list val) (setnth 5 list val)) "`setf' inversion for `sixth'") (defsetf seventh (lambda (list val) (setnth 6 list val)) "`setf' inversion for `seventh'") (defsetf eighth (lambda (list val) (setnth 7 list val)) "`setf' inversion for `eighth'") (defsetf ninth (lambda (list val) (setnth 8 list val)) "`setf' inversion for `ninth'") (defsetf tenth (lambda (list val) (setnth 9 list val)) "`setf' inversion for `tenth'") (defsetf rest (lambda (list val) (setcdr list val)) "`setf' inversion for `rest'") (defsetf car setcar "Replace the car of a cons") (defsetf cdr setcdr "Replace the cdr of a cons") (defsetf caar (lambda (list val) (setcar (nth 0 list) val)) "`setf' inversion for `caar'") (defsetf cadr (lambda (list val) (setcar (cdr list) val)) "`setf' inversion for `cadr'") (defsetf cdar (lambda (list val) (setcdr (car list) val)) "`setf' inversion for `cdar'") (defsetf cddr (lambda (list val) (setcdr (cdr list) val)) "`setf' inversion for `cddr'") (defsetf caaar (lambda (list val) (setcar (caar list) val)) "`setf' inversion for `caaar'") (defsetf caadr (lambda (list val) (setcar (cadr list) val)) "`setf' inversion for `caadr'") (defsetf cadar (lambda (list val) (setcar (cdar list) val)) "`setf' inversion for `cadar'") (defsetf cdaar (lambda (list val) (setcdr (caar list) val)) "`setf' inversion for `cdaar'") (defsetf caddr (lambda (list val) (setcar (cddr list) val)) "`setf' inversion for `caddr'") (defsetf cdadr (lambda (list val) (setcdr (cadr list) val)) "`setf' inversion for `cdadr'") (defsetf cddar (lambda (list val) (setcdr (cdar list) val)) "`setf' inversion for `cddar'") (defsetf cdddr (lambda (list val) (setcdr (cddr list) val)) "`setf' inversion for `cdddr'") (defsetf caaaar (lambda (list val) (setcar (caaar list) val)) "`setf' inversion for `caaaar'") (defsetf caaadr (lambda (list val) (setcar (caadr list) val)) "`setf' inversion for `caaadr'") (defsetf caadar (lambda (list val) (setcar (cadar list) val)) "`setf' inversion for `caadar'") (defsetf cadaar (lambda (list val) (setcar (cdaar list) val)) "`setf' inversion for `cadaar'") (defsetf cdaaar (lambda (list val) (setcdr (caar list) val)) "`setf' inversion for `cdaaar'") (defsetf caaddr (lambda (list val) (setcar (caddr list) val)) "`setf' inversion for `caaddr'") (defsetf cadadr (lambda (list val) (setcar (cdadr list) val)) "`setf' inversion for `cadadr'") (defsetf cdaadr (lambda (list val) (setcdr (caadr list) val)) "`setf' inversion for `cdaadr'") (defsetf caddar (lambda (list val) (setcar (cddar list) val)) "`setf' inversion for `caddar'") (defsetf cdadar (lambda (list val) (setcdr (cadar list) val)) "`setf' inversion for `cdadar'") (defsetf cddaar (lambda (list val) (setcdr (cdaar list) val)) "`setf' inversion for `cddaar'") (defsetf cadddr (lambda (list val) (setcar (cdddr list) val)) "`setf' inversion for `cadddr'") (defsetf cddadr (lambda (list val) (setcdr (cdadr list) val)) "`setf' inversion for `cddadr'") (defsetf cdaddr (lambda (list val) (setcdr (caddr list) val)) "`setf' inversion for `cdaddr'") (defsetf cdddar (lambda (list val) (setcdr (cddar list) val)) "`setf' inversion for `cdddar'") (defsetf cddddr (lambda (list val) (setcdr (cddr list) val)) "`setf' inversion for `cddddr'") (defsetf get put "`setf' inversion for `get' is `put'") (defsetf symbol-function fset "`setf' inversion for `symbol-function' is `fset'") (defsetf symbol-plist setplist "`setf' inversion for `symbol-plist' is `setplist'") (defsetf symbol-value set "`setf' inversion for `symbol-value' is `set'") (defmacro push (item ref) "(push ITEM REF) -> cons ITEM at the head of the g.v. REF (a list)" (byte-code "Âà EE‡" [ref item setq cons] 5)) (defmacro incf (ref &optional delta) "(incf REF [DELTA]) -> increment the g.v. REF by DELTA (default 1)" (byte-code "?…‰ˆÃ Ä EE‡" [delta ref 1 setf +] 5)) (defmacro decf (ref &optional delta) "(decf REF [DELTA]) -> decrement the g.v. REF by DELTA (default 1)" (byte-code "?…‰ˆÃ Ä EE‡" [delta ref 1 setq -] 5)) (defmacro pop (ref) "(pop REF) -> (prog1 (car REF) (setq REF (cdr REF)))" (byte-code " Ã DCÄÅDÆ ÇDEEE)‡" [listname ref gensym let prog1 car setq cdr] 9)) (defun notevery (pred seq &rest moreseqs) "\ Test PREDICATE on each element of SEQUENCE; is it sometimes nil? Extra args are additional sequences; PREDICATE gets one arg from each sequence and we advance down all the sequences together in lock-step. A sequence means either a list or a vector." (byte-code "ËÌ \"!ÄÄÄ@ †Í!?…LÎ \"‰ˆƒ5Ä‚<ʉˆÊ‰ˆA@‰ˆ‚ˆ -)‡" [args seq moreseqs ready nil result applyval remaining current pred t reassemble-argslists list* endp apply] 7)) (defmacro when (condition &rest body) "(when CONDITION . BODY) => evaluate BODY if CONDITION is true." (byte-code "ÂÃÄDÅ $‡" [condition body list* if not nil] 5)) (defun endp (x) "\ t if X is nil, nil if X is a cons; error otherwise." (byte-code "<ƒ ?‚ÁÂÃ!\"‡" [x error "endp received a non-cons, non-null argument `%s'" prin1-to-string] 4)) (defun last (x) "\ Returns the last link in the list LIST." (byte-code "Æ!… ÇÈ!ˆAÉ !?…( A A  ‰ˆÅ*ˆ‚ˆ *‡" [x current-cons next-cons G$$_1 G$$_0 nil nlistp error "Arg to `last' must be a list" endp] 6)) (defun butlast (list &optional n) "\ Return a new list like LIST but sans the last N elements. N defaults to 1. If the list doesn't have N elements, nil is returned." (byte-code "?…‰ˆÃÄà !\"!‡" [n list 1 reverse nthcdr] 5)) (defun list* (arg &rest others) "\ Return a new list containing the first arguments consed onto the last arg. Thus, (list* 1 2 3 '(a b)) returns (1 2 3 a b)." (byte-code "?ƒ ‚ BÅ !Æ !ÇÆ ! @\"ˆ +‡" [others arg allargs front back butlast last rplacd] 6)) (defmacro do (stepforms endforms &rest body) "(do STEPFORMS ENDFORMS . BODY): Iterate BODY, stepping some local variables. STEPFORMS must be a list of symbols or lists. In the second case, the lists must start with a symbol and contain up to two more forms. In the STEPFORMS, a symbol is the same as a (symbol). The other 2 forms are the initial value (def. NIL) and the form to step (def. itself). The values used by initialization and stepping are computed in parallel. The ENDFORMS are a list (CONDITION . ENDBODY). If the CONDITION evaluates to true in any iteration, ENDBODY is evaluated and the last form in it is returned. The BODY (which may be empty) is evaluated at every iteration, with the symbols of the STEPFORMS bound to the initial or stepped values." (byte-code "Ç!… È !ˆÉ!Ê! @ AË ÌÍ DÎ \"BBÎ !BBB,‡" [stepforms endforms initlist steplist endcond endbody body check-do-stepforms check-do-endforms extract-do-inits extract-do-steps let while not append] 11)) (defmacro do* (stepforms endforms &rest body) "`do*' is to `do' as `let*' is to `let'. STEPFORMS must be a list of symbols or lists. In the second case, the lists must start with a symbol and contain up to two more forms. In the STEPFORMS, a symbol is the same as a (symbol). The other 2 forms are the initial value (def. NIL) and the form to step (def. itself). Initializations and steppings are done in the sequence they are written. The ENDFORMS are a list (CONDITION . ENDBODY). If the CONDITION evaluates to true in any iteration, ENDBODY is evaluated and the last form in it is returned. The BODY (which may be empty) is evaluated at every iteration, with the symbols of the STEPFORMS bound to the initial or stepped values." (byte-code "Ç!… È !ˆÉ!Ê! @ AË ÌÍ DÎ \"BBÎ !BBB,‡" [stepforms endforms initlist steplist endcond endbody body check-do-stepforms check-do-endforms extract-do-inits extract-do*-steps let* while not append] 11)) (defun check-do-stepforms (forms) "\ True if FORMS is a valid stepforms for the do[*] macro (q.v.)" (byte-code "Â!ƒÃÄÅ!\"‚ÆÇ\"‡" [forms t nlistp error "Init/Step form for do[*] should be a list, not `%s'" prin1-to-string mapcar (lambda (entry) (byte-code "9†<…@9…GÂWƒÁ‚!ÃÄÅ!\"‡" [entry t 4 error "Init/Step must be symbol or (symbol [init [step]]), not `%s'" prin1-to-string] 4))] 6)) (defun check-do-endforms (forms) "\ True if FORMS is a valid endforms for the do[*] macro (q.v.)" (byte-code "<ƒ Á‚ÂÃÄ!\"‡" [forms t error "Termination form for do macro should be a list, not `%s'" prin1-to-string] 4)) (defun extract-do-inits (forms) "\ Returns a list of the initializations (for do) in FORMS -a stepforms, see the do macro-. Forms is assumed syntactically valid." (byte-code "ÁÂ\"‡" [forms mapcar (lambda (entry) (byte-code "9ƒ ÁD‚<…@Â!D‡" [entry nil cadr] 3))] 3)) (defun extract-do-steps (forms) "\ EXTRACT-DO-STEPS FORMS => an s-expr FORMS is the stepforms part of a DO macro (q.v.). This function constructs an s-expression that does the stepping at the end of an iteration." (byte-code "ÁÂ!BC‡" [forms psetq select-stepping-forms] 3)) (defun extract-do*-steps (forms) "\ EXTRACT-DO*-STEPS FORMS => an s-expr FORMS is the stepforms part of a DO* macro (q.v.). This function constructs an s-expression that does the stepping at the end of an iteration." (byte-code "ÁÂ!BC‡" [forms setq select-stepping-forms] 3)) (defun select-stepping-forms (forms) "\ Separate only the forms that cause stepping." (byte-code "Ä Ä …/ @‰ˆ <… GÅU…&ÆÇ ! @D\"‰ˆ A‰ˆ‚ˆÈ!+‡" [result ptr forms entry nil 3 append caddr nreverse] 5)) (defmacro dolist (stepform &rest body) "(dolist (VAR LIST [RESULTFORM]) . BODY): do BODY for each elt of LIST. The RESULTFORM defaults to nil. The VAR is bound to successive elements of the value of LIST and remains bound (to the nil value) when the RESULTFORM is evaluated." (byte-code "Æ!ƒÇÈÉ!\"‚-@9?ƒ ÇÊÉ@!\"‚-GËV…-ÇÌÉ!\"ˆ@Í!Î!ÏÐÑÒ C BBD EÓ ÅDC EE+‡" [stepform var listform resultform body nil nlistp error "Stepform for `dolist' should be (VAR LIST [RESULT]), not `%s'" prin1-to-string "First component of stepform should be a symbol, not `%s'" 3 "Too many components in stepform `%s'" cadr caddr progn mapcar function lambda let] 15)) (defmacro dotimes (stepform &rest body) "(dotimes (VAR COUNTFORM [RESULTFORM]) . BODY): Repeat BODY, counting in VAR. The COUNTFORM should return a positive integer. The VAR is bound to successive integers from 0 to COUNTFORM-1 and the BODY is repeated for each of them. At the end, the RESULTFORM is evaluated and its value returned. During this last evaluation, the VAR is still bound, and its value is the number of times the iteration occurred. An omitted RESULTFORM defaults to nil." (byte-code "Æ!ƒÇÈÉ!\"‚-@9?ƒ ÇÊÉ@!\"‚-GËV…-ÇÌÉ!\"ˆ@Í!Î!Ï Ð DCÑÒ ÓÔ ÕEECÖ E D $E,‡" [stepform var countform resultform newsym body nlistp error "Stepform for `dotimes' should be (VAR COUNT [RESULT]), not `%s'" prin1-to-string "First component of stepform should be a symbol, not `%s'" 3 "Too many components in stepform `%s'" cadr caddr gentemp let* list* do* 0 + 1 >=] 19)) (defun reassemble-argslists (argslists) "\ (reassemble-argslists ARGSLISTS). ARGSLISTS is a list of sequences. Return a list of lists, the first sublist being all the entries coming from ELT 0 of the original sublists, the next those coming from ELT 1 and so on, until the shortest list is exhausted." (byte-code "ÅÆÇÈ \"\"ÉÊ Y?…'ÇË \" B‰ˆ Ì\\‰ˆ‚ˆÍ !))*‡" [minlen argslists result T$$_3 i apply min mapcar length nil 0 (lambda (sublist) (byte-code " \"‡" [sublist i elt] 3)) 1 nreverse] 6)) (defmacro psetq (&rest pairs) "(psetq {VARIABLE VALUE}...): In parallel, set each VARIABLE to its VALUE. All the VALUEs are evaluated, and then all the VARIABLEs are set. Aside from order of evaluation, this is the same as `setq'." (byte-code " GÎÎÎÎÎÎÏÐÑ\"Ò\"…ÓÔ!ˆ Î …[@‰ ˆ 9?…?ÓÕÖ !\"ˆ B‰ˆA@ B‰ˆAA‰ˆ‚%*ˆ ÎÎ  …“@‰ ˆ× ‰ ˆ  D B‰ˆ B‰ˆA‰ˆ‚f+ˆØ !‰ˆ    …Å @ @BB‰ˆ A‰ ˆ A‰ ˆ‚¡*ˆÙ ÚBÎF.‡" [nforms pairs symbols forms bindings newsyms assignments i ptr var form newsym ptr1 ptr2 nil /= % 2 0 error "Odd number of arguments to `psetq'" "`psetq' expected a symbol, found '%s'." prin1-to-string gensym nreverse let setq] 11)) (defun caar (X) "\ Return the car of the car of X." (byte-code "@@‡" [X] 1)) (defun cadr (X) "\ Return the car of the cdr of X." (byte-code "A@‡" [X] 1)) (defun cdar (X) "\ Return the cdr of the car of X." (byte-code "@A‡" [X] 1)) (defun cddr (X) "\ Return the cdr of the cdr of X." (byte-code "AA‡" [X] 1)) (defun caaar (X) "\ Return the car of the car of the car of X." (byte-code "@@@‡" [X] 1)) (defun caadr (X) "\ Return the car of the car of the cdr of X." (byte-code "A@@‡" [X] 1)) (defun cadar (X) "\ Return the car of the cdr of the car of X." (byte-code "@A@‡" [X] 1)) (defun cdaar (X) "\ Return the cdr of the car of the car of X." (byte-code "@@A‡" [X] 1)) (defun caddr (X) "\ Return the car of the cdr of the cdr of X." (byte-code "AA@‡" [X] 1)) (defun cdadr (X) "\ Return the cdr of the car of the cdr of X." (byte-code "A@A‡" [X] 1)) (defun cddar (X) "\ Return the cdr of the cdr of the car of X." (byte-code "@AA‡" [X] 1)) (defun cdddr (X) "\ Return the cdr of the cdr of the cdr of X." (byte-code "AAA‡" [X] 1)) (defun caaaar (X) "\ Return the car of the car of the car of the car of X." (byte-code "@@@@‡" [X] 1)) (defun caaadr (X) "\ Return the car of the car of the car of the cdr of X." (byte-code "A@@@‡" [X] 1)) (defun caadar (X) "\ Return the car of the car of the cdr of the car of X." (byte-code "@A@@‡" [X] 1)) (defun cadaar (X) "\ Return the car of the cdr of the car of the car of X." (byte-code "@@A@‡" [X] 1)) (defun cdaaar (X) "\ Return the cdr of the car of the car of the car of X." (byte-code "@@@A‡" [X] 1)) (defun caaddr (X) "\ Return the car of the car of the cdr of the cdr of X." (byte-code "AA@@‡" [X] 1)) (defun cadadr (X) "\ Return the car of the cdr of the car of the cdr of X." (byte-code "A@A@‡" [X] 1)) (defun cdaadr (X) "\ Return the cdr of the car of the car of the cdr of X." (byte-code "A@@A‡" [X] 1)) (defun caddar (X) "\ Return the car of the cdr of the cdr of the car of X." (byte-code "@AA@‡" [X] 1)) (defun cdadar (X) "\ Return the cdr of the car of the cdr of the car of X." (byte-code "@A@A‡" [X] 1)) (defun cddaar (X) "\ Return the cdr of the cdr of the car of the car of X." (byte-code "@@AA‡" [X] 1)) (defun cadddr (X) "\ Return the car of the cdr of the cdr of the cdr of X." (byte-code "AAA@‡" [X] 1)) (defun cddadr (X) "\ Return the cdr of the cdr of the car of the cdr of X." (byte-code "A@AA‡" [X] 1)) (defun cdaddr (X) "\ Return the cdr of the car of the cdr of the cdr of X." (byte-code "AA@A‡" [X] 1)) (defun cdddar (X) "\ Return the cdr of the cdr of the cdr of the car of X." (byte-code "@AAA‡" [X] 1)) (defun cddddr (X) "\ Return the cdr of the cdr of the cdr of the cdr of X." (byte-code "AAAA‡" [X] 1)) (defun setnth (n list newval) "\ Set (nth N LIST) to NEWVAL. Returns NEWVAL." (byte-code "ÃÄ \" \"‡" [n list newval rplaca nthcdr] 4)) (defun setnthcdr (n list newval) "\ SETNTHCDR N LIST NEWVAL => NEWVAL As a side effect, sets the Nth cdr of LIST to NEWVAL." (byte-code "ÄWƒ ÅÆ\"‚,ÄUƒ#Ç @\"ˆÈ A\"ˆ ‚,ÈÉÊZ \" \"‡" [n list newval t 0 error "N must be 0 or greater, not %d" rplaca rplacd nthcdr 1] 7))