;;Saved into a file called common_lisp.lisp <?


;; ussually CYC
(defvar *cl-importing-package* *package*)

;;(in-package "SUBLISP")
(defmacro prog1 (body1 &body body) (ret `(clet ((prog1res ,body1)) ,@body prog1res)))


(sl:defmacro defun (symbolp args sl:&body body)
             (ret `(progn
                     ;; (sl::export '(,symbolp))
                     (format t ";; ~A cl-defun \"~A\" ~S " ,(package-name  *package* )',symbolp ',args) (terpri)(force-output)

                     (sl::define ,symbolp ,args (ret (progn ,@body))))))

(sl:defmacro cl-defun (symbolp args sl:&body body)
             (ret `(progn
                     ;; (sl::export '(,symbolp))
                     (format t ";; ~A cl-defun \"~A\" ~S " ,(package-name  *package* )',symbolp ',args) (terpri)(force-output)
                     (sl::define ,symbolp ,args (ret (progn ,@body))))))

;;(sl::in-package "CL")
;;(sl::import '(defun defmacro) *cl-package*)
(defmacro cl-defmacro (symbolp args sl:&body body)
  (ret `(progn
          ;; (sl::export '(,symbolp))
          (format t ";; ~A defmacro-like-cl \"~A\" ~S " ,(package-name *package* )',symbolp ',args) (terpri)(force-output)
          ( sl::defmacro ,symbolp ,args (ret (progn ,@body))))))

;;(sl::export '(cl::defmacro-like-cl) *cl-package*)


(cl-defmacro memq (item my-list)
             `(member ,item ,my-list :test #'eq))

(defun cons-when (cond f)
    (if (and cond f) (cons cond f ) nil))


(defun ele (num obj)
  (cond
    ((vectorp obj)(aref obj num))
    ((listp obj)(nth num obj))
    ((iterator-p obj)(ele num (ITERATOR-VALUE-LIST  (COPY-ITERATOR obj))))
    ((SET-P obj)(ele num (SET-ELEMENT-LIST obj)))
    ((SET-CONTENTS-P obj)(ele num (SET-CONTENTS-ELEMENT-LIST obj)))
    ))

#|
;; (cl-rewrite-function 'set-dispatch-macro-character)

(cl-defmacro psetq (&rest pairs)
             ;; not use reverse for build order consistency
             (do* ((pairs pairs (cddr pairs))
                   (tmp (gensym) (gensym))
                   (inits (list nil))
                   (inits-splice inits)
                   (setqs (list nil))
                   (setqs-splice setqs))
                  ((null pairs) (when (cdr inits)
                                  `(let ,(cdr inits)
                                     (setq ,@(cdr setqs))
                                     nil)))
               (setq inits-splice
                     (cdr (rplacd inits-splice (list (list tmp (cadr pairs)))))
                   setqs-splice
                     (cddr (rplacd setqs-splice (list (car pairs) tmp))))))


(cl-defmacro return (&optional result)
             `(return-from nil ,result))

(defun equal (x y)
  (cond
   ((eql x y) t)
   ((consp x) (and (consp y) (equal (car x) (car y)) (equal (cdr x) (cdr y))))
   ((stringp x) (and (stringp y) (string= x y)))
   ((bit-vector-p x) (and (bit-vector-p y) (= (length x) (length y))
                          (dotimes (i (length x) t)
                            (unless (eql (aref x i) (aref y i))
                              (return nil)))))
   ((pathnamep x) (and (pathnamep y)
                       (equal (pathname-host x) (pathname-host y))
                       (equal (pathname-device x) (pathname-device y))
                       (equal (pathname-directory x) (pathname-directory y))
                       (equal (pathname-name x) (pathname-name y))
                       (equal (pathname-type x) (pathname-type y))
                       (equal (pathname-version x) (pathname-version y))))
   (t nil)))
|#
#|
(defun identity (object)
  object)

(defun complement (function)
  #'(lambda (&rest arguments) (not (apply function arguments))))

(defun constantly (object)
  #'(lambda (&rest arguments)
      (declare (ignore arguments))
      object))

(cl-defmacro and (&rest forms)
             (cond
              ((null forms) t)
              ((null (cdr forms)) (car forms))
              (t `(when ,(car forms)
                    (and ,@(cdr forms))))))

(cl-defmacro or (&rest forms)
             (cond
              ((null forms) nil)
              ((null (cdr forms)) (car forms))
              (t (let ((tmp (gensym)))
                   `(let ((,tmp ,(car forms)))
                      (if ,tmp
                          ,tmp
                        (or ,@(cdr forms))))))))

(cl-defmacro cond (&rest clauses)
             (when clauses
               (let ((test1 (caar clauses))
                     (forms1 (cdar clauses)))
                 (if forms1
                     `(if ,test1
                          (progn ,@forms1)
                        (cond ,@(cdr clauses)))
                   (let ((tmp (gensym)))
                     `(let ((,tmp ,test1))
                        (if ,tmp
                            ,tmp
                          (cond ,@(cdr clauses)))))))))

(cl-defmacro when (test-form &rest forms)
             `(if ,test-form
                  (progn ,@forms)
                nil))

(cl-defmacro unless (test-form &rest forms)
             `(if ,test-form
                  nil
                (progn ,@forms)))

;;(defmacro block-to-tagname (bname) (ret `(gensym ',bname)))
(defmacro block-to-tagname (bname) (print (ret `',bname)))

(cl-defmacro case (keyform &rest clauses)(expand-case keyform clauses))

(cl-defmacro ccase (keyplace &rest clauses)
             (let* ((clauses (mapcar #'(lambda (clause)
                                         (let ((key (first clause))
                                               (forms (rest clause)))
                                           `(,(%list key) ,@forms)))
                               clauses))
                    (expected-type `(member ,@(apply #'append (mapcar #'car clauses))))
                    (block-name (gensym))
                    (tag (gensym)))
               `(block ,block-name
                  (tagbody
                    ,tag
                    (return-from ,block-name
                      (case ,keyplace
                        ,@clauses
                        (t (restart-case (error 'type-error :datum ,keyplace
                                           :expected-type ',expected-type)
                             (store-value (value)
                                          :report (lambda (stream)
                                                    (store-value-report stream ',keyplace))
                                          :interactive store-value-interactive
                                          (setf ,keyplace value)
                                          (go ,tag))))))))))


(cl-defmacro ecase (keyform &rest clauses)
             (let* ((clauses (mapcar #'(lambda (clause)
                                         (let ((key (first clause))
                                               (forms (rest clause)))
                                           `(,(%list key) ,@forms)))
                               clauses))
                    (expected-type `(member ,@(apply #'append (mapcar #'car clauses)))))
               `(case ,keyform
                  ,@clauses
                  (t (error 'type-error :datum ,keyform :expected-type ',expected-type)))))

(cl-defmacro typecase (keyform &rest clauses)
             (let* ((last (car (last clauses)))
                    (clauses (mapcar #'(lambda (clause)
                                         (let ((type (first clause))
                                               (forms (rest clause)))
                                           (if (and (eq clause last)
                                                    (member type '(otherwise t)))
                                               clause
                                             `((,type) ,@forms))))
                               clauses)))
               (expand-case keyform clauses :test #'typep)))

(cl-defmacro ctypecase (keyplace &rest clauses)
             (let ((expected-type `(or ,@(mapcar #'car clauses)))
                   (block-name (gensym))
                   (tag (gensym)))
               `(block ,block-name
                  (tagbody
                    ,tag
                    (return-from ,block-name
                      (typecase ,keyplace
                        ,@clauses
                        (t (restart-case (error 'type-error
                                           :datum ,keyplace
                                           :expected-type ',expected-type)
                             (store-value (value)
                                          :report (lambda (stream)
                                                    (store-value-report stream ',keyplace))
                                          :interactive store-value-interactive
                                          (setf ,keyplace value)
                                          (go ,tag))))))))))



(cl-defmacro etypecase (keyform &rest clauses)
             `(typecase ,keyform
                ,@clauses
                (t (error 'type-error
                     :datum ',keyform :expected-type '(or ,@(mapcar #'car clauses))))))
|#
#|
(cl-defmacro multiple-value-bind (vars values-form &body body)
             (cond
              ((null vars)
               `(progn ,@body))
              ((null (cdr vars))
               `(let ((,(car vars) ,values-form))
                  ,@body))
              (t
               (let ((rest (gensym)))
                 `(multiple-value-call #'(lambda (&optional ,@vars &rest ,rest)
                                           (declare (ignore ,rest))
                                           ,@body)
                    ,values-form)))))



(cl-defmacro multiple-value-list (form)
             `(multiple-value-call #'list ,form))


(cl-defmacro multiple-value-setq (vars form)
             `(values (setf (values ,@vars) ,form)))
;;  (let ((temps (mapcar #'(lambda (x) (declare (ignore x)) (gensym)) vars)))
;;    `(multiple-value-bind ,temps ,form
;;       (setq ,@(mapcan #'(lambda (var temp) (list var temp)) vars temps))
;;       ,(car temps))))

(defun values-list (list)
  (check-type list proper-list)
  (apply #'values list))

(cl-defmacro nth-value (n form)
             `(nth ,n (multiple-value-list ,form)))

(define-setf-expander values (&rest places &environment env)
  (let (all-temps all-vars 1st-newvals rest-newvals all-setters all-getters)
    (dolist (place places)
      (multiple-value-bind (temps vars newvals setter getter)
          (get-setf-expansion place env)
        (setq all-temps    (cons temps all-temps)
            all-vars     (cons vars all-vars)
            1st-newvals  (cons (car newvals) 1st-newvals)
            rest-newvals (cons (cdr newvals) rest-newvals)
            all-setters  (cons setter all-setters)
            all-getters  (cons getter all-getters))))
    (values (apply #'append (reverse (append rest-newvals all-temps)))
            (append (apply #'append (reverse all-vars))
                    (make-list (reduce #'+ rest-newvals :key #'length)))
            (reverse 1st-newvals)
            `(values ,@(reverse all-setters))
            `(values ,@(reverse all-getters)))))
;;(define-setf-expander apply (function &rest args)
;;  (assert (and (listp function)
;;               (= (list-length function) 2)
;;               (eq (first function) 'function)
;;               (symbolp (second function))))
;;  (let ((function (cadr function))
;;        (newvals (list (gensym)))
;;        (temps (mapcar #'(lambda (arg) (gensym)) args)))
;;    (values temps
;;            args
;;            newvals
;;            `(apply #'(setf ,function) ,(car newvals) ,@vars)
;;            `(apply #',function ,@temps))))

(cl-defmacro prog (vars &body body)
             (flet ((declare-p (expr)
                               (and (consp expr) (eq (car expr) 'declare))))
               (do ((decls nil)
                    (forms body (cdr forms)))
                   ((not (declare-p (car forms))) `(block nil
                                                     (let ,vars
                                                       ,@(reverse decls)
                                                       (tagbody ,@forms))))
                 (push (car forms) decls))))

(cl-defmacro prog* (vars &body body)
             (multiple-value-bind (decls forms) (split-into-declarations-and-forms body)
               `(block nil
                  (let* ,vars
                    ,@(reverse decls)
                    (tagbody ,@forms)))))

(cl-defmacro prog1 (first-form &rest more-forms)
             (let ((result (gensym)))
               `(let ((,result ,first-form))
                  ,@more-forms
                  ,result)))

(cl-defmacro prog2 (first-form second-form &rest more-forms)
             `(prog1 (progn ,first-form ,second-form) ,@more-forms))


(cl-defmacro setf (&rest pairs &environment env)
             (let ((nargs (length pairs)))
               (assert (evenp nargs))
               (cond
                ((zerop nargs) nil)
                ((= nargs 2)
                 (let ((place (car pairs))
                       (value-form (cadr pairs)))
                   (cond
                    ((symbolp place)
                     `(setq ,place ,value-form))
                    ((consp place)
                     (if (eq (car place) 'the)
                         `(setf ,(caddr place) (the ,(cadr place) ,value-form))
                       (multiple-value-bind (temps vars newvals setter getter)
                           (get-setf-expansion place env)
                         (declare (ignore getter))
                         `(let (,@(mapcar #'list temps vars))
                            (multiple-value-bind ,newvals ,value-form
                              ,setter))))))))
                (t
                 (do* ((pairs pairs (cddr pairs))
                       (setfs (list 'progn))
                       (splice setfs))
                      ((endp pairs) setfs)
                   (setq splice (cdr (rplacd splice
                                             `((setf ,(car pairs) ,(cadr pairs)))))))))))

(cl-defmacro psetf (&rest pairs &environment env)
             (let ((nargs (length pairs)))
               (assert (evenp nargs))
               (if (< nargs 4)
                   `(progn (setf ,@pairs) nil)
                 (let ((setters nil))
                   (labels ((expand (pairs)
                                    (if pairs
                                        (multiple-value-bind (temps vars newvals setter getter)
                                            (get-setf-expansion (car pairs) env)
                                          (declare (ignore getter))
                                          (setq setters (cons setter setters))
                                          `(let (,@(mapcar #'list temps vars))
                                             (multiple-value-bind ,newvals ,(cadr pairs)
                                               ,(expand (cddr pairs)))))
                                      `(progn ,@setters nil))))
                     (expand pairs))))))

(cl-defmacro shiftf (&rest places-and-newvalue &environment env)
             (let ((nargs (length places-and-newvalue)))
               (assert (>= nargs 2))
               (let ((place (car places-and-newvalue)))
                 (multiple-value-bind (temps vars newvals setter getter)
                     (get-setf-expansion place env)
                   `(let (,@(mapcar #'list temps vars))
                      (multiple-value-prog1 ,getter
                        (multiple-value-bind ,newvals
                            ,(if (= nargs 2)
                                 (cadr places-and-newvalue)
                               `(shiftf ,@(cdr places-and-newvalue)))
                          ,setter)))))))

(cl-defmacro rotatef (&rest places &environment env)
             (if (< (length places) 2)
                 nil
               (multiple-value-bind (temps vars newvals setter getter)
                   (get-setf-expansion (car places) env)
                 `(let (,@(mapcar #'list temps vars))
                    (multiple-value-bind ,newvals (shiftf ,@(cdr places) ,getter)
                      ,setter)
                    nil))))
|#

(defvar *eval-mode* (list :load-toplevel :execute) )
(defmacro eval-when (when &body body) (ret `(if (intersection ',when *eval-mode*) (progn ,@body))))


;; transliterations
(defmacro let (&body body) (ret `( clet ,@body)))
(defmacro let* (&body body) (ret `( clet ,@body)))
(defmacro dotimes (&body body) (ret `(cdotimes ,@body)))
(defmacro case (&body body) (ret `( pcase ,@body)))
(defmacro if (&body body) (ret `(fif ,@body)))
(defmacro do (&body body) (ret `( cdo ,@body)))
(defmacro not (&body body) (ret `(cnot ,@body)))
(defmacro or (&body body) (ret `(cor ,@body)))
(defmacro cond (&body body) (ret `( pcond ,@body)))
(defmacro and (&body body) (ret `(cand ,@body)))
(defmacro unless (&body body) (ret `(funless ,@body)))
(defmacro when (&body body) (ret `(pwhen ,@body)))
(defmacro setq (&body body) (ret `( csetq ,@body)))
(defmacro setf (&body body) (ret `(csetf ,@body)))
(defmacro pushnew (item place) (ret `(progn (cpushnew ,item ,place) ,place)))
(defmacro push (&body body) (ret `(cpush ,@body)))
(defmacro pop (place)
  (ret `(let ((f1rst (elt ,place 0))) (CPOP) f1rst)))
(defmacro concatenate (cltype &body args) (ret `(coerce (cconcatenate ,@args) ,cltype)))

;;(defmacro until (test &body body)"Repeatedly evaluate BODY until TEST is true."(ret `(do ()(,test) ,@body)))
(defmacro make-array (size &key initial-element ) (ret `(make-vector ,size  ,initial-element)))

(defmacro svref (array idx) (ret `(aref ,array ,idx)))
;;(defmacro incf (arg1 &body body) (ret `(fif (null body) (cincf arg1) (progn (cincf ,@body) ,@body)))
(defmacro incf (&body body) (ret `(cinc ,@body)))
(defmacro decf (&body body) (ret `(cdec ,@body)))

(defmacro unwind-protect (protected-form &body body) (ret `(cunwind-protect ,protected-form ,@body)))
(defmacro destructuring-bind (args datum &body body) (ret `(cdestructuring-bind ,args ,datum  ,@body)))
(defmacro multiple-value-bind (args datum &body body) (ret `(cmultiple-value-bind  ,args ,datum  ,@body)))
(defmacro cmultiple-value-list (value &rest ignore) (ret `(multiple-value-list ,value)))

(defmacro debug-print (&body stuff)
  (print stuff)(terpri)(force-output)
  (pcond
   ;; ((cdr stuff) (ret `(print (cons 'progn ,stuff))))
   ;;  ((consp stuff) (ret `(print (cons 'prog1 ,stuff))))
   (t (ret `(print (eval ',@stuff))))))

;;(defmacro concat (&rest body) (ret `(progn (mapcar #'(lambda (x) (if (not (stringp x)) (debug-print (cons 'concat ',body)))) ,body)(apply #'cconcatenate (cons "" ,body)))))
(define concat (&rest list) (ret (apply #'cconcatenate (cons "" (mapcar #'(lambda (x) (ret (if (stringp x) x (coerce x 'string) ))) list)))))


(defmacro catch (tag &body body)
  (ret
   `(apply #'values
           (let ((*thrown* :UNTHROWN) (*result* :UNEVALED))
             ;;(print (list 'eval (cons 'catch (cons ',tag  ',body))))(terpri)
             (ccatch ,tag *thrown* (setq *result* (multiple-value-list (progn ,@body))))
             (cond
              ((equal *result* :UNEVALED) (list *thrown*))
              (t *result*))))))

(define map-sequences (function sequences)
  (ret (fif (member () sequences) () (cons (apply function (mapcar #'car sequences)) (map-sequences function (mapcar #'cdr sequences))))))

(define map (result-type function &body sequences)
  (ret (fif result-type (coerce (map-sequences function sequences) result-type) (progn (map-sequences function sequences) nil))))

(define cl-make-string (&rest rest)
  (ret (make-string (find 'numberp rest #'funcall)(find #'characterp rest 'funcall))))

;;(define coerce (value result-type) (ret value))
;;are hashtables supposed ot be coercable back and forth from alists?
(define coerce (value result-type)
  (clet ((len value)(vtype (type-of value))(cltype result-type))
        (pwhen (equal result-type vtype) (ret value))
        (unless (cand (consp cltype) (setq len (second cltype)) (setq cltype (car cltype)))
          (if (consp value) (setq len (length value))))
        ;;     (print (list 'coerce value result-type cltype len))
        (case cltype
          ('t (ret value))
          ('sequence
           (if (sequencep value) (ret (copy-seq value)) (setq value (write-to-string value)))
           (setq cltype (make-vector len))
           (do ((idx 0 (+ 1 idx))) ((= idx len) (ret  cltype )) (set-aref cltype idx (elt value idx))))
          ('character
           (cond
            ((characterp value) (ret value))
            ((numberp value) (ret (code-char value)))
            ((stringp value) (ret (char value 0)))
            (t (ret (char (coerce value 'string ) 0)))))
          ('number
           (cond
            ((numberp value) (ret value))
            ((characterp value) (ret (char-code value)))
            ((stringp value) (ret (string-to-number value)))
            ;; not like CL
            (t (ret (string-to-number (write-to-string value))))))
          ('integer
           (ret (round (coerce value 'number))))
          ('fixnum
           (ret (round (coerce value 'number))))
          ('float
           (ret (float (coerce value 'number))))
          ('real
           (ret (float (coerce value 'number))))
          ('flonum
           (ret (float (coerce value 'number))))
          ('string
           (cond
            ((stringp value) (ret value))
            ((characterp value) (ret (make-string 1 value)))
            ((sequencep value) (setq cltype (make-string len))
             (do ((idx 0 (+ 1 idx))) ((= idx len) (ret cltype )) (set-aref cltype idx (coerce (elt value idx) 'character))))
            (t (ret (write-to-string value)))))
          ('list
           (cond
            ((listp value) (ret list))
            ((sequencep value)
             (setq cltype nil)
             (do ((idx len (- idx 1))) ((= idx 0) (ret  cltype )) (setq cltype (cons (elt value idx) cltype))))
            (t
             (setq cltype nil)
             (setq value (write-to-string value))
             (do ((idx len (- idx 1))) ((= idx 0) (ret  cltype )) (setq cltype (cons (elt value idx) cltype))))))
          ('cons
           (cond
            ((listp value) (ret list))
            ((sequencep value)
             (setq cltype nil)
             (do ((idx len (- idx 1))) ((= idx 0) (ret  cltype )) (setq cltype (cons (elt value idx) cltype))))
            (t
             (setq cltype nil)
             (setq value (write-to-string value))
             (do ((idx len (- idx 1))) ((= idx 0) (ret  cltype )) (setq cltype (cons (elt value idx) cltype))))))
          ;; not finished
          ('keypair
           (cond
            ((atom value) (ret list value))
            (t (ret (coerce value 'cons)))))
          ;; not finished
          ('alist
           ;;(if (hash-table-p value) (ret value))
           (setq cltype (setq cltype nil))
           (if (sequencep value) t (setq value (coerce value 'sequence)))
           (do ((idx 0 (+ 1 idx))) ((= idx len) (ret cltype))
             (setq result-type (coerce (elt value idx) 'cons))
             (setq cltype (acons (car result-type) (cdr result-type) cltype)))
           (ret cltype))
          ;; not finished
          ('hash-table
           (if (hash-table-p value) (ret value))
           (setq cltype (make-hash-table len))
           (if (sequencep value) t (setq value (coerce value 'sequence)))
           (do ((idx 0 (+ 1 idx))) ((= idx len) (ret cltype))
             (print (list 'coerce value result-type cltype len (elt value idx)))
             (setq result-type (coerce (elt value idx) 'keypair))
             (sethash (car result-type) cltype (cdr result-type))))
          ;; not like CL
          (otherwise (ret value)))
        (throw :coerce (list value result-type)))
  (ret value))





;;;;(load "sublisp-cl.lisp")
#|

(define FIND-ALL-SYMBOLS (stringp &optional (packagelist (list-all-packages)) (status '(:inherited :external :internal)))
  (ret (if packagelist
           (clet ((package (car packagelist))(res (multiple-values-list (find-symbol stringp package))))
                 (if
                     (member (cdr res) status)
                     (cons (car res) (FIND-ALL-SYMBOLS stringp (cdr packagelist) status ))
                   (FIND-ALL-SYMBOLS stringp (cdr packagelist) status ))))))

(defun eval-remote (server &rest remote)  (print remote))

;;
;;  (load "common_lisp.lisp")(macroexpand '(defstub :COMMON-LISP DEFPACKAGE))
(define defstub (pack symb &rest body)
  ;;  (clet ((symb `,symbn))
  (let ((sname (if (symbolp symb) (symbol-name symb) (if (stringp symb) symb "")))
        (fpack (if (packagep pack) pack (find-package pack)))
        (fsym  (if fpack (find-symbol sname fpack) (find-symbol sname))))
    (when (and(symbolp symb)(fboundp symb)) (ret `(symbol-function ',symb)))
    (when (and(symbolp fsym)(fboundp fsym)) (ret `(symbol-function ',fsym)))
    (when (and(symbolp fsym)(fboundp fsym)(member fpack *packages-local*)) (ret `(symbol-function ',fsym)))
    (unless (symbolp fsym)(setq fsym symb))
    (unless (symbolp fsym)(setq fsym (intern sname)))
    (unless fpack (setq fpack (symbol-package fsym)))
    (setq sname (concat (package-name fpack) "::" sname))
    (ret
     (print `(eval
              ',(print (if body
                           ;;(list 'defmacro fsym (list 'quote (car body))(list 'ret (list 'BQ-LIST* (cons '(quote eval-remote) (cons (list 'quote sname) (cdr body))))))
                           `(defmacro ,fsym ,(car body) (ret `(eval-remote ,,sname ,,@(cdr body))))

                         (list 'defmacro fsym '(&rest args)(list 'ret (list 'BQ-LIST* '(quote eval-remote) (list 'quote sname) 'args))))))))))


;;(define do-server4005 (in-stream out-stream)(print (read in-stream) out-stream))

(defstub :common-lisp 'defpackage)


;; We will show that only one of the three non-local exit mechanisms block/return-from, tagbody/go, catch/throw is required to be primitive, by showing how to emulate any two in terms of the third.[4] We first emulate block/return-from in terms of catch/throw. We map the block name into the name of a lexical variable which will hold the unique tag which distinguishes this dynamical block from any other. If trivial return-from's are optimized away, then this emulation can be quite efficient.
(cl-defmacro return-from-no (bname exp)
             "BLOCK/RETURN-FROM EMULATED BY CATCH/THROW"
             (let ((tagname (block-to-tagname bname)))
               `(throw ,tagname ,exp)))

(cl-defmacro block-no (bname &body forms)
             "BLOCK/RETURN-FROM EMULATED BY CATCH/THROW"
             (let ((tagname (block-to-tagname bname)))
               `(let ((,tagname (list nil))) ; Unique cons cell used as catch tag.
                  (catch ,tagname (progn ,@forms)))))

;; dont know if this is correct

(defmacro return (body) (ret `(ret ,body)))




(defconstant *unbound-value* (list nil))

(defun msymbol-value (var)
  (if (boundp var) (symbol-value var) *unbound-value*))

(defun mset (var val)
  (if (eq val *unbound-value*) (makunbound var) (set var val)))

(defmacro progv (syms vals &body forms)
  (let* ((vsyms (gensym)) (vvals (gensym)) (vovals (gensym)))
    `(let* ((,vsyms ,syms)
            (,vvals ,vals)
            (,vovals ,(mapcar #'msymbol-value ,vsyms)))
       (unwind-protect
           (progn (mapc #'mset ,vsyms ,vvals)
             (mapc #'makunbound (subseq ,vsyms (min (length ,vsyms) (length ,vvals))))
             ,@forms )
         (mapc #'mset ,vsyms ,vovals)))))

;;EMULATE "THE" USING "LET" AND "DECLARE"
;;The emulation of the the special form emphasizes the fact that there is a run-time type test which must be passed in order for the program to proceed. Of course, a clever compiler can eliminate the run-time test if it can prove that it will always succeed--e.g., the gcd function always returns an integer if it returns at all.

(defmacro the (typ exp)
  (if (and (consp typ) (eq (car typ) 'values))
      (let ((vals (gensym)))
        `(let ((,vals (multiple-value-list ,exp)))
           (assert (= (length ,vals) ,(length (cdr typ))))
           ,@(mapcar #'(lambda (typ i) `(assert (typep (elt ,vals ,i) ',typ)))
               (cdr typ) (iota-list (length (cdr typ))))
           (values-list ,vals)))
    (let ((val (gensym)))
      `(let ((,val ,exp))
         (assert (typep ,val ',typ))
         (let ((,val ,val)) (declare (type ,typ ,val))
           ,val)))))



(cl-defmacro go (label)
             "TAGBODY/GO EMULATED BY CATCH/THROW"
             (let ((name (label-to-functionname label)))
               `(throw ,name #',name)))

(cl-defmacro tagbody-no (&body body)
             "TAGBODY/GO EMULATED BY CATCH/THROW"
             (let* ((init-tag (gensym)) (go-tag (gensym)) (return-tag (gensym))

                    (functions
                     (mapcon
                         #'(lambda (seq &aux (label (car seq) (s (cdr seq)))
                                        (when (atom label)
                                          (let ((p (position-if #'atom s)))
                                            `((,(label-to-functionname label) ()
                                                 ,@(subseq s 0 (or p (length s)))
                                                 ,(if p `(,(label-to-functionname (elt s p)))
                                                    `(throw ,return-tag 'nil)))))))
                             `(,init-tag ,@body))))
                    `(let* ((,go-tag (list nil)) (,return-tag (list nil))
                                                 ,@(mapcar #'(lambda (f) `(,(car f) ,go-tag)) functions))
                       (catch ,return-tag
                              (labels ,functions
                                (let ((nxt-label #',(caar functions)))
                                  (loop (setq nxt-label (catch ,go-tag (funcall nxt-label)))))))))))

(print "The emulation of tagbody/go by catch/throw is considerably less obvious than the emulation of block/return-from.
This is because tagbody defines a number of different labels rather than a single block name, and because the parsing of the
tagbody body is considerably more complicated. The various segments of the tagbody are emulated by a labels nest of mutually
recursive functions, which are forced to all execute at the correct dynamic depth by means of a
'trampoline. If the implementation implements the 'tail recursion' optimization for functions
which have no arguments and return no values, and if the simpler cases of go's are optimized away, then this emulation can be quite efficient."
       )


(cl-defmacro labels (fns &body forms)
             "CIRCULAR ENVIRONMENTS OF 'LABELS EMULATED BY 'FLET AND 'SETQ: It is generally believed that the circular environments of labels cannot be
    obtained by means of flet. This is incorrect, as the following emulation (reminiscent of Scheme) shows.
    With a more sophisticated macro-expansion, this emulation can be optimized into production-quality code."
             (let* ((fnames (mapcar #'car fns))
                    (nfnames (mapcar #'(lambda (ignore) (gensym)) fnames))
                    (nfbodies (mapcar #'(lambda (f) `#'(lambda ,@(cdr f))) fns)))
               `(let ,(mapcar #'(lambda (nf) `(,nf #'(lambda () ()))) nfnames)
                  (flet ,(mapcar #'(lambda (f nf) `(,f (&rest a) (apply ,nf a)))
                           fnames nfnames)
                    (flet ,fns
                      (progn ,@(mapcar #'(lambda (f nf) `(setq ,nf #',f))
                                 fnames nfnames))
                      ,@forms)))))

;;(* + - / /= < <= = > > >= ABS ACONS ACOS ADJOIN ALPHA-CHAR-P ALPHANUMERICP APPEND AREF ASH ASIN ASSOC ASSOC-IF ATAN ATOM
;; BOOLE BOOLEAN BOTH-CASE-P BQ-CONS BQ-VECTOR BUTLAST BYTE CAAR CADR CAR CCONCATENATE CDAR CDDR CDR CEILING CERROR CHAR CHAR-CODE CHAR-DOWNCASE CHAR-EQUAL CHAR-GREATERP CHAR-LESSP CHAR-NOT-EQUAL CHAR-NOT-GREATERP CHAR-NOT-LESSP CHAR-UPCASE CHAR/= CHAR< CHAR<= CHAR= CHAR> CHAR>= CHARACTERP CLRHASH
;; CMERGE CODE-CHAR CONS CONSP CONSTANTP CONSTRUCT-FILENAME COPY-ALIST COPY-LIST COPY-SEQ COPY-TREE COS COUNT COUNT-IF CREDUCE CURRENT-PROCESS DATE-RELATIVE-GUID-P DECODE-FLOAT DECODE-UNIVERSAL-TIME DELETE DELETE-DUPLICATES DELETE-IF DIGIT-CHAR DIGIT-CHAR-P DISASSEMBLE-INTEGER-TO-FIXNUMS DPB EIGHTH ELT ENCODE-UNIVERSAL-TIME ENDP EQ EQL EQUAL EQUALP EVENP EXIT EXP EXPT FALSE FIFTH FILL FIND FIND-IF FIND-PACKAGE FIND-SYMBOL FIRST FIXNUMP FLOAT FLOAT-DIGITS FLOAT-RADIX FLOAT-SIGN FLOATP FLOOR FORCE-OUTPUT FORMAT FOURTH FRESH-LINE FUNCTION-SPEC-P FUNCTIONP GC GC-DYNAMIC GC-EPHEMERAL GC-FULL GENSYM GENTEMP GET GET-DECODED-TIME GET-INTERNAL-REAL-TIME GET-INTERNAL-REAL-TIME GET-INTERNAL-RUN-TIME GET-UNIVERSAL-TIME GET-UNIVERSAL-TIME GETF GETHASH GETHASH-WITHOUT-VALUES GUID-P GUID-STRING-P GUID-TO-STRING GUID/= GUID< GUID<= GUID= GUID> GUID>= HASH-TABLE-COUNT HASH-TABLE-P HASH-TABLE-SIZE HASH-TABLE-TEST IDENTITY IGNORE INFINITY-P INT/ INTEGER-DECODE-FLOAT INTEGER-LENGTH INTEGERP INTERN INTERRUPT-PROCESS INTERSECTION ISQRT KEYWORDP KILL-PROCESS LAST LDB LDIFF LENGTH LISP-IMPLEMENTATION-TYPE LISP-IMPLEMENTATION-VERSION LIST LIST* LIST-ALL-PACKAGES LIST-LENGTH LISTP LISTP LOCK-IDLE-P LOCK-P LOG LOGAND LOGANDC1 LOGANDC2 LOGBITP LOGCOUNT LOGEQV LOGIOR LOGNAND LOGNOR LOGNOT LOGORC1 LOGORC2 LOGTEST LOGXOR LOWER-CASE-P MAKE-HASH-TABLE MAKE-LOCK MAKE-LOCK MAKE-STRING MAKUNBOUND MAX MEMBER MEMBER-IF MIN MINUSP MISMATCH MOD NBUTLAST NCONC NEW-GUID NINTERSECTION NINTH NOT-A-NUMBER-P NOTE-PERCENT-PROGRESS NOTIFY NRECONC NREVERSE NSET-DIFFERENCE NSET-EXCLUSIVE-OR NSTRING-CAPITALIZE NSTRING-DOWNCASE NSTRING-UPCASE NSUBLIS NSUBST NSUBST-IF NSUBSTITUTE NSUBSTITUTE-IF NTH NTHCDR NULL NUMBERP NUMBERP NUNION ODDP PAIRLIS PEEK-CHAR PLUSP POSITION POSITION-IF PRIN1 PRIN1-TO-STRING PRINC PRINC-TO-STRING PRINT PROCESS-ACTIVE-P PROCESS-BLOCK PROCESS-NAME PROCESS-STATE PROCESS-UNBLOCK PROCESS-WAIT PROCESS-WAIT-WITH-TIMEOUT PROCESS-WHOSTATE PROCESSP RANDOM RASSOC RASSOC-IF READ-FROM-STRING READ-FROM-STRING-IGNORING-ERRORS REM REMF REMHASH REMOVE REMOVE-DUPLICATES REMOVE-IF REPLACE REST REVAPPEND REVERSE REVERSE ROOM ROUND RPLACA RPLACD SCALE-FLOAT SEARCH SECOND SEED-RANDOM SEQUENCEP SET-AREF SET-CONSING-STATE SET-DIFFERENCE SET-NTH SEVENTH SHOW-PROCESSES SIN SIXTH QUIT SLEEP SORT SQRT STABLE-SORT STRING STRING-CAPITALIZE STRING-DOWNCASE STRING-EQUAL STRING-GREATERP STRING-LEFT-TRIM STRING-LESSP STRING-NOT-EQUAL STRING-NOT-GREATERP STRING-NOT-LESSP STRING-RIGHT-TRIM STRING-TO-GUID STRING-TRIM STRING-UPCASE STRING/= STRING< STRING<= STRING= STRING> STRING>= STRINGP SUBLIS SUBLISP::PROPERTY-LIST-MEMBER SUBSEQ SUBSETP SUBST SUBST-IF SUBSTITUTE SUBSTITUTE-IF SXHASH SYMBOL-FUNCTION SYMBOL-NAME SYMBOLP SYMBOLP TAILP TAN TENTH TERPRI THIRD TREE-EQUAL TRUE TRUNCATE TYPE-OF UNINTERN UNION UPPER-CASE-P VALID-PROCESS-P VALUES VECTOR VECTORP WARN WRITE-IMAGE Y-OR-N-P YES-OR-NO-P ZEROP)



(DEFMACRO HANDLER-CASE-CAD (FORM &REST CASES)
  (ret (LET ((NO-ERROR-CLAUSE (ASSOC ':NO-ERROR CASES)))
         (IF NO-ERROR-CLAUSE
             (LET ((NORMAL-RETURN (MAKE-SYMBOL "NORMAL-RETURN"))
                   (ERROR-RETURN  (MAKE-SYMBOL "ERROR-RETURN")))
               `(BLOCK ,ERROR-RETURN
                  (MULTIPLE-VALUE-CALL #'(LAMBDA ,@(CDR NO-ERROR-CLAUSE))
                    (BLOCK ,NORMAL-RETURN
                      (RETURN-FROM ,ERROR-RETURN
                        (HANDLER-CASE (RETURN-FROM ,NORMAL-RETURN ,FORM)
                          ,@(REMOVE NO-ERROR-CLAUSE CASES)))))))
           (LET ((TAG (GENSYM))
                 (VAR (GENSYM))
                 (ANNOTATED-CASES (MAPCAR #'(LAMBDA (CASE) (CONS (GENSYM) CASE))
                                    CASES)))
             `(BLOCK ,TAG
                (LET ((,VAR NIL))
                  ,VAR              ;ignorable
                  (TAGBODY
                    (HANDLER-BIND ,(MAPCAR #'(LAMBDA (ANNOTATED-CASE)
                                               (LIST (CADR ANNOTATED-CASE)
                                                     `#'(LAMBDA (TEMP)
                                                          ,@(IF (CADDR ANNOTATED-CASE)
                                                                `((SETQ ,VAR TEMP)))
                                                          (GO ,(CAR ANNOTATED-CASE)))))
                                     ANNOTATED-CASES)
                      (RETURN-FROM ,TAG ,FORM))
                    ,@(MAPCAN #'(LAMBDA (ANNOTATED-CASE)
                                  (LIST (CAR ANNOTATED-CASE)
                                        (LET ((BODY (CDDDR ANNOTATED-CASE)))
                                          `(RETURN-FROM ,TAG
                                             ,(COND ((CADDR ANNOTATED-CASE)
                                                     `(LET ((,(CAADDR ANNOTATED-CASE)
                                                               ,VAR))
                                                        ,@BODY))
                                                    ((NOT (CDR BODY))
                                                     (CAR BODY))
                                                    (T
                                                     `(PROGN ,@BODY)))))))
                        ANNOTATED-CASES)))))))))
|#



(define clisp-symbol (pack name &rest ignore))

(clisp-symbol :COMMON-LISP "&ALLOW-OTHER-KEYS" "NIL") ;;&ALLOW-OTHER-KEYS;;
(clisp-symbol :COMMON-LISP "&AUX" "NIL") ;;&AUX;;
(clisp-symbol :COMMON-LISP "&BODY" "NIL") ;;&BODY;;
(clisp-symbol :COMMON-LISP "&ENVIRONMENT" "NIL") ;;&ENVIRONMENT;;
(clisp-symbol :COMMON-LISP "&KEY" "NIL") ;;&KEY;;
(clisp-symbol :COMMON-LISP "&OPTIONAL" "NIL") ;;&OPTIONAL;;
(clisp-symbol :COMMON-LISP "&REST" "NIL") ;;&REST;;
(clisp-symbol :COMMON-LISP "&WHOLE" "NIL") ;;&WHOLE;;
(clisp-symbol :COMMON-LISP "(SETF COMMON-LISP:COMPILER-MACRO-FUNCTION)" "(SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/cmacros.fas\" 51 55)))") ;;COMMON-LISP::|(SETF COMMON-LISP:COMPILER-MACRO-FUNCTION)|;;
(clisp-symbol :COMMON-LISP "(SETF COMMON-LISP:RESTART-NAME)" "(SYSTEM::INLINE-EXPANSION ((SYSTEM::VALUE SYSTEM::OBJECT) (DECLARE (SYSTEM::IN-DEFUN (SETF RESTART-NAME))) (BLOCK RESTART-NAME (SYSTEM::%STRUCTURE-STORE 'RESTART SYSTEM::OBJECT 1 SYSTEM::VALUE))) SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/condition.fas\" 714 729)) SYSTEM::INLINABLE INLINE)") ;;COMMON-LISP::|(SETF COMMON-LISP:RESTART-NAME)|;;
(clisp-symbol :COMMON-LISP "(SETF COMMON-LISP:STREAM-ELEMENT-TYPE)" "NIL") ;;COMMON-LISP::|(SETF COMMON-LISP:STREAM-ELEMENT-TYPE)|;;
(clisp-symbol :COMMON-LISP "*" "NIL") ;;*;;
(clisp-symbol :COMMON-LISP "**" "NIL") ;;**;;
(clisp-symbol :COMMON-LISP "***" "NIL") ;;***;;
(clisp-symbol :COMMON-LISP "*BREAK-ON-SIGNALS*" "NIL") ;;*BREAK-ON-SIGNALS*;;
(clisp-symbol :COMMON-LISP "*COMPILE-FILE-PATHNAME*" "NIL") ;;*COMPILE-FILE-PATHNAME*;;
(clisp-symbol :COMMON-LISP "*COMPILE-FILE-TRUENAME*" "NIL") ;;*COMPILE-FILE-TRUENAME*;;
(clisp-symbol :COMMON-LISP "*COMPILE-PRINT*" "NIL") ;;*COMPILE-PRINT*;;
(clisp-symbol :COMMON-LISP "*COMPILE-VERBOSE*" "NIL") ;;*COMPILE-VERBOSE*;;
(clisp-symbol :COMMON-LISP "*DEBUG-IO*" "NIL") ;;*DEBUG-IO*;;
(clisp-symbol :COMMON-LISP "*DEBUGGER-HOOK*" "NIL") ;;*DEBUGGER-HOOK*;;
(clisp-symbol :COMMON-LISP "*DEFAULT-PATHNAME-DEFAULTS*" "NIL") ;;*DEFAULT-PATHNAME-DEFAULTS*;;
(clisp-symbol :COMMON-LISP "*ERROR-OUTPUT*" "NIL") ;;*ERROR-OUTPUT*;;
(clisp-symbol :COMMON-LISP "*FEATURES*" "NIL") ;;*FEATURES*;;
(clisp-symbol :COMMON-LISP "*GENSYM-COUNTER*" "NIL") ;;*GENSYM-COUNTER*;;
(clisp-symbol :COMMON-LISP "*LOAD-PATHNAME*" "NIL") ;;*LOAD-PATHNAME*;;
(clisp-symbol :COMMON-LISP "*LOAD-PRINT*" "NIL") ;;*LOAD-PRINT*;;
(clisp-symbol :COMMON-LISP "*LOAD-TRUENAME*" "NIL") ;;*LOAD-TRUENAME*;;
(clisp-symbol :COMMON-LISP "*LOAD-VERBOSE*" "NIL") ;;*LOAD-VERBOSE*;;
(clisp-symbol :COMMON-LISP "*MACROEXPAND-HOOK*" "NIL") ;;*MACROEXPAND-HOOK*;;
(clisp-symbol :COMMON-LISP "*MODULES*" "NIL") ;;*MODULES*;;
(clisp-symbol :COMMON-LISP "*PACKAGE*" "NIL") ;;*PACKAGE*;;
(clisp-symbol :COMMON-LISP "*PRINT-ARRAY*" "NIL") ;;*PRINT-ARRAY*;;
(clisp-symbol :COMMON-LISP "*PRINT-BASE*" "NIL") ;;*PRINT-BASE*;;
(clisp-symbol :COMMON-LISP "*PRINT-CASE*" "NIL") ;;*PRINT-CASE*;;
(clisp-symbol :COMMON-LISP "*PRINT-CIRCLE*" "NIL") ;;*PRINT-CIRCLE*;;
(clisp-symbol :COMMON-LISP "*PRINT-ESCAPE*" "NIL") ;;*PRINT-ESCAPE*;;
(clisp-symbol :COMMON-LISP "*PRINT-GENSYM*" "NIL") ;;*PRINT-GENSYM*;;
(clisp-symbol :COMMON-LISP "*PRINT-LENGTH*" "NIL") ;;*PRINT-LENGTH*;;
(clisp-symbol :COMMON-LISP "*PRINT-LEVEL*" "NIL") ;;*PRINT-LEVEL*;;
(clisp-symbol :COMMON-LISP "*PRINT-LINES*" "NIL") ;;*PRINT-LINES*;;
(clisp-symbol :COMMON-LISP "*PRINT-MISER-WIDTH*" "NIL") ;;*PRINT-MISER-WIDTH*;;
(clisp-symbol :COMMON-LISP "*PRINT-PPRINT-DISPATCH*" "NIL") ;;*PRINT-PPRINT-DISPATCH*;;
(clisp-symbol :COMMON-LISP "*PRINT-PRETTY*" "NIL") ;;*PRINT-PRETTY*;;
(clisp-symbol :COMMON-LISP "*PRINT-RADIX*" "NIL") ;;*PRINT-RADIX*;;
(clisp-symbol :COMMON-LISP "*PRINT-READABLY*" "NIL") ;;*PRINT-READABLY*;;
(clisp-symbol :COMMON-LISP "*PRINT-RIGHT-MARGIN*" "NIL") ;;*PRINT-RIGHT-MARGIN*;;
(clisp-symbol :COMMON-LISP "*QUERY-IO*" "NIL") ;;*QUERY-IO*;;
(clisp-symbol :COMMON-LISP "*RANDOM-STATE*" "NIL") ;;*RANDOM-STATE*;;
(clisp-symbol :COMMON-LISP "*READ-BASE*" "NIL") ;;*READ-BASE*;;
(clisp-symbol :COMMON-LISP "*READ-DEFAULT-FLOAT-FORMAT*" "NIL") ;;*READ-DEFAULT-FLOAT-FORMAT*;;
(clisp-symbol :COMMON-LISP "*READ-EVAL*" "NIL") ;;*READ-EVAL*;;
(clisp-symbol :COMMON-LISP "*READ-SUPPRESS*" "NIL") ;;*READ-SUPPRESS*;;
(clisp-symbol :COMMON-LISP "*READTABLE*" "NIL") ;;*READTABLE*;;
(clisp-symbol :COMMON-LISP "*STANDARD-INPUT*" "NIL") ;;*STANDARD-INPUT*;;
(clisp-symbol :COMMON-LISP "*STANDARD-OUTPUT*" "NIL") ;;*STANDARD-OUTPUT*;;
(clisp-symbol :COMMON-LISP "*TERMINAL-IO*" "NIL") ;;*TERMINAL-IO*;;
(clisp-symbol :COMMON-LISP "*TRACE-OUTPUT*" "NIL") ;;*TRACE-OUTPUT*;;
(clisp-symbol :COMMON-LISP "+" "(CLOS::%METHOD-COMBINATION #<METHOD-COMBINATION + #x209F48E6>)") ;;+;;
(clisp-symbol :COMMON-LISP "++" "NIL") ;;++;;
(clisp-symbol :COMMON-LISP "+++" "NIL") ;;+++;;
(clisp-symbol :COMMON-LISP "-" "NIL") ;;-;;
(clisp-symbol :COMMON-LISP "/" "NIL") ;;/;;
(clisp-symbol :COMMON-LISP "//" "NIL") ;;//;;
(clisp-symbol :COMMON-LISP "///" "NIL") ;;///;;
(clisp-symbol :COMMON-LISP "/=" "NIL") ;;/=;;
(clisp-symbol :COMMON-LISP "1+" "NIL") ;;1+;;
(clisp-symbol :COMMON-LISP "1-" "NIL") ;;1-;;
(clisp-symbol :COMMON-LISP "<" "NIL") ;;<;;
(clisp-symbol :COMMON-LISP "<=" "NIL") ;;<=;;
(clisp-symbol :COMMON-LISP "=" "NIL") ;;=;;
(clisp-symbol :COMMON-LISP ">" "NIL") ;;>;;
(clisp-symbol :COMMON-LISP ">=" "NIL") ;;>=;;
(clisp-symbol :COMMON-LISP "ABORT" "(SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/condition.fas\" 1145 1152)))") ;;ABORT;;
(clisp-symbol :COMMON-LISP "ABS" "NIL") ;;ABS;;
(clisp-symbol :COMMON-LISP "ACONS" "NIL") ;;ACONS;;
(clisp-symbol :COMMON-LISP "ACOS" "NIL") ;;ACOS;;
(clisp-symbol :COMMON-LISP "ACOSH" "NIL") ;;ACOSH;;
(clisp-symbol :COMMON-LISP "ADJOIN" "NIL") ;;ADJOIN;;
(clisp-symbol :COMMON-LISP "ADJUST-ARRAY" "NIL") ;;ADJUST-ARRAY;;
(clisp-symbol :COMMON-LISP "ADJUSTABLE-ARRAY-P" "NIL") ;;ADJUSTABLE-ARRAY-P;;
(clisp-symbol :COMMON-LISP "ALPHA-CHAR-P" "NIL") ;;ALPHA-CHAR-P;;
(clisp-symbol :COMMON-LISP "ALPHANUMERICP" "NIL") ;;ALPHANUMERICP;;
(clisp-symbol :COMMON-LISP "AND" "(CLOS::%METHOD-COMBINATION #<METHOD-COMBINATION AND #x209F4956> SYSTEM::MACRO #<COMPILED-FUNCTION AND>)") ;;AND;;
(clisp-symbol :COMMON-LISP "APPEND" "(CLOS::%METHOD-COMBINATION #<METHOD-COMBINATION APPEND #x209F49C6>)") ;;APPEND;;
(clisp-symbol :COMMON-LISP "APPLY" "(SYSTEM::INSTRUCTION 55 SYSTEM::SETF-EXPANDER (-5 . #<COMPILED-FUNCTION #:SETF-APPLY>) SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/places.fas\" 1062 1124)))") ;;APPLY;;
(clisp-symbol :COMMON-LISP "APROPOS" "(SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/describe.fas\" 45 73)))") ;;APROPOS;;
(clisp-symbol :COMMON-LISP "APROPOS-1" "NIL") ;;COMMON-LISP::APROPOS-1;;
(clisp-symbol :COMMON-LISP "APROPOS-2" "NIL") ;;COMMON-LISP::APROPOS-2;;
(clisp-symbol :COMMON-LISP "APROPOS-3" "NIL") ;;COMMON-LISP::APROPOS-3;;
(clisp-symbol :COMMON-LISP "APROPOS-4" "NIL") ;;COMMON-LISP::APROPOS-4;;
(clisp-symbol :COMMON-LISP "APROPOS-5" "NIL") ;;COMMON-LISP::APROPOS-5;;
(clisp-symbol :COMMON-LISP "APROPOS-LIST" "(SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/describe.fas\" 19 35)))") ;;APROPOS-LIST;;
(clisp-symbol :COMMON-LISP "APROPOS-LIST-1" "NIL") ;;COMMON-LISP::APROPOS-LIST-1;;
(clisp-symbol :COMMON-LISP "APROPOS-LIST-2" "NIL") ;;COMMON-LISP::APROPOS-LIST-2;;
(clisp-symbol :COMMON-LISP "AREF" "(SYSTEM::SETF-EXPANDER (-1 1 . #<COMPILED-FUNCTION SYSTEM::SETF-AREF>) SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/places.fas\" 521 523)))") ;;AREF;;
(clisp-symbol :COMMON-LISP "ARITHMETIC-ERROR" "(CLOS::CLOSCLASS #1=#<STANDARD-CLASS ARITHMETIC-ERROR> SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/condition.fas\" 342 345)))") ;;ARITHMETIC-ERROR;;
(clisp-symbol :COMMON-LISP "ARITHMETIC-ERROR-OPERANDS" "NIL") ;;ARITHMETIC-ERROR-OPERANDS;;
(clisp-symbol :COMMON-LISP "ARITHMETIC-ERROR-OPERATION" "NIL") ;;ARITHMETIC-ERROR-OPERATION;;
(clisp-symbol :COMMON-LISP "ARRAY" "(CLOS::CLOSCLASS #1=#<BUILT-IN-CLASS ARRAY> SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/clos-class3.fas\" 2584 2634)) SYSTEM::SUBTYPEP-DECIDE SYSTEM::SUBTYPEP-ARRAY SYSTEM::SUBTYPEP-SIMPLIFY-OR SYSTEM::SIMPLIFY-OR-ARRAY SYSTEM::SUBTYPEP-SIMPLIFY-AND SYSTEM::SIMPLIFY-AND-ARRAY SYSTEM::SUBTYPEP-LIST (ARRAY SIMPLE-ARRAY) SYSTEM::SUBTYPEP-ATOM (ARRAY SIMPLE-ARRAY) SYSTEM::TYPE-LIST #<COMPILED-FUNCTION SYSTEM::TYPE-LIST-ARRAY> SYSTEM::TYPE-SYMBOL #<SYSTEM-FUNCTION ARRAYP>)") ;;ARRAY;;
(clisp-symbol :COMMON-LISP "ARRAY-DIMENSION" "NIL") ;;ARRAY-DIMENSION;;
(clisp-symbol :COMMON-LISP "ARRAY-DIMENSION-LIMIT" "(SYSTEM::CONSTANT-INLINABLE CONSTANT-NOTINLINE)") ;;ARRAY-DIMENSION-LIMIT;;
(clisp-symbol :COMMON-LISP "ARRAY-DIMENSIONS" "NIL") ;;ARRAY-DIMENSIONS;;
(clisp-symbol :COMMON-LISP "ARRAY-DISPLACEMENT" "NIL") ;;ARRAY-DISPLACEMENT;;
(clisp-symbol :COMMON-LISP "ARRAY-ELEMENT-TYPE" "NIL") ;;ARRAY-ELEMENT-TYPE;;
(clisp-symbol :COMMON-LISP "ARRAY-HAS-FILL-POINTER-P" "NIL") ;;ARRAY-HAS-FILL-POINTER-P;;
(clisp-symbol :COMMON-LISP "ARRAY-IN-BOUNDS-P" "NIL") ;;ARRAY-IN-BOUNDS-P;;
(clisp-symbol :COMMON-LISP "ARRAY-RANK" "NIL") ;;ARRAY-RANK;;
(clisp-symbol :COMMON-LISP "ARRAY-RANK-LIMIT" "(SYSTEM::CONSTANT-INLINABLE CONSTANT-NOTINLINE)") ;;ARRAY-RANK-LIMIT;;
(clisp-symbol :COMMON-LISP "ARRAY-ROW-MAJOR-INDEX" "NIL") ;;ARRAY-ROW-MAJOR-INDEX;;
(clisp-symbol :COMMON-LISP "ARRAY-TOTAL-SIZE" "NIL") ;;ARRAY-TOTAL-SIZE;;
(clisp-symbol :COMMON-LISP "ARRAY-TOTAL-SIZE-LIMIT" "(SYSTEM::CONSTANT-INLINABLE CONSTANT-NOTINLINE)") ;;ARRAY-TOTAL-SIZE-LIMIT;;
(clisp-symbol :COMMON-LISP "ARRAYP" "NIL") ;;ARRAYP;;
(clisp-symbol :COMMON-LISP "ASH" "NIL") ;;ASH;;
(clisp-symbol :COMMON-LISP "ASIN" "NIL") ;;ASIN;;
(clisp-symbol :COMMON-LISP "ASINH" "NIL") ;;ASINH;;
(clisp-symbol :COMMON-LISP "ASSERT" "(SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/condition.fas\" 1229 1261)))") ;;ASSERT;;
(clisp-symbol :COMMON-LISP "ASSOC" "NIL") ;;ASSOC;;
(clisp-symbol :COMMON-LISP "ASSOC-IF" "NIL") ;;ASSOC-IF;;
(clisp-symbol :COMMON-LISP "ASSOC-IF-NOT" "NIL") ;;ASSOC-IF-NOT;;
(clisp-symbol :COMMON-LISP "ATAN" "NIL") ;;ATAN;;
(clisp-symbol :COMMON-LISP "ATANH" "NIL") ;;ATANH;;
(clisp-symbol :COMMON-LISP "ATOM" "(SYSTEM::TYPE-SYMBOL #<SYSTEM-FUNCTION ATOM>)") ;;ATOM;;
(clisp-symbol :COMMON-LISP "BASE-CHAR" "(SYSTEM::TYPE-SYMBOL #<SYSTEM-FUNCTION CHARACTERP>)") ;;BASE-CHAR;;
(clisp-symbol :COMMON-LISP "BASE-STRING" "(SYSTEM::TYPE-LIST #<COMPILED-FUNCTION SYSTEM::TYPE-LIST-BASE-STRING> SYSTEM::TYPE-SYMBOL #<COMPILED-FUNCTION SYSTEM::TYPE-SYMBOL-BASE-STRING>)") ;;BASE-STRING;;
(clisp-symbol :COMMON-LISP "BIGNUM" "(SYSTEM::TYPE-SYMBOL #<COMPILED-FUNCTION SYSTEM::TYPE-SYMBOL-BIGNUM>)") ;;BIGNUM;;
(clisp-symbol :COMMON-LISP "BIT" "(SYSTEM::TYPE-SYMBOL #<COMPILED-FUNCTION SYSTEM::TYPE-SYMBOL-BIT> SYSTEM::SETF-EXPANDER SYSTEM::STORE SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/places.fas\" 995 995)))") ;;BIT;;
(clisp-symbol :COMMON-LISP "BIT-AND" "NIL") ;;BIT-AND;;
(clisp-symbol :COMMON-LISP "BIT-ANDC1" "NIL") ;;BIT-ANDC1;;
(clisp-symbol :COMMON-LISP "BIT-ANDC2" "NIL") ;;BIT-ANDC2;;
(clisp-symbol :COMMON-LISP "BIT-EQV" "NIL") ;;BIT-EQV;;
(clisp-symbol :COMMON-LISP "BIT-IOR" "NIL") ;;BIT-IOR;;
(clisp-symbol :COMMON-LISP "BIT-NAND" "NIL") ;;BIT-NAND;;
(clisp-symbol :COMMON-LISP "BIT-NOR" "NIL") ;;BIT-NOR;;
(clisp-symbol :COMMON-LISP "BIT-NOT" "NIL") ;;BIT-NOT;;
(clisp-symbol :COMMON-LISP "BIT-ORC1" "NIL") ;;BIT-ORC1;;
(clisp-symbol :COMMON-LISP "BIT-ORC2" "NIL") ;;BIT-ORC2;;
(clisp-symbol :COMMON-LISP "BIT-VECTOR" "(CLOS::CLOSCLASS #1=#<BUILT-IN-CLASS BIT-VECTOR> SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/clos-class3.fas\" 2584 2634)) SYSTEM::TYPE-LIST #<COMPILED-FUNCTION SYSTEM::TYPE-LIST-BIT-VECTOR> SYSTEM::TYPE-SYMBOL #<SYSTEM-FUNCTION BIT-VECTOR-P>)") ;;BIT-VECTOR;;
(clisp-symbol :COMMON-LISP "BIT-VECTOR-P" "NIL") ;;BIT-VECTOR-P;;
(clisp-symbol :COMMON-LISP "BIT-XOR" "NIL") ;;BIT-XOR;;
(clisp-symbol :COMMON-LISP "BLOCK" "(SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/compiler.fas\" 1008 1022)))") ;;BLOCK;;
(clisp-symbol :COMMON-LISP "BOOLE" "NIL") ;;BOOLE;;
(clisp-symbol :COMMON-LISP "BOOLE-1" "NIL") ;;BOOLE-1;;
(clisp-symbol :COMMON-LISP "BOOLE-2" "NIL") ;;BOOLE-2;;
(clisp-symbol :COMMON-LISP "BOOLE-AND" "NIL") ;;BOOLE-AND;;
(clisp-symbol :COMMON-LISP "BOOLE-ANDC1" "NIL") ;;BOOLE-ANDC1;;
(clisp-symbol :COMMON-LISP "BOOLE-ANDC2" "NIL") ;;BOOLE-ANDC2;;
(clisp-symbol :COMMON-LISP "BOOLE-C1" "NIL") ;;BOOLE-C1;;
(clisp-symbol :COMMON-LISP "BOOLE-C2" "NIL") ;;BOOLE-C2;;
(clisp-symbol :COMMON-LISP "BOOLE-CLR" "NIL") ;;BOOLE-CLR;;
(clisp-symbol :COMMON-LISP "BOOLE-EQV" "NIL") ;;BOOLE-EQV;;
(clisp-symbol :COMMON-LISP "BOOLE-IOR" "NIL") ;;BOOLE-IOR;;
(clisp-symbol :COMMON-LISP "BOOLE-NAND" "NIL") ;;BOOLE-NAND;;
(clisp-symbol :COMMON-LISP "BOOLE-NOR" "NIL") ;;BOOLE-NOR;;
(clisp-symbol :COMMON-LISP "BOOLE-ORC1" "NIL") ;;BOOLE-ORC1;;
(clisp-symbol :COMMON-LISP "BOOLE-ORC2" "NIL") ;;BOOLE-ORC2;;
(clisp-symbol :COMMON-LISP "BOOLE-SET" "NIL") ;;BOOLE-SET;;
(clisp-symbol :COMMON-LISP "BOOLE-XOR" "NIL") ;;BOOLE-XOR;;
(clisp-symbol :COMMON-LISP "BOOLEAN" "(SYSTEM::TYPE-SYMBOL #<COMPILED-FUNCTION SYSTEM::TYPE-SYMBOL-BOOLEAN>)") ;;BOOLEAN;;
(clisp-symbol :COMMON-LISP "BOTH-CASE-P" "NIL") ;;BOTH-CASE-P;;
(clisp-symbol :COMMON-LISP "BOUNDP" "(SYSTEM::INSTRUCTION 60)") ;;BOUNDP;;
(clisp-symbol :COMMON-LISP "BREAK" "(SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/condition.fas\" 1501 1529)))") ;;BREAK;;
(clisp-symbol :COMMON-LISP "BREAK-1" "NIL") ;;COMMON-LISP::BREAK-1;;
(clisp-symbol :COMMON-LISP "BREAK-2" "NIL") ;;COMMON-LISP::BREAK-2;;
(clisp-symbol :COMMON-LISP "BROADCAST-STREAM" "(CLOS::CLOSCLASS #1=#<BUILT-IN-CLASS BROADCAST-STREAM> SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/clos-class3.fas\" 2584 2634)) SYSTEM::TYPE-SYMBOL #<SYSTEM-FUNCTION SYSTEM::BROADCAST-STREAM-P>)") ;;BROADCAST-STREAM;;
(clisp-symbol :COMMON-LISP "BROADCAST-STREAM-STREAMS" "NIL") ;;BROADCAST-STREAM-STREAMS;;
(clisp-symbol :COMMON-LISP "BUTLAST" "NIL") ;;BUTLAST;;
(clisp-symbol :COMMON-LISP "BYTE" "(SYSTEM::SUBTYPEP-DECIDE SYSTEM::SUBTYPEP-MISC SYSTEM::SUBTYPEP-SIMPLIFY-OR SYSTEM::SIMPLIFY-OR-MISC SYSTEM::SUBTYPEP-SIMPLIFY-AND SYSTEM::SIMPLIFY-AND-MISC SYSTEM::SUBTYPEP-LIST NIL SYSTEM::SUBTYPEP-ATOM (BYTE))") ;;BYTE;;
(clisp-symbol :COMMON-LISP "BYTE-POSITION" "NIL") ;;BYTE-POSITION;;
(clisp-symbol :COMMON-LISP "BYTE-SIZE" "NIL") ;;BYTE-SIZE;;
(clisp-symbol :COMMON-LISP "CAAAAR" "(SYSTEM::SETF-EXPANDER (-1 1 . #<COMPILED-FUNCTION SYSTEM::SETF-CAAAAR>) SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/places.fas\" 565 565)))") ;;CAAAAR;;
(clisp-symbol :COMMON-LISP "CAAADR" "(SYSTEM::SETF-EXPANDER (-1 1 . #<COMPILED-FUNCTION SYSTEM::SETF-CAAADR>) SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/places.fas\" 566 566)))") ;;CAAADR;;
(clisp-symbol :COMMON-LISP "CAAAR" "(SYSTEM::SETF-EXPANDER (-1 1 . #<COMPILED-FUNCTION SYSTEM::SETF-CAAAR>) SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/places.fas\" 557 557)))") ;;CAAAR;;
(clisp-symbol :COMMON-LISP "CAADAR" "(SYSTEM::SETF-EXPANDER (-1 1 . #<COMPILED-FUNCTION SYSTEM::SETF-CAADAR>) SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/places.fas\" 567 567)))") ;;CAADAR;;
(clisp-symbol :COMMON-LISP "CAADDR" "(SYSTEM::SETF-EXPANDER (-1 1 . #<COMPILED-FUNCTION SYSTEM::SETF-CAADDR>) SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/places.fas\" 568 568)))") ;;CAADDR;;
(clisp-symbol :COMMON-LISP "CAADR" "(SYSTEM::SETF-EXPANDER (-1 1 . #<COMPILED-FUNCTION SYSTEM::SETF-CAADR>) SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/places.fas\" 558 558)))") ;;CAADR;;
(clisp-symbol :COMMON-LISP "CAAR" "(SYSTEM::SETF-EXPANDER (-1 1 . #<COMPILED-FUNCTION SYSTEM::SETF-CAAR>) SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/places.fas\" 553 553)))") ;;CAAR;;
(clisp-symbol :COMMON-LISP "CADAAR" "(SYSTEM::SETF-EXPANDER (-1 1 . #<COMPILED-FUNCTION SYSTEM::SETF-CADAAR>) SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/places.fas\" 569 569)))") ;;CADAAR;;
(clisp-symbol :COMMON-LISP "CADADR" "(SYSTEM::SETF-EXPANDER (-1 1 . #<COMPILED-FUNCTION SYSTEM::SETF-CADADR>) SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/places.fas\" 570 570)))") ;;CADADR;;
(clisp-symbol :COMMON-LISP "CADAR" "(SYSTEM::SETF-EXPANDER (-1 1 . #<COMPILED-FUNCTION SYSTEM::SETF-CADAR>) SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/places.fas\" 559 559)))") ;;CADAR;;
(clisp-symbol :COMMON-LISP "CADDAR" "(SYSTEM::SETF-EXPANDER (-1 1 . #<COMPILED-FUNCTION SYSTEM::SETF-CADDAR>) SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/places.fas\" 571 571)))") ;;CADDAR;;
(clisp-symbol :COMMON-LISP "CADDDR" "(SYSTEM::SETF-EXPANDER (-1 1 . #<COMPILED-FUNCTION SYSTEM::SETF-CADDDR>) SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/places.fas\" 572 572)))") ;;CADDDR;;
(clisp-symbol :COMMON-LISP "CADDR" "(SYSTEM::SETF-EXPANDER (-1 1 . #<COMPILED-FUNCTION SYSTEM::SETF-CADDR>) SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/places.fas\" 560 560)))") ;;CADDR;;
(clisp-symbol :COMMON-LISP "CADR" "(SYSTEM::SETF-EXPANDER (-1 1 . #<COMPILED-FUNCTION SYSTEM::SETF-CADR>) SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/places.fas\" 554 554)))") ;;CADR;;
(clisp-symbol :COMMON-LISP "CALL-ARGUMENTS-LIMIT" "(SYSTEM::CONSTANT-INLINABLE CONSTANT-NOTINLINE)") ;;CALL-ARGUMENTS-LIMIT;;
(clisp-symbol :COMMON-LISP "CAR" "(SYSTEM::INSTRUCTION 91 SYSTEM::SETF-EXPANDER SYSTEM::%RPLACA SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/places.fas\" 551 551)))") ;;CAR;;
(clisp-symbol :COMMON-LISP "CASE" "(SYSTEM::MACRO #<COMPILED-FUNCTION CASE>)") ;;CASE;;
(clisp-symbol :COMMON-LISP "CATCH" "NIL") ;;CATCH;;
(clisp-symbol :COMMON-LISP "CCASE" "(SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/condition.fas\" 1396 1475)))") ;;CCASE;;
(clisp-symbol :COMMON-LISP "CDAAAR" "(SYSTEM::SETF-EXPANDER (-1 1 . #<COMPILED-FUNCTION SYSTEM::SETF-CDAAAR>) SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/places.fas\" 573 573)))") ;;CDAAAR;;
(clisp-symbol :COMMON-LISP "CDAADR" "(SYSTEM::SETF-EXPANDER (-1 1 . #<COMPILED-FUNCTION SYSTEM::SETF-CDAADR>) SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/places.fas\" 574 574)))") ;;CDAADR;;
(clisp-symbol :COMMON-LISP "CDAAR" "(SYSTEM::SETF-EXPANDER (-1 1 . #<COMPILED-FUNCTION SYSTEM::SETF-CDAAR>) SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/places.fas\" 561 561)))") ;;CDAAR;;
(clisp-symbol :COMMON-LISP "CDADAR" "(SYSTEM::SETF-EXPANDER (-1 1 . #<COMPILED-FUNCTION SYSTEM::SETF-CDADAR>) SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/places.fas\" 575 575)))") ;;CDADAR;;
(clisp-symbol :COMMON-LISP "CDADDR" "(SYSTEM::SETF-EXPANDER (-1 1 . #<COMPILED-FUNCTION SYSTEM::SETF-CDADDR>) SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/places.fas\" 576 576)))") ;;CDADDR;;
(clisp-symbol :COMMON-LISP "CDADR" "(SYSTEM::SETF-EXPANDER (-1 1 . #<COMPILED-FUNCTION SYSTEM::SETF-CDADR>) SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/places.fas\" 562 562)))") ;;CDADR;;
(clisp-symbol :COMMON-LISP "CDAR" "(SYSTEM::SETF-EXPANDER (-1 1 . #<COMPILED-FUNCTION SYSTEM::SETF-CDAR>) SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/places.fas\" 555 555)))") ;;CDAR;;
(clisp-symbol :COMMON-LISP "CDDAAR" "(SYSTEM::SETF-EXPANDER (-1 1 . #<COMPILED-FUNCTION SYSTEM::SETF-CDDAAR>) SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/places.fas\" 577 577)))") ;;CDDAAR;;
(clisp-symbol :COMMON-LISP "CDDADR" "(SYSTEM::SETF-EXPANDER (-1 1 . #<COMPILED-FUNCTION SYSTEM::SETF-CDDADR>) SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/places.fas\" 578 578)))") ;;CDDADR;;
(clisp-symbol :COMMON-LISP "CDDAR" "(SYSTEM::SETF-EXPANDER (-1 1 . #<COMPILED-FUNCTION SYSTEM::SETF-CDDAR>) SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/places.fas\" 563 563)))") ;;CDDAR;;
(clisp-symbol :COMMON-LISP "CDDDAR" "(SYSTEM::SETF-EXPANDER (-1 1 . #<COMPILED-FUNCTION SYSTEM::SETF-CDDDAR>) SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/places.fas\" 579 579)))") ;;CDDDAR;;
(clisp-symbol :COMMON-LISP "CDDDDR" "(SYSTEM::SETF-EXPANDER (-1 1 . #<COMPILED-FUNCTION SYSTEM::SETF-CDDDDR>) SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/places.fas\" 580 580)))") ;;CDDDDR;;
(clisp-symbol :COMMON-LISP "CDDDR" "(SYSTEM::SETF-EXPANDER (-1 1 . #<COMPILED-FUNCTION SYSTEM::SETF-CDDDR>) SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/places.fas\" 564 564)))") ;;CDDDR;;
(clisp-symbol :COMMON-LISP "CDDR" "(SYSTEM::SETF-EXPANDER (-1 1 . #<COMPILED-FUNCTION SYSTEM::SETF-CDDR>) SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/places.fas\" 556 556)))") ;;CDDR;;
(clisp-symbol :COMMON-LISP "CDR" "(SYSTEM::INSTRUCTION 92 SYSTEM::SETF-EXPANDER SYSTEM::%RPLACD SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/places.fas\" 552 552)))") ;;CDR;;
(clisp-symbol :COMMON-LISP "CEILING" "NIL") ;;CEILING;;
(clisp-symbol :COMMON-LISP "CELL-ERROR" "(CLOS::CLOSCLASS #1=#<STANDARD-CLASS CELL-ERROR> SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/condition.fas\" 360 362)))") ;;CELL-ERROR;;
(clisp-symbol :COMMON-LISP "CELL-ERROR-NAME" "NIL") ;;CELL-ERROR-NAME;;
(clisp-symbol :COMMON-LISP "CERROR" "(SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/condition.fas\" 1531 1585)))") ;;CERROR;;
(clisp-symbol :COMMON-LISP "CERROR-1" "NIL") ;;COMMON-LISP::CERROR-1;;
(clisp-symbol :COMMON-LISP "CERROR-2" "NIL") ;;COMMON-LISP::CERROR-2;;
(clisp-symbol :COMMON-LISP "CHAR" "(SYSTEM::SETF-EXPANDER SYSTEM::STORE-CHAR SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/places.fas\" 992 993)))") ;;CHAR;;
(clisp-symbol :COMMON-LISP "CHAR-CODE" "NIL") ;;CHAR-CODE;;
(clisp-symbol :COMMON-LISP "CHAR-CODE-LIMIT" "(SYSTEM::CONSTANT-INLINABLE CONSTANT-NOTINLINE)") ;;CHAR-CODE-LIMIT;;
(clisp-symbol :COMMON-LISP "CHAR-DOWNCASE" "NIL") ;;CHAR-DOWNCASE;;
(clisp-symbol :COMMON-LISP "CHAR-EQUAL" "NIL") ;;CHAR-EQUAL;;
(clisp-symbol :COMMON-LISP "CHAR-GREATERP" "NIL") ;;CHAR-GREATERP;;
(clisp-symbol :COMMON-LISP "CHAR-INT" "NIL") ;;CHAR-INT;;
(clisp-symbol :COMMON-LISP "CHAR-LESSP" "NIL") ;;CHAR-LESSP;;
(clisp-symbol :COMMON-LISP "CHAR-NAME" "NIL") ;;CHAR-NAME;;
(clisp-symbol :COMMON-LISP "CHAR-NOT-EQUAL" "NIL") ;;CHAR-NOT-EQUAL;;
(clisp-symbol :COMMON-LISP "CHAR-NOT-GREATERP" "NIL") ;;CHAR-NOT-GREATERP;;
(clisp-symbol :COMMON-LISP "CHAR-NOT-LESSP" "NIL") ;;CHAR-NOT-LESSP;;
(clisp-symbol :COMMON-LISP "CHAR-UPCASE" "NIL") ;;CHAR-UPCASE;;
(clisp-symbol :COMMON-LISP "CHAR/=" "NIL") ;;CHAR/=;;
(clisp-symbol :COMMON-LISP "CHAR<" "NIL") ;;CHAR<;;
(clisp-symbol :COMMON-LISP "CHAR<=" "NIL") ;;CHAR<=;;
(clisp-symbol :COMMON-LISP "CHAR=" "NIL") ;;CHAR=;;
(clisp-symbol :COMMON-LISP "CHAR>" "NIL") ;;CHAR>;;
(clisp-symbol :COMMON-LISP "CHAR>=" "NIL") ;;CHAR>=;;
(clisp-symbol :COMMON-LISP "CHARACTER" "(CLOS::CLOSCLASS #1=#<BUILT-IN-CLASS CHARACTER> SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/clos-class3.fas\" 2584 2634)) SYSTEM::SUBTYPEP-DECIDE SYSTEM::SUBTYPEP-CHARACTER SYSTEM::SUBTYPEP-SIMPLIFY-OR SYSTEM::SIMPLIFY-OR-CHARACTER SYSTEM::SUBTYPEP-SIMPLIFY-AND SYSTEM::SIMPLIFY-AND-CHARACTER SYSTEM::SUBTYPEP-LIST (SYSTEM::CHARACTER-INTERVALS) SYSTEM::SUBTYPEP-ATOM (CHARACTER) SYSTEM::TYPE-SYMBOL #<SYSTEM-FUNCTION CHARACTERP>)") ;;CHARACTER;;
(clisp-symbol :COMMON-LISP "CHARACTERP" "NIL") ;;CHARACTERP;;
(clisp-symbol :COMMON-LISP "CHECK-TYPE" "(SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/condition.fas\" 1199 1213)))") ;;CHECK-TYPE;;
(clisp-symbol :COMMON-LISP "CIS" "NIL") ;;CIS;;
(clisp-symbol :COMMON-LISP "CLEAR-INPUT" "NIL") ;;CLEAR-INPUT;;
(clisp-symbol :COMMON-LISP "CLEAR-OUTPUT" "NIL") ;;CLEAR-OUTPUT;;
(clisp-symbol :COMMON-LISP "CLOSE" "NIL") ;;CLOSE;;
(clisp-symbol :COMMON-LISP "CLRHASH" "NIL") ;;CLRHASH;;
(clisp-symbol :COMMON-LISP "CODE-CHAR" "NIL") ;;CODE-CHAR;;
(clisp-symbol :COMMON-LISP "COERCE" "NIL") ;;COERCE;;
(clisp-symbol :COMMON-LISP "COMPILATION-SPEED" "NIL") ;;COMPILATION-SPEED;;
(clisp-symbol :COMMON-LISP "COMPILE" "(SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/compiler.fas\" 10761 10852)))") ;;COMPILE;;
(clisp-symbol :COMMON-LISP "COMPILE-CLOSURE-SLOT" "NIL") ;;COMMON-LISP::COMPILE-CLOSURE-SLOT;;
(clisp-symbol :COMMON-LISP "COMPILE-FILE" "(SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/compiler.fas\" 11105 11289)))") ;;COMPILE-FILE;;
(clisp-symbol :COMMON-LISP "COMPILE-FILE-1" "NIL") ;;COMMON-LISP::COMPILE-FILE-1;;
(clisp-symbol :COMMON-LISP "COMPILE-FILE-PATHNAME" "(SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/compiler.fas\" 11291 11293)))") ;;COMPILE-FILE-PATHNAME;;
(clisp-symbol :COMMON-LISP "COMPILE-FILE-SET-UTF-8" "NIL") ;;COMMON-LISP::COMPILE-FILE-SET-UTF-8;;
(clisp-symbol :COMMON-LISP "COMPILE-FILE-SET-UTF-8-1" "NIL") ;;COMMON-LISP::COMPILE-FILE-SET-UTF-8-1;;
(clisp-symbol :COMMON-LISP "COMPILED-FUNCTION" "(SYSTEM::TYPE-SYMBOL #<SYSTEM-FUNCTION COMPILED-FUNCTION-P>)") ;;COMPILED-FUNCTION;;
(clisp-symbol :COMMON-LISP "COMPILED-FUNCTION-P" "NIL") ;;COMPILED-FUNCTION-P;;
(clisp-symbol :COMMON-LISP "COMPILER-MACRO" "NIL") ;;COMPILER-MACRO;;
(clisp-symbol :COMMON-LISP "COMPILER-MACRO-FUNCTION" "(SYSTEM::SETF-FUNCTION COMMON-LISP::|(SETF COMMON-LISP:COMPILER-MACRO-FUNCTION)| SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/cmacros.fas\" 8 49)))") ;;COMPILER-MACRO-FUNCTION;;
(clisp-symbol :COMMON-LISP "COMPLEMENT" "(SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/defs2.fas\" 68 74)))") ;;COMPLEMENT;;
(clisp-symbol :COMMON-LISP "COMPLEMENT-1" "NIL") ;;COMMON-LISP::COMPLEMENT-1;;
(clisp-symbol :COMMON-LISP "COMPLEX" "(CLOS::CLOSCLASS #1=#<BUILT-IN-CLASS COMPLEX> SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/clos-class3.fas\" 2584 2634)) SYSTEM::SUBTYPEP-DECIDE SYSTEM::SUBTYPEP-COMPLEX SYSTEM::SUBTYPEP-SIMPLIFY-OR SYSTEM::SIMPLIFY-OR-COMPLEX SYSTEM::SUBTYPEP-SIMPLIFY-AND SYSTEM::SIMPLIFY-AND-COMPLEX SYSTEM::SUBTYPEP-LIST (COMPLEX) SYSTEM::SUBTYPEP-ATOM (COMPLEX) SYSTEM::TYPE-LIST #<COMPILED-FUNCTION SYSTEM::TYPE-LIST-COMPLEX> SYSTEM::TYPE-SYMBOL #<SYSTEM-FUNCTION COMPLEXP>)") ;;COMPLEX;;
(clisp-symbol :COMMON-LISP "COMPLEXP" "NIL") ;;COMPLEXP;;
(clisp-symbol :COMMON-LISP "COMPUTE-RESTARTS" "(SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/condition.fas\" 811 814)))") ;;COMPUTE-RESTARTS;;
(clisp-symbol :COMMON-LISP "COMPUTE-RESTARTS-1" "NIL") ;;COMMON-LISP::COMPUTE-RESTARTS-1;;
(clisp-symbol :COMMON-LISP "CONCATENATE" "NIL") ;;CONCATENATE;;
(clisp-symbol :COMMON-LISP "CONCATENATED-STREAM" "(CLOS::CLOSCLASS #1=#<BUILT-IN-CLASS CONCATENATED-STREAM> SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/clos-class3.fas\" 2584 2634)) SYSTEM::TYPE-SYMBOL #<SYSTEM-FUNCTION SYSTEM::CONCATENATED-STREAM-P>)") ;;CONCATENATED-STREAM;;
(clisp-symbol :COMMON-LISP "CONCATENATED-STREAM-STREAMS" "NIL") ;;CONCATENATED-STREAM-STREAMS;;
(clisp-symbol :COMMON-LISP "COND" "(SYSTEM::MACRO #<COMPILED-FUNCTION COND>)") ;;COND;;
(clisp-symbol :COMMON-LISP "CONDITION" "(CLOS::CLOSCLASS #1=#<STANDARD-CLASS CONDITION> SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/condition.fas\" 49 61)))") ;;CONDITION;;
(clisp-symbol :COMMON-LISP "CONJUGATE" "NIL") ;;CONJUGATE;;
(clisp-symbol :COMMON-LISP "CONS" "(SYSTEM::INSTRUCTION 93 CLOS::CLOSCLASS #1=#<BUILT-IN-CLASS CONS> SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/clos-class3.fas\" 2584 2634)) SYSTEM::SUBTYPEP-DECIDE SYSTEM::SUBTYPEP-CONS SYSTEM::SUBTYPEP-SIMPLIFY-OR SYSTEM::SIMPLIFY-OR-CONS SYSTEM::SUBTYPEP-SIMPLIFY-AND SYSTEM::SIMPLIFY-AND-CONS SYSTEM::SUBTYPEP-LIST (CONS) SYSTEM::SUBTYPEP-ATOM (CONS) SYSTEM::TYPE-LIST #<COMPILED-FUNCTION SYSTEM::TYPE-LIST-CONS> SYSTEM::TYPE-SYMBOL #<SYSTEM-FUNCTION CONSP>)") ;;CONS;;
(clisp-symbol :COMMON-LISP "CONSP" "NIL") ;;CONSP;;
(clisp-symbol :COMMON-LISP "CONSTANTLY" "(SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/defs2.fas\" 76 80)))") ;;CONSTANTLY;;
(clisp-symbol :COMMON-LISP "CONSTANTLY-1" "NIL") ;;COMMON-LISP::CONSTANTLY-1;;
(clisp-symbol :COMMON-LISP "CONSTANTP" "NIL") ;;CONSTANTP;;
(clisp-symbol :COMMON-LISP "CONTINUE" "(SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/condition.fas\" 1154 1156)))") ;;CONTINUE;;
(clisp-symbol :COMMON-LISP "CONTROL-ERROR" "(CLOS::CLOSCLASS #1=#<STANDARD-CLASS CONTROL-ERROR> SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/condition.fas\" 337 340)))") ;;CONTROL-ERROR;;
(clisp-symbol :COMMON-LISP "COPY-ALIST" "NIL") ;;COPY-ALIST;;
(clisp-symbol :COMMON-LISP "COPY-LIST" "NIL") ;;COPY-LIST;;
(clisp-symbol :COMMON-LISP "COPY-PPRINT-DISPATCH" "(SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/pprint.fas\" 60 71)))") ;;COPY-PPRINT-DISPATCH;;
(clisp-symbol :COMMON-LISP "COPY-READTABLE" "NIL") ;;COPY-READTABLE;;
(clisp-symbol :COMMON-LISP "COPY-SEQ" "NIL") ;;COPY-SEQ;;
(clisp-symbol :COMMON-LISP "COPY-STRUCTURE" "NIL") ;;COPY-STRUCTURE;;
(clisp-symbol :COMMON-LISP "COPY-SYMBOL" "(SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/defs1.fas\" 14 29)))") ;;COPY-SYMBOL;;
(clisp-symbol :COMMON-LISP "COPY-TREE" "NIL") ;;COPY-TREE;;
(clisp-symbol :COMMON-LISP "COS" "NIL") ;;COS;;
(clisp-symbol :COMMON-LISP "COSH" "NIL") ;;COSH;;
(clisp-symbol :COMMON-LISP "COUNT" "NIL") ;;COUNT;;
(clisp-symbol :COMMON-LISP "COUNT-IF" "NIL") ;;COUNT-IF;;
(clisp-symbol :COMMON-LISP "COUNT-IF-NOT" "NIL") ;;COUNT-IF-NOT;;
(clisp-symbol :COMMON-LISP "CTYPECASE" "(SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/condition.fas\" 1396 1475)))") ;;CTYPECASE;;
(clisp-symbol :COMMON-LISP "DEBUG" "NIL") ;;DEBUG;;
(clisp-symbol :COMMON-LISP "DECF" "(SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/places.fas\" 789 790)))") ;;DECF;;
(clisp-symbol :COMMON-LISP "DECLAIM" "(SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/defs2.fas\" 13 21)))") ;;DECLAIM;;
(clisp-symbol :COMMON-LISP "DECLARATION" "NIL") ;;DECLARATION;;
(clisp-symbol :COMMON-LISP "DECLARE" "(SYSTEM::MACRO #<COMPILED-FUNCTION DECLARE>)") ;;DECLARE;;
(clisp-symbol :COMMON-LISP "DECODE-FLOAT" "NIL") ;;DECODE-FLOAT;;
(clisp-symbol :COMMON-LISP "DECODE-UNIVERSAL-TIME" "(SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/defs1.fas\" 651 791)))") ;;DECODE-UNIVERSAL-TIME;;
(clisp-symbol :COMMON-LISP "DEFCONSTANT" "(SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/macros1.fas\" 62 82)))") ;;DEFCONSTANT;;
(clisp-symbol :COMMON-LISP "DEFINE-COMPILER-MACRO" "(SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/cmacros.fas\" 74 88)))") ;;DEFINE-COMPILER-MACRO;;
(clisp-symbol :COMMON-LISP "DEFINE-CONDITION" "(SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/condition.fas\" 85 152)))") ;;DEFINE-CONDITION;;
(clisp-symbol :COMMON-LISP "DEFINE-MODIFY-MACRO" "(SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/places.fas\" 743 788)))") ;;DEFINE-MODIFY-MACRO;;
(clisp-symbol :COMMON-LISP "DEFINE-MODIFY-MACRO-1" "NIL") ;;COMMON-LISP::DEFINE-MODIFY-MACRO-1;;
(clisp-symbol :COMMON-LISP "DEFINE-SETF-EXPANDER" "(SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/places.fas\" 354 414)))") ;;DEFINE-SETF-EXPANDER;;
(clisp-symbol :COMMON-LISP "DEFINE-SYMBOL-MACRO" "(SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/macros2.fas\" 213 229)))") ;;DEFINE-SYMBOL-MACRO;;
(clisp-symbol :COMMON-LISP "DEFMACRO" "NIL") ;;DEFMACRO;;
(clisp-symbol :COMMON-LISP "DEFPACKAGE" "(SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/defpackage.fas\" 11 202)))") ;;DEFPACKAGE;;
(clisp-symbol :COMMON-LISP "DEFPACKAGE-MODERNIZE" "NIL") ;;COMMON-LISP::DEFPACKAGE-MODERNIZE;;
(clisp-symbol :COMMON-LISP "DEFPACKAGE-RECORD-SYMNAME" "NIL") ;;COMMON-LISP::DEFPACKAGE-RECORD-SYMNAME;;
(clisp-symbol :COMMON-LISP "DEFPARAMETER" "(SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/macros1.fas\" 42 60)))") ;;DEFPARAMETER;;
(clisp-symbol :COMMON-LISP "DEFSETF" "(SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/places.fas\" 415 500)))") ;;DEFSETF;;
(clisp-symbol :COMMON-LISP "DEFSETF-1" "NIL") ;;COMMON-LISP::DEFSETF-1;;
(clisp-symbol :COMMON-LISP "DEFSTRUCT" "(SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/defstruct.fas\" 586 1134)))") ;;DEFSTRUCT;;
(clisp-symbol :COMMON-LISP "DEFSTRUCT-1" "NIL") ;;COMMON-LISP::DEFSTRUCT-1;;
(clisp-symbol :COMMON-LISP "DEFSTRUCT-2" "NIL") ;;COMMON-LISP::DEFSTRUCT-2;;
(clisp-symbol :COMMON-LISP "DEFTYPE" "(SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/macros2.fas\" 169 208)))") ;;DEFTYPE;;
(clisp-symbol :COMMON-LISP "DEFUN" "NIL") ;;DEFUN;;
(clisp-symbol :COMMON-LISP "DEFVAR" "(SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/macros1.fas\" 19 40)))") ;;DEFVAR;;
(clisp-symbol :COMMON-LISP "DELETE" "NIL") ;;DELETE;;
(clisp-symbol :COMMON-LISP "DELETE-DUPLICATES" "NIL") ;;DELETE-DUPLICATES;;
(clisp-symbol :COMMON-LISP "DELETE-FILE" "NIL") ;;DELETE-FILE;;
(clisp-symbol :COMMON-LISP "DELETE-IF" "NIL") ;;DELETE-IF;;
(clisp-symbol :COMMON-LISP "DELETE-IF-NOT" "NIL") ;;DELETE-IF-NOT;;
(clisp-symbol :COMMON-LISP "DELETE-PACKAGE" "NIL") ;;DELETE-PACKAGE;;
(clisp-symbol :COMMON-LISP "DENOMINATOR" "NIL") ;;DENOMINATOR;;
(clisp-symbol :COMMON-LISP "DEPOSIT-FIELD" "NIL") ;;DEPOSIT-FIELD;;
(clisp-symbol :COMMON-LISP "DESCRIBE" "(SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/describe.fas\" 582 601)))") ;;DESCRIBE;;
(clisp-symbol :COMMON-LISP "DESTRUCTURING-BIND" "(SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/defs2.fas\" 23 51)))") ;;DESTRUCTURING-BIND;;
(clisp-symbol :COMMON-LISP "DIGIT-CHAR" "NIL") ;;DIGIT-CHAR;;
(clisp-symbol :COMMON-LISP "DIGIT-CHAR-P" "NIL") ;;DIGIT-CHAR-P;;
(clisp-symbol :COMMON-LISP "DIRECTORY" "NIL") ;;DIRECTORY;;
(clisp-symbol :COMMON-LISP "DIRECTORY-NAMESTRING" "NIL") ;;DIRECTORY-NAMESTRING;;
(clisp-symbol :COMMON-LISP "DISASSEMBLE" "NIL") ;;DISASSEMBLE;;
(clisp-symbol :COMMON-LISP "DIVISION-BY-ZERO" "(CLOS::CLOSCLASS #1=#<STANDARD-CLASS DIVISION-BY-ZERO> SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/condition.fas\" 347 348)))") ;;DIVISION-BY-ZERO;;
(clisp-symbol :COMMON-LISP "DO" "(SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/macros1.fas\" 196 198)))") ;;DO;;
(clisp-symbol :COMMON-LISP "DO*" "(SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/macros1.fas\" 200 202)))") ;;DO*;;
(clisp-symbol :COMMON-LISP "DO-ALL-SYMBOLS" "(SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/defs1.fas\" 75 84)))") ;;DO-ALL-SYMBOLS;;
(clisp-symbol :COMMON-LISP "DO-EXTERNAL-SYMBOLS" "(SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/defs1.fas\" 59 73)))") ;;DO-EXTERNAL-SYMBOLS;;
(clisp-symbol :COMMON-LISP "DO-SYMBOLS" "(SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/defs1.fas\" 43 57)))") ;;DO-SYMBOLS;;
(clisp-symbol :COMMON-LISP "DOLIST" "(SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/macros1.fas\" 204 219)))") ;;DOLIST;;
(clisp-symbol :COMMON-LISP "DOTIMES" "(SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/macros1.fas\" 222 236)))") ;;DOTIMES;;
(clisp-symbol :COMMON-LISP "DOUBLE-FLOAT" "(SYSTEM::TYPE-LIST #<COMPILED-FUNCTION SYSTEM::TYPE-LIST-DOUBLE-FLOAT> SYSTEM::TYPE-SYMBOL #<SYSTEM-FUNCTION SYSTEM::DOUBLE-FLOAT-P>)") ;;DOUBLE-FLOAT;;
(clisp-symbol :COMMON-LISP "DOUBLE-FLOAT-EPSILON" "(SYSTEM::CONSTANT-INLINABLE CONSTANT-NOTINLINE)") ;;DOUBLE-FLOAT-EPSILON;;
(clisp-symbol :COMMON-LISP "DOUBLE-FLOAT-NEGATIVE-EPSILON" "(SYSTEM::CONSTANT-INLINABLE CONSTANT-NOTINLINE)") ;;DOUBLE-FLOAT-NEGATIVE-EPSILON;;
(clisp-symbol :COMMON-LISP "DPB" "NIL") ;;DPB;;
(clisp-symbol :COMMON-LISP "DRIBBLE" "(SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/dribble.fas\" 66 71)))") ;;DRIBBLE;;
(clisp-symbol :COMMON-LISP "DYNAMIC-EXTENT" "NIL") ;;DYNAMIC-EXTENT;;
(clisp-symbol :COMMON-LISP "ECASE" "(SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/condition.fas\" 1396 1475)))") ;;ECASE;;
(clisp-symbol :COMMON-LISP "ECHO-STREAM" "(CLOS::CLOSCLASS #1=#<BUILT-IN-CLASS ECHO-STREAM> SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/clos-class3.fas\" 2584 2634)) SYSTEM::TYPE-SYMBOL #<SYSTEM-FUNCTION SYSTEM::ECHO-STREAM-P>)") ;;ECHO-STREAM;;
(clisp-symbol :COMMON-LISP "ECHO-STREAM-INPUT-STREAM" "NIL") ;;ECHO-STREAM-INPUT-STREAM;;
(clisp-symbol :COMMON-LISP "ECHO-STREAM-OUTPUT-STREAM" "NIL") ;;ECHO-STREAM-OUTPUT-STREAM;;
(clisp-symbol :COMMON-LISP "ED" "(SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/edit.fas\" 43 84)))") ;;ED;;
(clisp-symbol :COMMON-LISP "EIGHTH" "(SYSTEM::SETF-EXPANDER (-1 1 . #<COMPILED-FUNCTION SYSTEM::SETF-EIGHTH>) SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/places.fas\" 547 547)))") ;;EIGHTH;;
(clisp-symbol :COMMON-LISP "ELT" "(SYSTEM::SETF-FUNCTION SYSTEM::|(SETF ELT)|)") ;;ELT;;
(clisp-symbol :COMMON-LISP "ENCODE-UNIVERSAL-TIME" "(SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/defs1.fas\" 651 791)))") ;;ENCODE-UNIVERSAL-TIME;;
(clisp-symbol :COMMON-LISP "END-OF-FILE" "(CLOS::CLOSCLASS #1=#<STANDARD-CLASS END-OF-FILE> SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/condition.fas\" 410 411)))") ;;END-OF-FILE;;
(clisp-symbol :COMMON-LISP "ENDP" "NIL") ;;ENDP;;
(clisp-symbol :COMMON-LISP "ENOUGH-NAMESTRING" "NIL") ;;ENOUGH-NAMESTRING;;
(clisp-symbol :COMMON-LISP "ENSURE-DIRECTORIES-EXIST" "NIL") ;;ENSURE-DIRECTORIES-EXIST;;
(clisp-symbol :COMMON-LISP "EQ" "(SYSTEM::INSTRUCTION 90)") ;;EQ;;
(clisp-symbol :COMMON-LISP "EQL" "NIL") ;;EQL;;
(clisp-symbol :COMMON-LISP "EQUAL" "NIL") ;;EQUAL;;
(clisp-symbol :COMMON-LISP "EQUALP" "NIL") ;;EQUALP;;
(clisp-symbol :COMMON-LISP "ERROR" "(CLOS::CLOSCLASS #1=#<STANDARD-CLASS ERROR> SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/condition.fas\" 322 323)))") ;;ERROR;;
(clisp-symbol :COMMON-LISP "ETYPECASE" "(SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/condition.fas\" 1396 1475)))") ;;ETYPECASE;;
(clisp-symbol :COMMON-LISP "EVAL" "NIL") ;;EVAL;;
(clisp-symbol :COMMON-LISP "EVAL-WHEN" "NIL") ;;EVAL-WHEN;;
(clisp-symbol :COMMON-LISP "EVENP" "NIL") ;;EVENP;;
(clisp-symbol :COMMON-LISP "EVERY" "NIL") ;;EVERY;;
(clisp-symbol :COMMON-LISP "EXP" "NIL") ;;EXP;;
(clisp-symbol :COMMON-LISP "EXPORT" "NIL") ;;EXPORT;;
(clisp-symbol :COMMON-LISP "EXPT" "NIL") ;;EXPT;;
(clisp-symbol :COMMON-LISP "EXTENDED-CHAR" "(SYSTEM::TYPE-SYMBOL #<COMPILED-FUNCTION SYSTEM::TYPE-SYMBOL-EXTENDED-CHAR>)") ;;EXTENDED-CHAR;;
(clisp-symbol :COMMON-LISP "FBOUNDP" "NIL") ;;FBOUNDP;;
(clisp-symbol :COMMON-LISP "FCEILING" "NIL") ;;FCEILING;;
(clisp-symbol :COMMON-LISP "FDEFINITION" "(SYSTEM::SETF-EXPANDER SYSTEM::SET-FDEFINITION SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/places.fas\" 982 982)))") ;;FDEFINITION;;
(clisp-symbol :COMMON-LISP "FFLOOR" "NIL") ;;FFLOOR;;
(clisp-symbol :COMMON-LISP "FIFTH" "(SYSTEM::SETF-EXPANDER (-1 1 . #<COMPILED-FUNCTION SYSTEM::SETF-FIFTH>) SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/places.fas\" 544 544)))") ;;FIFTH;;
(clisp-symbol :COMMON-LISP "FILE-AUTHOR" "NIL") ;;FILE-AUTHOR;;
(clisp-symbol :COMMON-LISP "FILE-ERROR" "(CLOS::CLOSCLASS #1=#<STANDARD-CLASS FILE-ERROR> SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/condition.fas\" 416 418)))") ;;FILE-ERROR;;
(clisp-symbol :COMMON-LISP "FILE-ERROR-PATHNAME" "NIL") ;;FILE-ERROR-PATHNAME;;
(clisp-symbol :COMMON-LISP "FILE-LENGTH" "NIL") ;;FILE-LENGTH;;
(clisp-symbol :COMMON-LISP "FILE-NAMESTRING" "NIL") ;;FILE-NAMESTRING;;
(clisp-symbol :COMMON-LISP "FILE-POSITION" "NIL") ;;FILE-POSITION;;
(clisp-symbol :COMMON-LISP "FILE-STREAM" "(CLOS::CLOSCLASS #1=#<BUILT-IN-CLASS FILE-STREAM> SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/clos-class3.fas\" 2584 2634)) SYSTEM::TYPE-SYMBOL #<SYSTEM-FUNCTION SYSTEM::FILE-STREAM-P>)") ;;FILE-STREAM;;
(clisp-symbol :COMMON-LISP "FILE-STRING-LENGTH" "NIL") ;;FILE-STRING-LENGTH;;
(clisp-symbol :COMMON-LISP "FILE-WRITE-DATE" "NIL") ;;FILE-WRITE-DATE;;
(clisp-symbol :COMMON-LISP "FILL" "NIL") ;;FILL;;
(clisp-symbol :COMMON-LISP "FILL-POINTER" "(SYSTEM::SETF-EXPANDER SYSTEM::SET-FILL-POINTER SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/places.fas\" 967 968)))") ;;FILL-POINTER;;
(clisp-symbol :COMMON-LISP "FIND" "NIL") ;;FIND;;
(clisp-symbol :COMMON-LISP "FIND-ALL-SYMBOLS" "NIL") ;;FIND-ALL-SYMBOLS;;
(clisp-symbol :COMMON-LISP "FIND-IF" "NIL") ;;FIND-IF;;
(clisp-symbol :COMMON-LISP "FIND-IF-NOT" "NIL") ;;FIND-IF-NOT;;
(clisp-symbol :COMMON-LISP "FIND-PACKAGE" "NIL") ;;FIND-PACKAGE;;
(clisp-symbol :COMMON-LISP "FIND-RESTART" "(SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/condition.fas\" 816 845)))") ;;FIND-RESTART;;
(clisp-symbol :COMMON-LISP "FIND-SYMBOL" "NIL") ;;FIND-SYMBOL;;
(clisp-symbol :COMMON-LISP "FINISH-OUTPUT" "NIL") ;;FINISH-OUTPUT;;
(clisp-symbol :COMMON-LISP "FIRST" "(SYSTEM::SETF-EXPANDER SYSTEM::%RPLACA SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/places.fas\" 540 540)))") ;;FIRST;;
(clisp-symbol :COMMON-LISP "FIXNUM" "(SYSTEM::TYPE-SYMBOL #<SYSTEM-FUNCTION SYSTEM::FIXNUMP>)") ;;FIXNUM;;
(clisp-symbol :COMMON-LISP "FLET" "NIL") ;;FLET;;
(clisp-symbol :COMMON-LISP "FLOAT" "(CLOS::CLOSCLASS #1=#<BUILT-IN-CLASS FLOAT> SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/clos-class3.fas\" 2584 2634)) SYSTEM::TYPE-LIST #<COMPILED-FUNCTION SYSTEM::TYPE-LIST-FLOAT> SYSTEM::TYPE-SYMBOL #<SYSTEM-FUNCTION FLOATP>)") ;;FLOAT;;
(clisp-symbol :COMMON-LISP "FLOAT-DIGITS" "NIL") ;;FLOAT-DIGITS;;
(clisp-symbol :COMMON-LISP "FLOAT-PRECISION" "NIL") ;;FLOAT-PRECISION;;
(clisp-symbol :COMMON-LISP "FLOAT-RADIX" "NIL") ;;FLOAT-RADIX;;
(clisp-symbol :COMMON-LISP "FLOAT-SIGN" "NIL") ;;FLOAT-SIGN;;
(clisp-symbol :COMMON-LISP "FLOATING-POINT-INEXACT" "(CLOS::CLOSCLASS #1=#<STANDARD-CLASS FLOATING-POINT-INEXACT> SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/condition.fas\" 356 356)))") ;;FLOATING-POINT-INEXACT;;
(clisp-symbol :COMMON-LISP "FLOATING-POINT-INVALID-OPERATION" "(CLOS::CLOSCLASS #1=#<STANDARD-CLASS FLOATING-POINT-INVALID-OPERATION> SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/condition.fas\" 358 358)))") ;;FLOATING-POINT-INVALID-OPERATION;;
(clisp-symbol :COMMON-LISP "FLOATING-POINT-OVERFLOW" "(CLOS::CLOSCLASS #1=#<STANDARD-CLASS FLOATING-POINT-OVERFLOW> SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/condition.fas\" 350 351)))") ;;FLOATING-POINT-OVERFLOW;;
(clisp-symbol :COMMON-LISP "FLOATING-POINT-UNDERFLOW" "(CLOS::CLOSCLASS #1=#<STANDARD-CLASS FLOATING-POINT-UNDERFLOW> SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/condition.fas\" 353 354)))") ;;FLOATING-POINT-UNDERFLOW;;
(clisp-symbol :COMMON-LISP "FLOATP" "NIL") ;;FLOATP;;
(clisp-symbol :COMMON-LISP "FLOOR" "NIL") ;;FLOOR;;
(clisp-symbol :COMMON-LISP "FMAKUNBOUND" "NIL") ;;FMAKUNBOUND;;
(clisp-symbol :COMMON-LISP "FORCE-OUTPUT" "NIL") ;;FORCE-OUTPUT;;
(clisp-symbol :COMMON-LISP "FORMAT" "(SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/format.fas\" 337 363)))") ;;FORMAT;;
(clisp-symbol :COMMON-LISP "FORMATTER" "(SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/format.fas\" 2570 2596)))") ;;FORMATTER;;
(clisp-symbol :COMMON-LISP "FOURTH" "(SYSTEM::SETF-EXPANDER (-1 1 . #<COMPILED-FUNCTION SYSTEM::SETF-FOURTH>) SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/places.fas\" 543 543)))") ;;FOURTH;;
(clisp-symbol :COMMON-LISP "FRESH-LINE" "NIL") ;;FRESH-LINE;;
(clisp-symbol :COMMON-LISP "FROUND" "NIL") ;;FROUND;;
(clisp-symbol :COMMON-LISP "FTRUNCATE" "NIL") ;;FTRUNCATE;;
(clisp-symbol :COMMON-LISP "FTYPE" "NIL") ;;FTYPE;;
(clisp-symbol :COMMON-LISP "FUNCALL" "(SYSTEM::INSTRUCTION 54 SYSTEM::SETF-EXPANDER (-5 . #<COMPILED-FUNCTION #:SETF-FUNCALL>) SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/places.fas\" 1125 1144)))") ;;FUNCALL;;
(clisp-symbol :COMMON-LISP "FUNCTION" "(CLOS::CLOSCLASS #1=#<BUILT-IN-CLASS FUNCTION> SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/clos-class3.fas\" 2584 2634)) SYSTEM::TYPE-SYMBOL #<SYSTEM-FUNCTION FUNCTIONP>)") ;;FUNCTION;;
(clisp-symbol :COMMON-LISP "FUNCTION-LAMBDA-EXPRESSION" "(SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/functions.fas\" 19 42)))") ;;FUNCTION-LAMBDA-EXPRESSION;;
(clisp-symbol :COMMON-LISP "FUNCTIONP" "NIL") ;;FUNCTIONP;;
(clisp-symbol :COMMON-LISP "GCD" "NIL") ;;GCD;;
(clisp-symbol :COMMON-LISP "GENSYM" "NIL") ;;GENSYM;;
(clisp-symbol :COMMON-LISP "GENTEMP" "(SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/defs1.fas\" 31 40)))") ;;GENTEMP;;
(clisp-symbol :COMMON-LISP "GET" "(SYSTEM::SETF-EXPANDER (-1 1 . #<COMPILED-FUNCTION SYSTEM::SETF-GET>) SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/places.fas\" 929 937)))") ;;GET;;
(clisp-symbol :COMMON-LISP "GET-DECODED-TIME" "(SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/defs1.fas\" 791 795)))") ;;GET-DECODED-TIME;;
(clisp-symbol :COMMON-LISP "GET-DISPATCH-MACRO-CHARACTER" "(SYSTEM::SETF-EXPANDER (-1 1 . #<COMPILED-FUNCTION SYSTEM::SETF-GET-DISPATCH-MACRO-CHARACTER>) SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/places.fas\" 1206 1210)))") ;;GET-DISPATCH-MACRO-CHARACTER;;
(clisp-symbol :COMMON-LISP "GET-INTERNAL-REAL-TIME" "NIL") ;;GET-INTERNAL-REAL-TIME;;
(clisp-symbol :COMMON-LISP "GET-INTERNAL-RUN-TIME" "NIL") ;;GET-INTERNAL-RUN-TIME;;
(clisp-symbol :COMMON-LISP "GET-MACRO-CHARACTER" "NIL") ;;GET-MACRO-CHARACTER;;
(clisp-symbol :COMMON-LISP "GET-OUTPUT-STREAM-STRING" "NIL") ;;GET-OUTPUT-STREAM-STRING;;
(clisp-symbol :COMMON-LISP "GET-PROPERTIES" "NIL") ;;GET-PROPERTIES;;
(clisp-symbol :COMMON-LISP "GET-SETF-EXPANSION" "(SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/places.fas\" 27 138)))") ;;GET-SETF-EXPANSION;;
(clisp-symbol :COMMON-LISP "GET-UNIVERSAL-TIME" "NIL") ;;GET-UNIVERSAL-TIME;;
(clisp-symbol :COMMON-LISP "GETF" "(SYSTEM::SETF-EXPANDER (-5 . #<COMPILED-FUNCTION #:SETF-GETF>) SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/places.fas\" 938 959)))") ;;GETF;;
(clisp-symbol :COMMON-LISP "GETHASH" "(SYSTEM::SETF-EXPANDER (-1 1 . #<COMPILED-FUNCTION SYSTEM::SETF-GETHASH>) SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/places.fas\" 960 966)))") ;;GETHASH;;
(clisp-symbol :COMMON-LISP "GO" "(SYSTEM::INSTRUCTION 78)") ;;GO;;
(clisp-symbol :COMMON-LISP "GRAPHIC-CHAR-P" "NIL") ;;GRAPHIC-CHAR-P;;
(clisp-symbol :COMMON-LISP "HANDLER-BIND" "(SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/condition.fas\" 550 614)))") ;;HANDLER-BIND;;
(clisp-symbol :COMMON-LISP "HANDLER-CASE" "(SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/condition.fas\" 631 697)))") ;;HANDLER-CASE;;
(clisp-symbol :COMMON-LISP "HASH-TABLE" "(CLOS::CLOSCLASS #1=#<BUILT-IN-CLASS HASH-TABLE> SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/clos-class3.fas\" 2584 2634)) SYSTEM::SUBTYPEP-DECIDE SYSTEM::SUBTYPEP-MISC SYSTEM::SUBTYPEP-SIMPLIFY-OR SYSTEM::SIMPLIFY-OR-MISC SYSTEM::SUBTYPEP-SIMPLIFY-AND SYSTEM::SIMPLIFY-AND-MISC SYSTEM::SUBTYPEP-LIST NIL SYSTEM::SUBTYPEP-ATOM (HASH-TABLE) SYSTEM::TYPE-SYMBOL #<SYSTEM-FUNCTION HASH-TABLE-P>)") ;;HASH-TABLE;;
(clisp-symbol :COMMON-LISP "HASH-TABLE-COUNT" "NIL") ;;HASH-TABLE-COUNT;;
(clisp-symbol :COMMON-LISP "HASH-TABLE-P" "NIL") ;;HASH-TABLE-P;;
(clisp-symbol :COMMON-LISP "HASH-TABLE-REHASH-SIZE" "NIL") ;;HASH-TABLE-REHASH-SIZE;;
(clisp-symbol :COMMON-LISP "HASH-TABLE-REHASH-THRESHOLD" "NIL") ;;HASH-TABLE-REHASH-THRESHOLD;;
(clisp-symbol :COMMON-LISP "HASH-TABLE-SIZE" "NIL") ;;HASH-TABLE-SIZE;;
(clisp-symbol :COMMON-LISP "HASH-TABLE-TEST" "NIL") ;;HASH-TABLE-TEST;;
(clisp-symbol :COMMON-LISP "HOST-NAMESTRING" "NIL") ;;HOST-NAMESTRING;;
(clisp-symbol :COMMON-LISP "IDENTITY" "NIL") ;;IDENTITY;;
(clisp-symbol :COMMON-LISP "IF" "(SYSTEM::SETF-EXPANDER (-5 . #<COMPILED-FUNCTION #:SETF-IF>) SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/places.fas\" 1179 1205)))") ;;IF;;
(clisp-symbol :COMMON-LISP "IGNORABLE" "NIL") ;;IGNORABLE;;
(clisp-symbol :COMMON-LISP "IGNORE" "NIL") ;;IGNORE;;
(clisp-symbol :COMMON-LISP "IGNORE-ERRORS" "(SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/condition.fas\" 616 629)))") ;;IGNORE-ERRORS;;
(clisp-symbol :COMMON-LISP "IMAGPART" "NIL") ;;IMAGPART;;
(clisp-symbol :COMMON-LISP "IMPORT" "NIL") ;;IMPORT;;
(clisp-symbol :COMMON-LISP "IN-PACKAGE" "NIL") ;;IN-PACKAGE;;
(clisp-symbol :COMMON-LISP "INCF" "(SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/places.fas\" 791 792)))") ;;INCF;;
(clisp-symbol :COMMON-LISP "INLINE" "NIL") ;;INLINE;;
(clisp-symbol :COMMON-LISP "INPUT-STREAM-P" "NIL") ;;INPUT-STREAM-P;;
(clisp-symbol :COMMON-LISP "INSPECT" "(SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/inspect.fas\" 642 662)))") ;;INSPECT;;
(clisp-symbol :COMMON-LISP "INTEGER" "(CLOS::CLOSCLASS #1=#<BUILT-IN-CLASS INTEGER> SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/clos-class3.fas\" 2584 2634)) SYSTEM::TYPE-LIST #<COMPILED-FUNCTION SYSTEM::TYPE-LIST-INTEGER> SYSTEM::TYPE-SYMBOL #<SYSTEM-FUNCTION INTEGERP>)") ;;INTEGER;;
(clisp-symbol :COMMON-LISP "INTEGER-DECODE-FLOAT" "NIL") ;;INTEGER-DECODE-FLOAT;;
(clisp-symbol :COMMON-LISP "INTEGER-LENGTH" "NIL") ;;INTEGER-LENGTH;;
(clisp-symbol :COMMON-LISP "INTEGERP" "NIL") ;;INTEGERP;;
(clisp-symbol :COMMON-LISP "INTERACTIVE-STREAM-P" "NIL") ;;INTERACTIVE-STREAM-P;;
(clisp-symbol :COMMON-LISP "INTERN" "NIL") ;;INTERN;;
(clisp-symbol :COMMON-LISP "INTERNAL-TIME-UNITS-PER-SECOND" "(SYSTEM::CONSTANT-INLINABLE CONSTANT-NOTINLINE)") ;;INTERNAL-TIME-UNITS-PER-SECOND;;
(clisp-symbol :COMMON-LISP "INTERSECTION" "(SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/defs1.fas\" 262 403)))") ;;INTERSECTION;;
(clisp-symbol :COMMON-LISP "INVOKE-DEBUGGER" "NIL") ;;INVOKE-DEBUGGER;;
(clisp-symbol :COMMON-LISP "INVOKE-RESTART" "(SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/condition.fas\" 860 864)))") ;;INVOKE-RESTART;;
(clisp-symbol :COMMON-LISP "INVOKE-RESTART-INTERACTIVELY" "(SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/condition.fas\" 876 881)))") ;;INVOKE-RESTART-INTERACTIVELY;;
(clisp-symbol :COMMON-LISP "ISQRT" "NIL") ;;ISQRT;;
(clisp-symbol :COMMON-LISP "KEYWORD" "(SYSTEM::TYPE-SYMBOL #<SYSTEM-FUNCTION KEYWORDP>)") ;;KEYWORD;;
(clisp-symbol :COMMON-LISP "KEYWORDP" "NIL") ;;KEYWORDP;;
(clisp-symbol :COMMON-LISP "LABELS" "NIL") ;;LABELS;;
(clisp-symbol :COMMON-LISP "LAMBDA" "(SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/defs2.fas\" 141 147)))") ;;LAMBDA;;
(clisp-symbol :COMMON-LISP "LAMBDA-LIST-KEYWORDS" "NIL") ;;LAMBDA-LIST-KEYWORDS;;
(clisp-symbol :COMMON-LISP "LAMBDA-PARAMETERS-LIMIT" "(SYSTEM::CONSTANT-INLINABLE CONSTANT-NOTINLINE)") ;;LAMBDA-PARAMETERS-LIMIT;;
(clisp-symbol :COMMON-LISP "LAST" "NIL") ;;LAST;;
(clisp-symbol :COMMON-LISP "LCM" "NIL") ;;LCM;;
(clisp-symbol :COMMON-LISP "LDB" "(SYSTEM::SETF-EXPANDER (-5 . #<COMPILED-FUNCTION #:SETF-LDB>) SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/places.fas\" 1015 1029)))") ;;LDB;;
(clisp-symbol :COMMON-LISP "LDB-TEST" "NIL") ;;LDB-TEST;;
(clisp-symbol :COMMON-LISP "LDIFF" "NIL") ;;LDIFF;;
(clisp-symbol :COMMON-LISP "LEAST-NEGATIVE-DOUBLE-FLOAT" "(SYSTEM::CONSTANT-INLINABLE CONSTANT-NOTINLINE)") ;;LEAST-NEGATIVE-DOUBLE-FLOAT;;
(clisp-symbol :COMMON-LISP "LEAST-NEGATIVE-LONG-FLOAT" "NIL") ;;LEAST-NEGATIVE-LONG-FLOAT;;
(clisp-symbol :COMMON-LISP "LEAST-NEGATIVE-NORMALIZED-DOUBLE-FLOAT" "(SYSTEM::CONSTANT-INLINABLE CONSTANT-NOTINLINE)") ;;LEAST-NEGATIVE-NORMALIZED-DOUBLE-FLOAT;;
(clisp-symbol :COMMON-LISP "LEAST-NEGATIVE-NORMALIZED-LONG-FLOAT" "NIL") ;;LEAST-NEGATIVE-NORMALIZED-LONG-FLOAT;;
(clisp-symbol :COMMON-LISP "LEAST-NEGATIVE-NORMALIZED-SHORT-FLOAT" "(SYSTEM::CONSTANT-INLINABLE CONSTANT-NOTINLINE)") ;;LEAST-NEGATIVE-NORMALIZED-SHORT-FLOAT;;
(clisp-symbol :COMMON-LISP "LEAST-NEGATIVE-NORMALIZED-SINGLE-FLOAT" "(SYSTEM::CONSTANT-INLINABLE CONSTANT-NOTINLINE)") ;;LEAST-NEGATIVE-NORMALIZED-SINGLE-FLOAT;;
(clisp-symbol :COMMON-LISP "LEAST-NEGATIVE-SHORT-FLOAT" "(SYSTEM::CONSTANT-INLINABLE CONSTANT-NOTINLINE)") ;;LEAST-NEGATIVE-SHORT-FLOAT;;
(clisp-symbol :COMMON-LISP "LEAST-NEGATIVE-SINGLE-FLOAT" "(SYSTEM::CONSTANT-INLINABLE CONSTANT-NOTINLINE)") ;;LEAST-NEGATIVE-SINGLE-FLOAT;;
(clisp-symbol :COMMON-LISP "LEAST-POSITIVE-DOUBLE-FLOAT" "(SYSTEM::CONSTANT-INLINABLE CONSTANT-NOTINLINE)") ;;LEAST-POSITIVE-DOUBLE-FLOAT;;
(clisp-symbol :COMMON-LISP "LEAST-POSITIVE-LONG-FLOAT" "NIL") ;;LEAST-POSITIVE-LONG-FLOAT;;
(clisp-symbol :COMMON-LISP "LEAST-POSITIVE-NORMALIZED-DOUBLE-FLOAT" "(SYSTEM::CONSTANT-INLINABLE CONSTANT-NOTINLINE)") ;;LEAST-POSITIVE-NORMALIZED-DOUBLE-FLOAT;;
(clisp-symbol :COMMON-LISP "LEAST-POSITIVE-NORMALIZED-LONG-FLOAT" "NIL") ;;LEAST-POSITIVE-NORMALIZED-LONG-FLOAT;;
(clisp-symbol :COMMON-LISP "LEAST-POSITIVE-NORMALIZED-SHORT-FLOAT" "(SYSTEM::CONSTANT-INLINABLE CONSTANT-NOTINLINE)") ;;LEAST-POSITIVE-NORMALIZED-SHORT-FLOAT;;
(clisp-symbol :COMMON-LISP "LEAST-POSITIVE-NORMALIZED-SINGLE-FLOAT" "(SYSTEM::CONSTANT-INLINABLE CONSTANT-NOTINLINE)") ;;LEAST-POSITIVE-NORMALIZED-SINGLE-FLOAT;;
(clisp-symbol :COMMON-LISP "LEAST-POSITIVE-SHORT-FLOAT" "(SYSTEM::CONSTANT-INLINABLE CONSTANT-NOTINLINE)") ;;LEAST-POSITIVE-SHORT-FLOAT;;
(clisp-symbol :COMMON-LISP "LEAST-POSITIVE-SINGLE-FLOAT" "(SYSTEM::CONSTANT-INLINABLE CONSTANT-NOTINLINE)") ;;LEAST-POSITIVE-SINGLE-FLOAT;;
(clisp-symbol :COMMON-LISP "LENGTH" "NIL") ;;LENGTH;;
(clisp-symbol :COMMON-LISP "LET" "NIL") ;;LET;;
(clisp-symbol :COMMON-LISP "LET*" "NIL") ;;LET*;;
(clisp-symbol :COMMON-LISP "LISP-IMPLEMENTATION-TYPE" "NIL") ;;LISP-IMPLEMENTATION-TYPE;;
(clisp-symbol :COMMON-LISP "LISP-IMPLEMENTATION-VERSION" "NIL") ;;LISP-IMPLEMENTATION-VERSION;;
(clisp-symbol :COMMON-LISP "LIST" "(CLOS::%METHOD-COMBINATION #<METHOD-COMBINATION LIST #x209F4A36> SYSTEM::INSTRUCTION 97 CLOS::CLOSCLASS #1=#<BUILT-IN-CLASS LIST> SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/clos-class3.fas\" 2584 2634)) SYSTEM::TYPE-SYMBOL #<SYSTEM-FUNCTION LISTP>)") ;;LIST;;
(clisp-symbol :COMMON-LISP "LIST*" "(SYSTEM::INSTRUCTION 98)") ;;LIST*;;
(clisp-symbol :COMMON-LISP "LIST-ALL-PACKAGES" "NIL") ;;LIST-ALL-PACKAGES;;
(clisp-symbol :COMMON-LISP "LIST-LENGTH" "NIL") ;;LIST-LENGTH;;
(clisp-symbol :COMMON-LISP "LISTEN" "NIL") ;;LISTEN;;
(clisp-symbol :COMMON-LISP "LISTP" "NIL") ;;LISTP;;
(clisp-symbol :COMMON-LISP "LOAD" "(SYSTEM::INSTRUCTION 4)") ;;LOAD;;
(clisp-symbol :COMMON-LISP "LOAD-LOGICAL-PATHNAME-TRANSLATIONS" "(SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/defs1.fas\" 469 536)))") ;;LOAD-LOGICAL-PATHNAME-TRANSLATIONS;;
(clisp-symbol :COMMON-LISP "LOAD-TIME-VALUE" "NIL") ;;LOAD-TIME-VALUE;;
(clisp-symbol :COMMON-LISP "LOCALLY" "(SYSTEM::SETF-EXPANDER (-5 . #<COMPILED-FUNCTION #:SETF-LOCALLY>) SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/places.fas\" 1163 1178)) SYSTEM::MACRO #<COMPILED-FUNCTION LOCALLY>)") ;;LOCALLY;;
(clisp-symbol :COMMON-LISP "LOG" "NIL") ;;LOG;;
(clisp-symbol :COMMON-LISP "LOGAND" "NIL") ;;LOGAND;;
(clisp-symbol :COMMON-LISP "LOGANDC1" "NIL") ;;LOGANDC1;;
(clisp-symbol :COMMON-LISP "LOGANDC2" "NIL") ;;LOGANDC2;;
(clisp-symbol :COMMON-LISP "LOGBITP" "NIL") ;;LOGBITP;;
(clisp-symbol :COMMON-LISP "LOGCOUNT" "NIL") ;;LOGCOUNT;;
(clisp-symbol :COMMON-LISP "LOGEQV" "NIL") ;;LOGEQV;;
(clisp-symbol :COMMON-LISP "LOGICAL-PATHNAME" "(CLOS::CLOSCLASS #1=#<BUILT-IN-CLASS LOGICAL-PATHNAME> SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/clos-class3.fas\" 2584 2634)) SYSTEM::TYPE-SYMBOL #<SYSTEM-FUNCTION SYSTEM::LOGICAL-PATHNAME-P>)") ;;LOGICAL-PATHNAME;;
(clisp-symbol :COMMON-LISP "LOGICAL-PATHNAME-TRANSLATIONS" "(SYSTEM::SETF-EXPANDER SYSTEM::SET-LOGICAL-PATHNAME-TRANSLATIONS SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/places.fas\" 1221 1223)))") ;;LOGICAL-PATHNAME-TRANSLATIONS;;
(clisp-symbol :COMMON-LISP "LOGIOR" "NIL") ;;LOGIOR;;
(clisp-symbol :COMMON-LISP "LOGNAND" "NIL") ;;LOGNAND;;
(clisp-symbol :COMMON-LISP "LOGNOR" "NIL") ;;LOGNOR;;
(clisp-symbol :COMMON-LISP "LOGNOT" "NIL") ;;LOGNOT;;
(clisp-symbol :COMMON-LISP "LOGORC1" "NIL") ;;LOGORC1;;
(clisp-symbol :COMMON-LISP "LOGORC2" "NIL") ;;LOGORC2;;
(clisp-symbol :COMMON-LISP "LOGTEST" "NIL") ;;LOGTEST;;
(clisp-symbol :COMMON-LISP "LOGXOR" "NIL") ;;LOGXOR;;
(clisp-symbol :COMMON-LISP "LONG-FLOAT" "(SYSTEM::TYPE-LIST #<COMPILED-FUNCTION SYSTEM::TYPE-LIST-LONG-FLOAT> SYSTEM::TYPE-SYMBOL #<SYSTEM-FUNCTION SYSTEM::LONG-FLOAT-P>)") ;;LONG-FLOAT;;
(clisp-symbol :COMMON-LISP "LONG-FLOAT-EPSILON" "NIL") ;;LONG-FLOAT-EPSILON;;
(clisp-symbol :COMMON-LISP "LONG-FLOAT-NEGATIVE-EPSILON" "NIL") ;;LONG-FLOAT-NEGATIVE-EPSILON;;
(clisp-symbol :COMMON-LISP "LONG-SITE-NAME" "(SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/config.fas\" 16 22)))") ;;LONG-SITE-NAME;;
(clisp-symbol :COMMON-LISP "LOOP" "(SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/loop.fas\" 1118 1125)))") ;;LOOP;;
(clisp-symbol :COMMON-LISP "LOOP-FINISH" "(SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/loop.fas\" 1126 1128)))") ;;LOOP-FINISH;;
(clisp-symbol :COMMON-LISP "LOWER-CASE-P" "NIL") ;;LOWER-CASE-P;;
(clisp-symbol :COMMON-LISP "MACHINE-INSTANCE" "NIL") ;;MACHINE-INSTANCE;;
(clisp-symbol :COMMON-LISP "MACHINE-TYPE" "NIL") ;;MACHINE-TYPE;;
(clisp-symbol :COMMON-LISP "MACHINE-VERSION" "NIL") ;;MACHINE-VERSION;;
(clisp-symbol :COMMON-LISP "MACRO-FUNCTION" "(SYSTEM::SETF-EXPANDER (-1 1 . #<COMPILED-FUNCTION SYSTEM::SETF-MACRO-FUNCTION>) SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/places.fas\" 983 991)))") ;;MACRO-FUNCTION;;
(clisp-symbol :COMMON-LISP "MACROEXPAND" "NIL") ;;MACROEXPAND;;
(clisp-symbol :COMMON-LISP "MACROEXPAND-1" "NIL") ;;MACROEXPAND-1;;
(clisp-symbol :COMMON-LISP "MACROLET" "NIL") ;;MACROLET;;
(clisp-symbol :COMMON-LISP "MAKE-ARRAY" "NIL") ;;MAKE-ARRAY;;
(clisp-symbol :COMMON-LISP "MAKE-BROADCAST-STREAM" "NIL") ;;MAKE-BROADCAST-STREAM;;
(clisp-symbol :COMMON-LISP "MAKE-CONCATENATED-STREAM" "NIL") ;;MAKE-CONCATENATED-STREAM;;
(clisp-symbol :COMMON-LISP "MAKE-CONDITION" "(SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/condition.fas\" 164 191)))") ;;MAKE-CONDITION;;
(clisp-symbol :COMMON-LISP "MAKE-DISPATCH-MACRO-CHARACTER" "NIL") ;;MAKE-DISPATCH-MACRO-CHARACTER;;
(clisp-symbol :COMMON-LISP "MAKE-ECHO-STREAM" "NIL") ;;MAKE-ECHO-STREAM;;
(clisp-symbol :COMMON-LISP "MAKE-HASH-TABLE" "NIL") ;;MAKE-HASH-TABLE;;
(clisp-symbol :COMMON-LISP "MAKE-LIST" "NIL") ;;MAKE-LIST;;
(clisp-symbol :COMMON-LISP "MAKE-PACKAGE" "NIL") ;;MAKE-PACKAGE;;
(clisp-symbol :COMMON-LISP "MAKE-PATHNAME" "NIL") ;;MAKE-PATHNAME;;
(clisp-symbol :COMMON-LISP "MAKE-RANDOM-STATE" "NIL") ;;MAKE-RANDOM-STATE;;
(clisp-symbol :COMMON-LISP "MAKE-SEQUENCE" "NIL") ;;MAKE-SEQUENCE;;
(clisp-symbol :COMMON-LISP "MAKE-STRING" "NIL") ;;MAKE-STRING;;
(clisp-symbol :COMMON-LISP "MAKE-STRING-INPUT-STREAM" "NIL") ;;MAKE-STRING-INPUT-STREAM;;
(clisp-symbol :COMMON-LISP "MAKE-STRING-OUTPUT-STREAM" "NIL") ;;MAKE-STRING-OUTPUT-STREAM;;
(clisp-symbol :COMMON-LISP "MAKE-SYMBOL" "NIL") ;;MAKE-SYMBOL;;
(clisp-symbol :COMMON-LISP "MAKE-SYNONYM-STREAM" "NIL") ;;MAKE-SYNONYM-STREAM;;
(clisp-symbol :COMMON-LISP "MAKE-TWO-WAY-STREAM" "NIL") ;;MAKE-TWO-WAY-STREAM;;
(clisp-symbol :COMMON-LISP "MAKUNBOUND" "NIL") ;;MAKUNBOUND;;
(clisp-symbol :COMMON-LISP "MAP" "NIL") ;;MAP;;
(clisp-symbol :COMMON-LISP "MAP-INTO" "NIL") ;;MAP-INTO;;
(clisp-symbol :COMMON-LISP "MAPC" "NIL") ;;MAPC;;
(clisp-symbol :COMMON-LISP "MAPCAN" "NIL") ;;MAPCAN;;
(clisp-symbol :COMMON-LISP "MAPCAR" "NIL") ;;MAPCAR;;
(clisp-symbol :COMMON-LISP "MAPCON" "NIL") ;;MAPCON;;
(clisp-symbol :COMMON-LISP "MAPHASH" "NIL") ;;MAPHASH;;
(clisp-symbol :COMMON-LISP "MAPL" "NIL") ;;MAPL;;
(clisp-symbol :COMMON-LISP "MAPLIST" "NIL") ;;MAPLIST;;
(clisp-symbol :COMMON-LISP "MASK-FIELD" "(SYSTEM::SETF-EXPANDER (-5 . #<COMPILED-FUNCTION #:SETF-MASK-FIELD>) SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/places.fas\" 1030 1044)))") ;;MASK-FIELD;;
(clisp-symbol :COMMON-LISP "MAX" "(CLOS::%METHOD-COMBINATION #<METHOD-COMBINATION MAX #x209F4AA6>)") ;;MAX;;
(clisp-symbol :COMMON-LISP "MEMBER" "NIL") ;;MEMBER;;
(clisp-symbol :COMMON-LISP "MEMBER-IF" "NIL") ;;MEMBER-IF;;
(clisp-symbol :COMMON-LISP "MEMBER-IF-NOT" "NIL") ;;MEMBER-IF-NOT;;
(clisp-symbol :COMMON-LISP "MERGE" "NIL") ;;MERGE;;
(clisp-symbol :COMMON-LISP "MERGE-PATHNAMES" "NIL") ;;MERGE-PATHNAMES;;
(clisp-symbol :COMMON-LISP "MIN" "(CLOS::%METHOD-COMBINATION #<METHOD-COMBINATION MIN #x209F4B16>)") ;;MIN;;
(clisp-symbol :COMMON-LISP "MINUSP" "NIL") ;;MINUSP;;
(clisp-symbol :COMMON-LISP "MISMATCH" "NIL") ;;MISMATCH;;
(clisp-symbol :COMMON-LISP "MOD" "(SYSTEM::TYPE-LIST #<COMPILED-FUNCTION SYSTEM::TYPE-LIST-MOD>)") ;;MOD;;
(clisp-symbol :COMMON-LISP "MOST-NEGATIVE-DOUBLE-FLOAT" "(SYSTEM::CONSTANT-INLINABLE CONSTANT-NOTINLINE)") ;;MOST-NEGATIVE-DOUBLE-FLOAT;;
(clisp-symbol :COMMON-LISP "MOST-NEGATIVE-FIXNUM" "(SYSTEM::CONSTANT-INLINABLE CONSTANT-NOTINLINE)") ;;MOST-NEGATIVE-FIXNUM;;
(clisp-symbol :COMMON-LISP "MOST-NEGATIVE-LONG-FLOAT" "NIL") ;;MOST-NEGATIVE-LONG-FLOAT;;
(clisp-symbol :COMMON-LISP "MOST-NEGATIVE-SHORT-FLOAT" "(SYSTEM::CONSTANT-INLINABLE CONSTANT-NOTINLINE)") ;;MOST-NEGATIVE-SHORT-FLOAT;;
(clisp-symbol :COMMON-LISP "MOST-NEGATIVE-SINGLE-FLOAT" "(SYSTEM::CONSTANT-INLINABLE CONSTANT-NOTINLINE)") ;;MOST-NEGATIVE-SINGLE-FLOAT;;
(clisp-symbol :COMMON-LISP "MOST-POSITIVE-DOUBLE-FLOAT" "(SYSTEM::CONSTANT-INLINABLE CONSTANT-NOTINLINE)") ;;MOST-POSITIVE-DOUBLE-FLOAT;;
(clisp-symbol :COMMON-LISP "MOST-POSITIVE-FIXNUM" "(SYSTEM::CONSTANT-INLINABLE CONSTANT-NOTINLINE)") ;;MOST-POSITIVE-FIXNUM;;
(clisp-symbol :COMMON-LISP "MOST-POSITIVE-LONG-FLOAT" "NIL") ;;MOST-POSITIVE-LONG-FLOAT;;
(clisp-symbol :COMMON-LISP "MOST-POSITIVE-SHORT-FLOAT" "(SYSTEM::CONSTANT-INLINABLE CONSTANT-NOTINLINE)") ;;MOST-POSITIVE-SHORT-FLOAT;;
(clisp-symbol :COMMON-LISP "MOST-POSITIVE-SINGLE-FLOAT" "(SYSTEM::CONSTANT-INLINABLE CONSTANT-NOTINLINE)") ;;MOST-POSITIVE-SINGLE-FLOAT;;
(clisp-symbol :COMMON-LISP "MUFFLE-WARNING" "(SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/condition.fas\" 1158 1160)))") ;;MUFFLE-WARNING;;
(clisp-symbol :COMMON-LISP "MULTIPLE-VALUE-BIND" "(SYSTEM::MACRO #<COMPILED-FUNCTION MULTIPLE-VALUE-BIND>)") ;;MULTIPLE-VALUE-BIND;;
(clisp-symbol :COMMON-LISP "MULTIPLE-VALUE-CALL" "NIL") ;;MULTIPLE-VALUE-CALL;;
(clisp-symbol :COMMON-LISP "MULTIPLE-VALUE-LIST" "(SYSTEM::MACRO #<COMPILED-FUNCTION MULTIPLE-VALUE-LIST>)") ;;MULTIPLE-VALUE-LIST;;
(clisp-symbol :COMMON-LISP "MULTIPLE-VALUE-PROG1" "NIL") ;;MULTIPLE-VALUE-PROG1;;
(clisp-symbol :COMMON-LISP "MULTIPLE-VALUE-SETQ" "(SYSTEM::MACRO #<COMPILED-FUNCTION MULTIPLE-VALUE-SETQ>)") ;;MULTIPLE-VALUE-SETQ;;
(clisp-symbol :COMMON-LISP "MULTIPLE-VALUES-LIMIT" "NIL") ;;MULTIPLE-VALUES-LIMIT;;
(clisp-symbol :COMMON-LISP "NAME-CHAR" "NIL") ;;NAME-CHAR;;
(clisp-symbol :COMMON-LISP "NAMESTRING" "NIL") ;;NAMESTRING;;
(clisp-symbol :COMMON-LISP "NBUTLAST" "NIL") ;;NBUTLAST;;
(clisp-symbol :COMMON-LISP "NCONC" "(CLOS::%METHOD-COMBINATION #<METHOD-COMBINATION NCONC #x209F4B86>)") ;;NCONC;;
(clisp-symbol :COMMON-LISP "NIL" "(SYSTEM::INSTRUCTION 0 SYSTEM::TYPE-SYMBOL #<COMPILED-FUNCTION SYSTEM::TYPE-SYMBOL-NIL>)") ;;NIL;;
(clisp-symbol :COMMON-LISP "NINTERSECTION" "(SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/defs1.fas\" 262 403)))") ;;NINTERSECTION;;
(clisp-symbol :COMMON-LISP "NINTH" "(SYSTEM::SETF-EXPANDER (-1 1 . #<COMPILED-FUNCTION SYSTEM::SETF-NINTH>) SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/places.fas\" 548 548)))") ;;NINTH;;
(clisp-symbol :COMMON-LISP "NOT" "(SYSTEM::INSTRUCTION 89)") ;;NOT;;
(clisp-symbol :COMMON-LISP "NOTANY" "NIL") ;;NOTANY;;
(clisp-symbol :COMMON-LISP "NOTEVERY" "NIL") ;;NOTEVERY;;
(clisp-symbol :COMMON-LISP "NOTINLINE" "NIL") ;;NOTINLINE;;
(clisp-symbol :COMMON-LISP "NRECONC" "NIL") ;;NRECONC;;
(clisp-symbol :COMMON-LISP "NREVERSE" "NIL") ;;NREVERSE;;
(clisp-symbol :COMMON-LISP "NSET-DIFFERENCE" "(SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/defs1.fas\" 262 403)))") ;;NSET-DIFFERENCE;;
(clisp-symbol :COMMON-LISP "NSET-EXCLUSIVE-OR" "(SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/defs1.fas\" 262 403)))") ;;NSET-EXCLUSIVE-OR;;
(clisp-symbol :COMMON-LISP "NSET-EXCLUSIVE-OR-1" "NIL") ;;COMMON-LISP::NSET-EXCLUSIVE-OR-1;;
(clisp-symbol :COMMON-LISP "NSET-EXCLUSIVE-OR-2" "NIL") ;;COMMON-LISP::NSET-EXCLUSIVE-OR-2;;
(clisp-symbol :COMMON-LISP "NSTRING-CAPITALIZE" "NIL") ;;NSTRING-CAPITALIZE;;
(clisp-symbol :COMMON-LISP "NSTRING-DOWNCASE" "NIL") ;;NSTRING-DOWNCASE;;
(clisp-symbol :COMMON-LISP "NSTRING-UPCASE" "NIL") ;;NSTRING-UPCASE;;
(clisp-symbol :COMMON-LISP "NSUBLIS" "NIL") ;;NSUBLIS;;
(clisp-symbol :COMMON-LISP "NSUBST" "NIL") ;;NSUBST;;
(clisp-symbol :COMMON-LISP "NSUBST-IF" "NIL") ;;NSUBST-IF;;
(clisp-symbol :COMMON-LISP "NSUBST-IF-NOT" "NIL") ;;NSUBST-IF-NOT;;
(clisp-symbol :COMMON-LISP "NSUBSTITUTE" "NIL") ;;NSUBSTITUTE;;
(clisp-symbol :COMMON-LISP "NSUBSTITUTE-IF" "NIL") ;;NSUBSTITUTE-IF;;
(clisp-symbol :COMMON-LISP "NSUBSTITUTE-IF-NOT" "NIL") ;;NSUBSTITUTE-IF-NOT;;
(clisp-symbol :COMMON-LISP "NTH" "(SYSTEM::SETF-EXPANDER SYSTEM::%SETNTH SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/places.fas\" 535 535)))") ;;NTH;;
(clisp-symbol :COMMON-LISP "NTH-VALUE" "(SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/macros2.fas\" 235 260)))") ;;NTH-VALUE;;
(clisp-symbol :COMMON-LISP "NTHCDR" "NIL") ;;NTHCDR;;
(clisp-symbol :COMMON-LISP "NULL" "(CLOS::CLOSCLASS #1=#<BUILT-IN-CLASS NULL> SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/clos-class3.fas\" 2584 2634)) SYSTEM::TYPE-SYMBOL #<SYSTEM-FUNCTION NULL>)") ;;NULL;;
(clisp-symbol :COMMON-LISP "NUMBER" "(CLOS::CLOSCLASS #1=#<BUILT-IN-CLASS NUMBER> SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/clos-class3.fas\" 2584 2634)) SYSTEM::TYPE-SYMBOL #<SYSTEM-FUNCTION NUMBERP>)") ;;NUMBER;;
(clisp-symbol :COMMON-LISP "NUMBERP" "NIL") ;;NUMBERP;;
(clisp-symbol :COMMON-LISP "NUMERATOR" "NIL") ;;NUMERATOR;;
(clisp-symbol :COMMON-LISP "NUNION" "(SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/defs1.fas\" 262 403)))") ;;NUNION;;
(clisp-symbol :COMMON-LISP "ODDP" "NIL") ;;ODDP;;
(clisp-symbol :COMMON-LISP "OPEN" "NIL") ;;OPEN;;
(clisp-symbol :COMMON-LISP "OPEN-STREAM-P" "NIL") ;;OPEN-STREAM-P;;
(clisp-symbol :COMMON-LISP "OPTIMIZE" "NIL") ;;OPTIMIZE;;
(clisp-symbol :COMMON-LISP "OR" "(CLOS::%METHOD-COMBINATION #<METHOD-COMBINATION OR #x209F4BEE> SYSTEM::MACRO #<COMPILED-FUNCTION OR>)") ;;OR;;
(clisp-symbol :COMMON-LISP "OTHERWISE" "NIL") ;;OTHERWISE;;
(clisp-symbol :COMMON-LISP "OUTPUT-STREAM-P" "NIL") ;;OUTPUT-STREAM-P;;
(clisp-symbol :COMMON-LISP "PACKAGE" "(CLOS::CLOSCLASS #1=#<BUILT-IN-CLASS PACKAGE> SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/clos-class3.fas\" 2584 2634)) SYSTEM::SUBTYPEP-DECIDE SYSTEM::SUBTYPEP-MISC SYSTEM::SUBTYPEP-SIMPLIFY-OR SYSTEM::SIMPLIFY-OR-MISC SYSTEM::SUBTYPEP-SIMPLIFY-AND SYSTEM::SIMPLIFY-AND-MISC SYSTEM::SUBTYPEP-LIST NIL SYSTEM::SUBTYPEP-ATOM (PACKAGE) SYSTEM::TYPE-SYMBOL #<SYSTEM-FUNCTION PACKAGEP>)") ;;PACKAGE;;
(clisp-symbol :COMMON-LISP "PACKAGE-ERROR" "(CLOS::CLOSCLASS #1=#<STANDARD-CLASS PACKAGE-ERROR> SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/condition.fas\" 393 397)))") ;;PACKAGE-ERROR;;
(clisp-symbol :COMMON-LISP "PACKAGE-ERROR-PACKAGE" "NIL") ;;PACKAGE-ERROR-PACKAGE;;
(clisp-symbol :COMMON-LISP "PACKAGE-NAME" "NIL") ;;PACKAGE-NAME;;
(clisp-symbol :COMMON-LISP "PACKAGE-NICKNAMES" "NIL") ;;PACKAGE-NICKNAMES;;
(clisp-symbol :COMMON-LISP "PACKAGE-SHADOWING-SYMBOLS" "NIL") ;;PACKAGE-SHADOWING-SYMBOLS;;
(clisp-symbol :COMMON-LISP "PACKAGE-USE-LIST" "NIL") ;;PACKAGE-USE-LIST;;
(clisp-symbol :COMMON-LISP "PACKAGE-USED-BY-LIST" "NIL") ;;PACKAGE-USED-BY-LIST;;
(clisp-symbol :COMMON-LISP "PACKAGEP" "NIL") ;;PACKAGEP;;
(clisp-symbol :COMMON-LISP "PAIRLIS" "NIL") ;;PAIRLIS;;
(clisp-symbol :COMMON-LISP "PARSE-ERROR" "(CLOS::CLOSCLASS #1=#<STANDARD-CLASS PARSE-ERROR> SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/condition.fas\" 403 404)))") ;;PARSE-ERROR;;
(clisp-symbol :COMMON-LISP "PARSE-INTEGER" "NIL") ;;PARSE-INTEGER;;
(clisp-symbol :COMMON-LISP "PARSE-NAMESTRING" "NIL") ;;PARSE-NAMESTRING;;
(clisp-symbol :COMMON-LISP "PATHNAME" "(CLOS::CLOSCLASS #1=#<BUILT-IN-CLASS PATHNAME> SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/clos-class3.fas\" 2584 2634)) SYSTEM::SUBTYPEP-DECIDE SYSTEM::SUBTYPEP-PATHNAME SYSTEM::SUBTYPEP-SIMPLIFY-OR SYSTEM::SIMPLIFY-OR-PATHNAME SYSTEM::SUBTYPEP-SIMPLIFY-AND SYSTEM::SIMPLIFY-AND-PATHNAME SYSTEM::SUBTYPEP-LIST NIL SYSTEM::SUBTYPEP-ATOM (PATHNAME LOGICAL-PATHNAME) SYSTEM::TYPE-SYMBOL #<SYSTEM-FUNCTION PATHNAMEP>)") ;;PATHNAME;;
(clisp-symbol :COMMON-LISP "PATHNAME-DEVICE" "NIL") ;;PATHNAME-DEVICE;;
(clisp-symbol :COMMON-LISP "PATHNAME-DIRECTORY" "NIL") ;;PATHNAME-DIRECTORY;;
(clisp-symbol :COMMON-LISP "PATHNAME-HOST" "NIL") ;;PATHNAME-HOST;;
(clisp-symbol :COMMON-LISP "PATHNAME-MATCH-P" "NIL") ;;PATHNAME-MATCH-P;;
(clisp-symbol :COMMON-LISP "PATHNAME-NAME" "NIL") ;;PATHNAME-NAME;;
(clisp-symbol :COMMON-LISP "PATHNAME-TYPE" "NIL") ;;PATHNAME-TYPE;;
(clisp-symbol :COMMON-LISP "PATHNAME-VERSION" "NIL") ;;PATHNAME-VERSION;;
(clisp-symbol :COMMON-LISP "PATHNAMEP" "NIL") ;;PATHNAMEP;;
(clisp-symbol :COMMON-LISP "PEEK-CHAR" "NIL") ;;PEEK-CHAR;;
(clisp-symbol :COMMON-LISP "PHASE" "NIL") ;;PHASE;;
(clisp-symbol :COMMON-LISP "PI" "NIL") ;;PI;;
(clisp-symbol :COMMON-LISP "PLUSP" "NIL") ;;PLUSP;;
(clisp-symbol :COMMON-LISP "POP" "(SYSTEM::INSTRUCTION 21 SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/places.fas\" 592 635)))") ;;POP;;
(clisp-symbol :COMMON-LISP "POSITION" "NIL") ;;POSITION;;
(clisp-symbol :COMMON-LISP "POSITION-IF" "NIL") ;;POSITION-IF;;
(clisp-symbol :COMMON-LISP "POSITION-IF-NOT" "NIL") ;;POSITION-IF-NOT;;
(clisp-symbol :COMMON-LISP "PPRINT" "NIL") ;;PPRINT;;
(clisp-symbol :COMMON-LISP "PPRINT-DISPATCH" "(SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/pprint.fas\" 43 58)))") ;;PPRINT-DISPATCH;;
(clisp-symbol :COMMON-LISP "PPRINT-EXIT-IF-LIST-EXHAUSTED" "NIL") ;;PPRINT-EXIT-IF-LIST-EXHAUSTED;;
(clisp-symbol :COMMON-LISP "PPRINT-FILL" "(SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/pprint.fas\" 193 207)))") ;;PPRINT-FILL;;
(clisp-symbol :COMMON-LISP "PPRINT-FILL-1" "NIL") ;;COMMON-LISP::PPRINT-FILL-1;;
(clisp-symbol :COMMON-LISP "PPRINT-INDENT" "NIL") ;;PPRINT-INDENT;;
(clisp-symbol :COMMON-LISP "PPRINT-LINEAR" "(SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/pprint.fas\" 209 221)))") ;;PPRINT-LINEAR;;
(clisp-symbol :COMMON-LISP "PPRINT-LINEAR-1" "NIL") ;;COMMON-LISP::PPRINT-LINEAR-1;;
(clisp-symbol :COMMON-LISP "PPRINT-LOGICAL-BLOCK" "(SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/pprint.fas\" 103 161)))") ;;PPRINT-LOGICAL-BLOCK;;
(clisp-symbol :COMMON-LISP "PPRINT-NEWLINE" "NIL") ;;PPRINT-NEWLINE;;
(clisp-symbol :COMMON-LISP "PPRINT-POP" "NIL") ;;PPRINT-POP;;
(clisp-symbol :COMMON-LISP "PPRINT-TAB" "(SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/pprint.fas\" 177 191)))") ;;PPRINT-TAB;;
(clisp-symbol :COMMON-LISP "PPRINT-TABULAR" "(SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/pprint.fas\" 223 239)))") ;;PPRINT-TABULAR;;
(clisp-symbol :COMMON-LISP "PPRINT-TABULAR-1" "NIL") ;;COMMON-LISP::PPRINT-TABULAR-1;;
(clisp-symbol :COMMON-LISP "PRIN1" "NIL") ;;PRIN1;;
(clisp-symbol :COMMON-LISP "PRIN1-TO-STRING" "NIL") ;;PRIN1-TO-STRING;;
(clisp-symbol :COMMON-LISP "PRINC" "NIL") ;;PRINC;;
(clisp-symbol :COMMON-LISP "PRINC-TO-STRING" "NIL") ;;PRINC-TO-STRING;;
(clisp-symbol :COMMON-LISP "PRINT" "NIL") ;;PRINT;;
(clisp-symbol :COMMON-LISP "PRINT-NOT-READABLE" "(CLOS::CLOSCLASS #1=#<STANDARD-CLASS PRINT-NOT-READABLE> SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/condition.fas\" 399 401)))") ;;PRINT-NOT-READABLE;;
(clisp-symbol :COMMON-LISP "PRINT-NOT-READABLE-OBJECT" "NIL") ;;PRINT-NOT-READABLE-OBJECT;;
(clisp-symbol :COMMON-LISP "PRINT-UNREADABLE-OBJECT" "(SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/macros2.fas\" 345 352)))") ;;PRINT-UNREADABLE-OBJECT;;
(clisp-symbol :COMMON-LISP "PROBE-FILE" "NIL") ;;PROBE-FILE;;
(clisp-symbol :COMMON-LISP "PROCLAIM" "NIL") ;;PROCLAIM;;
(clisp-symbol :COMMON-LISP "PROG" "(SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/macros1.fas\" 314 321)))") ;;PROG;;
(clisp-symbol :COMMON-LISP "PROG*" "(SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/macros1.fas\" 323 330)))") ;;PROG*;;
(clisp-symbol :COMMON-LISP "PROG1" "(SYSTEM::MACRO #<COMPILED-FUNCTION PROG1>)") ;;PROG1;;
(clisp-symbol :COMMON-LISP "PROG2" "(SYSTEM::MACRO #<COMPILED-FUNCTION PROG2>)") ;;PROG2;;
(clisp-symbol :COMMON-LISP "PROGN" "(CLOS::%METHOD-COMBINATION #<METHOD-COMBINATION PROGN #x209F4C5E> SYSTEM::SETF-EXPANDER (-5 . #<COMPILED-FUNCTION #:SETF-PROGN>) SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/places.fas\" 1145 1162)))") ;;PROGN;;
(clisp-symbol :COMMON-LISP "PROGRAM-ERROR" "(CLOS::CLOSCLASS #1=#<STANDARD-CLASS PROGRAM-ERROR> SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/condition.fas\" 325 326)))") ;;PROGRAM-ERROR;;
(clisp-symbol :COMMON-LISP "PROGV" "(SYSTEM::INSTRUCTION 19)") ;;PROGV;;
(clisp-symbol :COMMON-LISP "PROVIDE" "(SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/defs1.fas\" 160 161)))") ;;PROVIDE;;
(clisp-symbol :COMMON-LISP "PSETF" "(SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/places.fas\" 636 653)))") ;;PSETF;;
(clisp-symbol :COMMON-LISP "PSETF-RECURSE" "NIL") ;;COMMON-LISP::PSETF-RECURSE;;
(clisp-symbol :COMMON-LISP "PSETQ" "(SYSTEM::MACRO #<COMPILED-FUNCTION PSETQ>)") ;;PSETQ;;
(clisp-symbol :COMMON-LISP "PUSH" "(SYSTEM::INSTRUCTION 20 SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/places.fas\" 321 344)))") ;;PUSH;;
(clisp-symbol :COMMON-LISP "PUSHNEW" "(SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/places.fas\" 654 677)))") ;;PUSHNEW;;
(clisp-symbol :COMMON-LISP "QUOTE" "NIL") ;;QUOTE;;
(clisp-symbol :COMMON-LISP "RANDOM" "NIL") ;;RANDOM;;
(clisp-symbol :COMMON-LISP "RANDOM-STATE" "(CLOS::CLOSCLASS #1=#<BUILT-IN-CLASS RANDOM-STATE> SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/clos-class3.fas\" 2584 2634)) SYSTEM::SUBTYPEP-DECIDE SYSTEM::SUBTYPEP-MISC SYSTEM::SUBTYPEP-SIMPLIFY-OR SYSTEM::SIMPLIFY-OR-MISC SYSTEM::SUBTYPEP-SIMPLIFY-AND SYSTEM::SIMPLIFY-AND-MISC SYSTEM::SUBTYPEP-LIST NIL SYSTEM::SUBTYPEP-ATOM (RANDOM-STATE) SYSTEM::TYPE-SYMBOL #<SYSTEM-FUNCTION RANDOM-STATE-P>)") ;;RANDOM-STATE;;
(clisp-symbol :COMMON-LISP "RANDOM-STATE-P" "NIL") ;;RANDOM-STATE-P;;
(clisp-symbol :COMMON-LISP "RASSOC" "NIL") ;;RASSOC;;
(clisp-symbol :COMMON-LISP "RASSOC-IF" "NIL") ;;RASSOC-IF;;
(clisp-symbol :COMMON-LISP "RASSOC-IF-NOT" "NIL") ;;RASSOC-IF-NOT;;
(clisp-symbol :COMMON-LISP "RATIO" "(CLOS::CLOSCLASS #1=#<BUILT-IN-CLASS RATIO> SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/clos-class3.fas\" 2584 2634)) SYSTEM::TYPE-SYMBOL #<COMPILED-FUNCTION SYSTEM::TYPE-SYMBOL-RATIO>)") ;;RATIO;;
(clisp-symbol :COMMON-LISP "RATIONAL" "(CLOS::CLOSCLASS #1=#<BUILT-IN-CLASS RATIONAL> SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/clos-class3.fas\" 2584 2634)) SYSTEM::TYPE-LIST #<COMPILED-FUNCTION SYSTEM::TYPE-LIST-RATIONAL> SYSTEM::TYPE-SYMBOL #<SYSTEM-FUNCTION RATIONALP>)") ;;RATIONAL;;
(clisp-symbol :COMMON-LISP "RATIONALIZE" "NIL") ;;RATIONALIZE;;
(clisp-symbol :COMMON-LISP "RATIONALP" "NIL") ;;RATIONALP;;
(clisp-symbol :COMMON-LISP "READ" "NIL") ;;READ;;
(clisp-symbol :COMMON-LISP "READ-BYTE" "NIL") ;;READ-BYTE;;
(clisp-symbol :COMMON-LISP "READ-CHAR" "NIL") ;;READ-CHAR;;
(clisp-symbol :COMMON-LISP "READ-CHAR-NO-HANG" "NIL") ;;READ-CHAR-NO-HANG;;
(clisp-symbol :COMMON-LISP "READ-DELIMITED-LIST" "NIL") ;;READ-DELIMITED-LIST;;
(clisp-symbol :COMMON-LISP "READ-FROM-STRING" "NIL") ;;READ-FROM-STRING;;
(clisp-symbol :COMMON-LISP "READ-LINE" "NIL") ;;READ-LINE;;
(clisp-symbol :COMMON-LISP "READ-PRESERVING-WHITESPACE" "NIL") ;;READ-PRESERVING-WHITESPACE;;
(clisp-symbol :COMMON-LISP "READ-SEQUENCE" "(SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/defs2.fas\" 238 250)))") ;;READ-SEQUENCE;;
(clisp-symbol :COMMON-LISP "READER-ERROR" "(CLOS::CLOSCLASS #1=#<STANDARD-CLASS READER-ERROR> SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/condition.fas\" 413 414)))") ;;READER-ERROR;;
(clisp-symbol :COMMON-LISP "READTABLE" "(CLOS::CLOSCLASS #1=#<BUILT-IN-CLASS READTABLE> SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/clos-class3.fas\" 2584 2634)) SYSTEM::SUBTYPEP-DECIDE SYSTEM::SUBTYPEP-MISC SYSTEM::SUBTYPEP-SIMPLIFY-OR SYSTEM::SIMPLIFY-OR-MISC SYSTEM::SUBTYPEP-SIMPLIFY-AND SYSTEM::SIMPLIFY-AND-MISC SYSTEM::SUBTYPEP-LIST NIL SYSTEM::SUBTYPEP-ATOM (READTABLE) SYSTEM::TYPE-SYMBOL #<SYSTEM-FUNCTION READTABLEP>)") ;;READTABLE;;
(clisp-symbol :COMMON-LISP "READTABLE-CASE" "(SYSTEM::SETF-EXPANDER SYSTEM::SET-READTABLE-CASE SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/places.fas\" 969 970)))") ;;READTABLE-CASE;;
(clisp-symbol :COMMON-LISP "READTABLEP" "NIL") ;;READTABLEP;;
(clisp-symbol :COMMON-LISP "REAL" "(CLOS::CLOSCLASS #1=#<BUILT-IN-CLASS REAL> SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/clos-class3.fas\" 2584 2634)) SYSTEM::SUBTYPEP-DECIDE SYSTEM::SUBTYPEP-REAL SYSTEM::SUBTYPEP-SIMPLIFY-OR SYSTEM::SIMPLIFY-OR-REAL SYSTEM::SUBTYPEP-SIMPLIFY-AND SYSTEM::SIMPLIFY-AND-REAL SYSTEM::SUBTYPEP-LIST (SYSTEM::INTERVALS) SYSTEM::SUBTYPEP-ATOM (REAL RATIONAL INTEGER FLOAT SHORT-FLOAT SINGLE-FLOAT DOUBLE-FLOAT LONG-FLOAT) SYSTEM::TYPE-LIST #<COMPILED-FUNCTION SYSTEM::TYPE-LIST-REAL> SYSTEM::TYPE-SYMBOL #<SYSTEM-FUNCTION REALP>)") ;;REAL;;
(clisp-symbol :COMMON-LISP "REALP" "NIL") ;;REALP;;
(clisp-symbol :COMMON-LISP "REALPART" "NIL") ;;REALPART;;
(clisp-symbol :COMMON-LISP "REDUCE" "NIL") ;;REDUCE;;
(clisp-symbol :COMMON-LISP "REM" "NIL") ;;REM;;
(clisp-symbol :COMMON-LISP "REMF" "(SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/places.fas\" 678 696)))") ;;REMF;;
(clisp-symbol :COMMON-LISP "REMHASH" "NIL") ;;REMHASH;;
(clisp-symbol :COMMON-LISP "REMOVE" "NIL") ;;REMOVE;;
(clisp-symbol :COMMON-LISP "REMOVE-DUPLICATES" "NIL") ;;REMOVE-DUPLICATES;;
(clisp-symbol :COMMON-LISP "REMOVE-IF" "NIL") ;;REMOVE-IF;;
(clisp-symbol :COMMON-LISP "REMOVE-IF-NOT" "NIL") ;;REMOVE-IF-NOT;;
(clisp-symbol :COMMON-LISP "REMPROP" "NIL") ;;REMPROP;;
(clisp-symbol :COMMON-LISP "RENAME-FILE" "NIL") ;;RENAME-FILE;;
(clisp-symbol :COMMON-LISP "RENAME-PACKAGE" "NIL") ;;RENAME-PACKAGE;;
(clisp-symbol :COMMON-LISP "REPLACE" "NIL") ;;REPLACE;;
(clisp-symbol :COMMON-LISP "REQUIRE" "(SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/defs1.fas\" 163 175)))") ;;REQUIRE;;
(clisp-symbol :COMMON-LISP "REST" "(SYSTEM::SETF-EXPANDER SYSTEM::%RPLACD SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/places.fas\" 538 539)))") ;;REST;;
(clisp-symbol :COMMON-LISP "RESTART" "(CLOS::CLOSCLASS #1=#<STRUCTURE-CLASS RESTART> SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/condition.fas\" 714 729)))") ;;RESTART;;
(clisp-symbol :COMMON-LISP "RESTART-BIND" "(SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/condition.fas\" 883 943)))") ;;RESTART-BIND;;
(clisp-symbol :COMMON-LISP "RESTART-BIND-1" "NIL") ;;COMMON-LISP::RESTART-BIND-1;;
(clisp-symbol :COMMON-LISP "RESTART-CASE" "(SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/condition.fas\" 1106 1109)))") ;;RESTART-CASE;;
(clisp-symbol :COMMON-LISP "RESTART-NAME" "(SYSTEM::DEFSTRUCT-WRITER RESTART SYSTEM::DEFSTRUCT-READER RESTART SYSTEM::INLINE-EXPANSION ((SYSTEM::OBJECT) (DECLARE (SYSTEM::IN-DEFUN RESTART-NAME)) (BLOCK RESTART-NAME (THE T (SYSTEM::%STRUCTURE-REF 'RESTART SYSTEM::OBJECT 1)))) SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/condition.fas\" 714 729)) SYSTEM::INLINABLE INLINE SYSTEM::SETF-FUNCTION COMMON-LISP::|(SETF COMMON-LISP:RESTART-NAME)|)") ;;RESTART-NAME;;
(clisp-symbol :COMMON-LISP "RETURN" "(SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/macros1.fas\" 132 133)))") ;;RETURN;;
(clisp-symbol :COMMON-LISP "RETURN-FROM" "(SYSTEM::INSTRUCTION 73)") ;;RETURN-FROM;;
(clisp-symbol :COMMON-LISP "REVAPPEND" "NIL") ;;REVAPPEND;;
(clisp-symbol :COMMON-LISP "REVERSE" "NIL") ;;REVERSE;;
(clisp-symbol :COMMON-LISP "ROOM" "(SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/room.fas\" 15 65)))") ;;ROOM;;
(clisp-symbol :COMMON-LISP "ROTATEF" "(SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/places.fas\" 715 742)))") ;;ROTATEF;;
(clisp-symbol :COMMON-LISP "ROUND" "NIL") ;;ROUND;;
(clisp-symbol :COMMON-LISP "ROW-MAJOR-AREF" "(SYSTEM::SETF-EXPANDER SYSTEM::ROW-MAJOR-STORE SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/places.fas\" 583 583)))") ;;ROW-MAJOR-AREF;;
(clisp-symbol :COMMON-LISP "RPLACA" "NIL") ;;RPLACA;;
(clisp-symbol :COMMON-LISP "RPLACD" "NIL") ;;RPLACD;;
(clisp-symbol :COMMON-LISP "SAFETY" "NIL") ;;SAFETY;;
(clisp-symbol :COMMON-LISP "SATISFIES" "NIL") ;;SATISFIES;;
(clisp-symbol :COMMON-LISP "SBIT" "(SYSTEM::SETF-EXPANDER SYSTEM::STORE SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/places.fas\" 996 996)))") ;;SBIT;;
(clisp-symbol :COMMON-LISP "SCALE-FLOAT" "NIL") ;;SCALE-FLOAT;;
(clisp-symbol :COMMON-LISP "SCHAR" "(SYSTEM::SETF-EXPANDER SYSTEM::STORE-SCHAR SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/places.fas\" 994 994)))") ;;SCHAR;;
(clisp-symbol :COMMON-LISP "SEARCH" "NIL") ;;SEARCH;;
(clisp-symbol :COMMON-LISP "SECOND" "(SYSTEM::SETF-EXPANDER (-1 1 . #<COMPILED-FUNCTION SYSTEM::SETF-SECOND>) SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/places.fas\" 541 541)))") ;;SECOND;;
(clisp-symbol :COMMON-LISP "SEQUENCE" "(CLOS::CLOSCLASS #1=#<BUILT-IN-CLASS SEQUENCE> SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/clos-class3.fas\" 2584 2634)) SYSTEM::TYPE-SYMBOL #<SYSTEM-FUNCTION SYSTEM::SEQUENCEP>)") ;;SEQUENCE;;
(clisp-symbol :COMMON-LISP "SERIOUS-CONDITION" "(CLOS::CLOSCLASS #1=#<STANDARD-CLASS SERIOUS-CONDITION> SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/condition.fas\" 241 320)))") ;;SERIOUS-CONDITION;;
(clisp-symbol :COMMON-LISP "SET" "NIL") ;;SET;;
(clisp-symbol :COMMON-LISP "SET-DIFFERENCE" "(SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/defs1.fas\" 262 403)))") ;;SET-DIFFERENCE;;
(clisp-symbol :COMMON-LISP "SET-DISPATCH-MACRO-CHARACTER" "NIL") ;;SET-DISPATCH-MACRO-CHARACTER;;
(clisp-symbol :COMMON-LISP "SET-EXCLUSIVE-OR" "(SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/defs1.fas\" 262 403)))") ;;SET-EXCLUSIVE-OR;;
(clisp-symbol :COMMON-LISP "SET-EXCLUSIVE-OR-1" "NIL") ;;COMMON-LISP::SET-EXCLUSIVE-OR-1;;
(clisp-symbol :COMMON-LISP "SET-EXCLUSIVE-OR-2" "NIL") ;;COMMON-LISP::SET-EXCLUSIVE-OR-2;;
(clisp-symbol :COMMON-LISP "SET-MACRO-CHARACTER" "NIL") ;;SET-MACRO-CHARACTER;;
(clisp-symbol :COMMON-LISP "SET-PPRINT-DISPATCH" "(SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/pprint.fas\" 73 101)))") ;;SET-PPRINT-DISPATCH;;
(clisp-symbol :COMMON-LISP "SET-SYNTAX-FROM-CHAR" "NIL") ;;SET-SYNTAX-FROM-CHAR;;
(clisp-symbol :COMMON-LISP "SETF" "(SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/places.fas\" 793 893)))") ;;SETF;;
(clisp-symbol :COMMON-LISP "SETQ" "NIL") ;;SETQ;;
(clisp-symbol :COMMON-LISP "SEVENTH" "(SYSTEM::SETF-EXPANDER (-1 1 . #<COMPILED-FUNCTION SYSTEM::SETF-SEVENTH>) SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/places.fas\" 546 546)))") ;;SEVENTH;;
(clisp-symbol :COMMON-LISP "SHADOW" "NIL") ;;SHADOW;;
(clisp-symbol :COMMON-LISP "SHADOWING-IMPORT" "NIL") ;;SHADOWING-IMPORT;;
(clisp-symbol :COMMON-LISP "SHIFTF" "(SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/places.fas\" 894 928)))") ;;SHIFTF;;
(clisp-symbol :COMMON-LISP "SHORT-FLOAT" "(SYSTEM::TYPE-LIST #<COMPILED-FUNCTION SYSTEM::TYPE-LIST-SHORT-FLOAT> SYSTEM::TYPE-SYMBOL #<SYSTEM-FUNCTION SYSTEM::SHORT-FLOAT-P>)") ;;SHORT-FLOAT;;
(clisp-symbol :COMMON-LISP "SHORT-FLOAT-EPSILON" "(SYSTEM::CONSTANT-INLINABLE CONSTANT-NOTINLINE)") ;;SHORT-FLOAT-EPSILON;;
(clisp-symbol :COMMON-LISP "SHORT-FLOAT-NEGATIVE-EPSILON" "(SYSTEM::CONSTANT-INLINABLE CONSTANT-NOTINLINE)") ;;SHORT-FLOAT-NEGATIVE-EPSILON;;
(clisp-symbol :COMMON-LISP "SHORT-SITE-NAME" "(SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/config.fas\" 8 14)))") ;;SHORT-SITE-NAME;;
(clisp-symbol :COMMON-LISP "SIGNAL" "NIL") ;;SIGNAL;;
(clisp-symbol :COMMON-LISP "SIGNED-BYTE" "(SYSTEM::TYPE-LIST #<COMPILED-FUNCTION SYSTEM::TYPE-LIST-SIGNED-BYTE>)") ;;SIGNED-BYTE;;
(clisp-symbol :COMMON-LISP "SIGNUM" "NIL") ;;SIGNUM;;
(clisp-symbol :COMMON-LISP "SIMPLE-ARRAY" "(SYSTEM::TYPE-LIST #<COMPILED-FUNCTION SYSTEM::TYPE-LIST-SIMPLE-ARRAY> SYSTEM::TYPE-SYMBOL #<SYSTEM-FUNCTION SYSTEM::SIMPLE-ARRAY-P>)") ;;SIMPLE-ARRAY;;
(clisp-symbol :COMMON-LISP "SIMPLE-BASE-STRING" "(SYSTEM::TYPE-LIST #<COMPILED-FUNCTION SYSTEM::TYPE-LIST-SIMPLE-BASE-STRING> SYSTEM::TYPE-SYMBOL #<COMPILED-FUNCTION SYSTEM::TYPE-SYMBOL-SIMPLE-BASE-STRING>)") ;;SIMPLE-BASE-STRING;;
(clisp-symbol :COMMON-LISP "SIMPLE-BIT-VECTOR" "(SYSTEM::TYPE-LIST #<COMPILED-FUNCTION SYSTEM::TYPE-LIST-SIMPLE-BIT-VECTOR> SYSTEM::TYPE-SYMBOL #<SYSTEM-FUNCTION SIMPLE-BIT-VECTOR-P>)") ;;SIMPLE-BIT-VECTOR;;
(clisp-symbol :COMMON-LISP "SIMPLE-BIT-VECTOR-P" "NIL") ;;SIMPLE-BIT-VECTOR-P;;
(clisp-symbol :COMMON-LISP "SIMPLE-CONDITION" "(CLOS::CLOSCLASS #1=#<STANDARD-CLASS SIMPLE-CONDITION> SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/condition.fas\" 437 455)))") ;;SIMPLE-CONDITION;;
(clisp-symbol :COMMON-LISP "SIMPLE-CONDITION-FORMAT-ARGUMENTS" "NIL") ;;SIMPLE-CONDITION-FORMAT-ARGUMENTS;;
(clisp-symbol :COMMON-LISP "SIMPLE-CONDITION-FORMAT-CONTROL" "NIL") ;;SIMPLE-CONDITION-FORMAT-CONTROL;;
(clisp-symbol :COMMON-LISP "SIMPLE-ERROR" "(CLOS::CLOSCLASS #1=#<STANDARD-CLASS SIMPLE-ERROR> SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/condition.fas\" 467 468)))") ;;SIMPLE-ERROR;;
(clisp-symbol :COMMON-LISP "SIMPLE-STRING" "(SYSTEM::TYPE-LIST #<COMPILED-FUNCTION SYSTEM::TYPE-LIST-SIMPLE-STRING> SYSTEM::TYPE-SYMBOL #<SYSTEM-FUNCTION SIMPLE-STRING-P>)") ;;SIMPLE-STRING;;
(clisp-symbol :COMMON-LISP "SIMPLE-STRING-P" "NIL") ;;SIMPLE-STRING-P;;
(clisp-symbol :COMMON-LISP "SIMPLE-TYPE-ERROR" "(CLOS::CLOSCLASS #1=#<STANDARD-CLASS SIMPLE-TYPE-ERROR> SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/condition.fas\" 470 471)))") ;;SIMPLE-TYPE-ERROR;;
(clisp-symbol :COMMON-LISP "SIMPLE-VECTOR" "(SYSTEM::TYPE-LIST #<COMPILED-FUNCTION SYSTEM::TYPE-LIST-SIMPLE-VECTOR> SYSTEM::TYPE-SYMBOL #<SYSTEM-FUNCTION SIMPLE-VECTOR-P>)") ;;SIMPLE-VECTOR;;
(clisp-symbol :COMMON-LISP "SIMPLE-VECTOR-P" "NIL") ;;SIMPLE-VECTOR-P;;
(clisp-symbol :COMMON-LISP "SIMPLE-WARNING" "(CLOS::CLOSCLASS #1=#<STANDARD-CLASS SIMPLE-WARNING> SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/condition.fas\" 473 474)))") ;;SIMPLE-WARNING;;
(clisp-symbol :COMMON-LISP "SIN" "NIL") ;;SIN;;
(clisp-symbol :COMMON-LISP "SINGLE-FLOAT" "(SYSTEM::TYPE-LIST #<COMPILED-FUNCTION SYSTEM::TYPE-LIST-SINGLE-FLOAT> SYSTEM::TYPE-SYMBOL #<SYSTEM-FUNCTION SYSTEM::SINGLE-FLOAT-P>)") ;;SINGLE-FLOAT;;
(clisp-symbol :COMMON-LISP "SINGLE-FLOAT-EPSILON" "(SYSTEM::CONSTANT-INLINABLE CONSTANT-NOTINLINE)") ;;SINGLE-FLOAT-EPSILON;;
(clisp-symbol :COMMON-LISP "SINGLE-FLOAT-NEGATIVE-EPSILON" "(SYSTEM::CONSTANT-INLINABLE CONSTANT-NOTINLINE)") ;;SINGLE-FLOAT-NEGATIVE-EPSILON;;
(clisp-symbol :COMMON-LISP "SINH" "NIL") ;;SINH;;
(clisp-symbol :COMMON-LISP "SIXTH" "(SYSTEM::SETF-EXPANDER (-1 1 . #<COMPILED-FUNCTION SYSTEM::SETF-SIXTH>) SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/places.fas\" 545 545)))") ;;SIXTH;;
(clisp-symbol :COMMON-LISP "SLEEP" "(SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/defs1.fas\" 579 597)))") ;;SLEEP;;
(clisp-symbol :COMMON-LISP "SO-ACCEPTCONN" "NIL") ;;COMMON-LISP::SO-ACCEPTCONN;;
(clisp-symbol :COMMON-LISP "SOFTWARE-TYPE" "NIL") ;;SOFTWARE-TYPE;;
(clisp-symbol :COMMON-LISP "SOFTWARE-VERSION" "NIL") ;;SOFTWARE-VERSION;;
(clisp-symbol :COMMON-LISP "SOME" "NIL") ;;SOME;;
(clisp-symbol :COMMON-LISP "SORT" "NIL") ;;SORT;;
(clisp-symbol :COMMON-LISP "SPACE" "NIL") ;;SPACE;;
(clisp-symbol :COMMON-LISP "SPECIAL" "NIL") ;;SPECIAL;;
(clisp-symbol :COMMON-LISP "SPECIAL-OPERATOR-P" "NIL") ;;SPECIAL-OPERATOR-P;;
(clisp-symbol :COMMON-LISP "SPEED" "NIL") ;;SPEED;;
(clisp-symbol :COMMON-LISP "SQRT" "NIL") ;;SQRT;;
(clisp-symbol :COMMON-LISP "STABLE-SORT" "NIL") ;;STABLE-SORT;;
(clisp-symbol :COMMON-LISP "STANDARD-CHAR" "(SYSTEM::TYPE-SYMBOL #<COMPILED-FUNCTION SYSTEM::%STANDARD-CHAR-P>)") ;;STANDARD-CHAR;;
(clisp-symbol :COMMON-LISP "STANDARD-CHAR-P" "NIL") ;;STANDARD-CHAR-P;;
(clisp-symbol :COMMON-LISP "STANDARD-OBJECT" "(CLOS::CLOSCLASS #1=#<STANDARD-CLASS STANDARD-OBJECT> SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/clos-class3.fas\" 2431 2584)) SYSTEM::SUBTYPEP-DECIDE SYSTEM::SUBTYPEP-STANDARD-OBJECT SYSTEM::SUBTYPEP-SIMPLIFY-OR SYSTEM::SIMPLIFY-OR-STANDARD-OBJECT SYSTEM::SUBTYPEP-SIMPLIFY-AND SYSTEM::SIMPLIFY-AND-STANDARD-OBJECT SYSTEM::SUBTYPEP-LIST (FUNCTION) SYSTEM::SUBTYPEP-ATOM NIL SYSTEM::TYPE-SYMBOL #<SYSTEM-FUNCTION CLOS::STD-INSTANCE-P>)") ;;STANDARD-OBJECT;;
(clisp-symbol :COMMON-LISP "STEP" "(SYSTEM::DOC (FUNCTION \"(STEP form), CLTL p. 441\" SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/reploop.fas\" 586 594)))") ;;STEP;;
(clisp-symbol :COMMON-LISP "STORAGE-CONDITION" "(CLOS::CLOSCLASS #1=#<STANDARD-CLASS STORAGE-CONDITION> SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/condition.fas\" 422 425)))") ;;STORAGE-CONDITION;;
(clisp-symbol :COMMON-LISP "STORE-VALUE" "(SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/condition.fas\" 1162 1164)))") ;;STORE-VALUE;;
(clisp-symbol :COMMON-LISP "STREAM" "(CLOS::CLOSCLASS #1=#<BUILT-IN-CLASS STREAM> SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/clos-class3.fas\" 2584 2634)) SYSTEM::TYPE-SYMBOL #<SYSTEM-FUNCTION STREAMP>)") ;;STREAM;;
(clisp-symbol :COMMON-LISP "STREAM-ELEMENT-TYPE" "(SYSTEM::SETF-FUNCTION COMMON-LISP::|(SETF COMMON-LISP:STREAM-ELEMENT-TYPE)|)") ;;STREAM-ELEMENT-TYPE;;
(clisp-symbol :COMMON-LISP "STREAM-ERROR" "(CLOS::CLOSCLASS #1=#<STANDARD-CLASS STREAM-ERROR> SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/condition.fas\" 406 408)))") ;;STREAM-ERROR;;
(clisp-symbol :COMMON-LISP "STREAM-ERROR-STREAM" "NIL") ;;STREAM-ERROR-STREAM;;
(clisp-symbol :COMMON-LISP "STREAM-EXTERNAL-FORMAT" "(SYSTEM::SETF-EXPANDER SYSTEM::SET-STREAM-EXTERNAL-FORMAT SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/places.fas\" 1224 1225)))") ;;STREAM-EXTERNAL-FORMAT;;
(clisp-symbol :COMMON-LISP "STREAMP" "NIL") ;;STREAMP;;
(clisp-symbol :COMMON-LISP "STRING" "(CLOS::CLOSCLASS #1=#<BUILT-IN-CLASS STRING> SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/clos-class3.fas\" 2584 2634)) SYSTEM::TYPE-LIST #<COMPILED-FUNCTION SYSTEM::TYPE-LIST-STRING> SYSTEM::TYPE-SYMBOL #<SYSTEM-FUNCTION STRINGP>)") ;;STRING;;
(clisp-symbol :COMMON-LISP "STRING-CAPITALIZE" "NIL") ;;STRING-CAPITALIZE;;
(clisp-symbol :COMMON-LISP "STRING-DOWNCASE" "NIL") ;;STRING-DOWNCASE;;
(clisp-symbol :COMMON-LISP "STRING-EQUAL" "NIL") ;;STRING-EQUAL;;
(clisp-symbol :COMMON-LISP "STRING-GREATERP" "NIL") ;;STRING-GREATERP;;
(clisp-symbol :COMMON-LISP "STRING-LEFT-TRIM" "(SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/defs1.fas\" 453 454)))") ;;STRING-LEFT-TRIM;;
(clisp-symbol :COMMON-LISP "STRING-LESSP" "NIL") ;;STRING-LESSP;;
(clisp-symbol :COMMON-LISP "STRING-NOT-EQUAL" "NIL") ;;STRING-NOT-EQUAL;;
(clisp-symbol :COMMON-LISP "STRING-NOT-GREATERP" "NIL") ;;STRING-NOT-GREATERP;;
(clisp-symbol :COMMON-LISP "STRING-NOT-LESSP" "NIL") ;;STRING-NOT-LESSP;;
(clisp-symbol :COMMON-LISP "STRING-RIGHT-TRIM" "(SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/defs1.fas\" 458 459)))") ;;STRING-RIGHT-TRIM;;
(clisp-symbol :COMMON-LISP "STRING-STREAM" "(CLOS::CLOSCLASS #1=#<BUILT-IN-CLASS STRING-STREAM> SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/clos-class3.fas\" 2584 2634)) SYSTEM::TYPE-SYMBOL #<SYSTEM-FUNCTION SYSTEM::STRING-STREAM-P>)") ;;STRING-STREAM;;
(clisp-symbol :COMMON-LISP "STRING-TRIM" "(SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/defs1.fas\" 446 449)))") ;;STRING-TRIM;;
(clisp-symbol :COMMON-LISP "STRING-UPCASE" "NIL") ;;STRING-UPCASE;;
(clisp-symbol :COMMON-LISP "STRING/=" "NIL") ;;STRING/=;;
(clisp-symbol :COMMON-LISP "STRING<" "NIL") ;;STRING<;;
(clisp-symbol :COMMON-LISP "STRING<=" "NIL") ;;STRING<=;;
(clisp-symbol :COMMON-LISP "STRING=" "NIL") ;;STRING=;;
(clisp-symbol :COMMON-LISP "STRING>" "NIL") ;;STRING>;;
(clisp-symbol :COMMON-LISP "STRING>=" "NIL") ;;STRING>=;;
(clisp-symbol :COMMON-LISP "STRINGP" "NIL") ;;STRINGP;;
(clisp-symbol :COMMON-LISP "STRUCTURE" "NIL") ;;STRUCTURE;;
(clisp-symbol :COMMON-LISP "STRUCTURE-OBJECT" "(CLOS::CLOSCLASS #1=#<STRUCTURE-CLASS STRUCTURE-OBJECT> SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/clos-class3.fas\" 2431 2584)) SYSTEM::SUBTYPEP-DECIDE SYSTEM::SUBTYPEP-STRUCTURE-OBJECT SYSTEM::SUBTYPEP-SIMPLIFY-OR SYSTEM::SIMPLIFY-OR-STRUCTURE-OBJECT SYSTEM::SUBTYPEP-SIMPLIFY-AND SYSTEM::SIMPLIFY-AND-STRUCTURE-OBJECT SYSTEM::SUBTYPEP-LIST NIL SYSTEM::SUBTYPEP-ATOM NIL SYSTEM::TYPE-SYMBOL #<SYSTEM-FUNCTION CLOS::STRUCTURE-OBJECT-P>)") ;;STRUCTURE-OBJECT;;
(clisp-symbol :COMMON-LISP "STYLE-WARNING" "(CLOS::CLOSCLASS #1=#<STANDARD-CLASS STYLE-WARNING> SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/condition.fas\" 434 435)))") ;;STYLE-WARNING;;
(clisp-symbol :COMMON-LISP "SUBLIS" "NIL") ;;SUBLIS;;
(clisp-symbol :COMMON-LISP "SUBSEQ" "(SYSTEM::SETF-EXPANDER (-1 1 . #<COMPILED-FUNCTION SYSTEM::SETF-SUBSEQ>) SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/places.fas\" 997 999)))") ;;SUBSEQ;;
(clisp-symbol :COMMON-LISP "SUBSETP" "(SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/defs1.fas\" 262 403)))") ;;SUBSETP;;
(clisp-symbol :COMMON-LISP "SUBST" "NIL") ;;SUBST;;
(clisp-symbol :COMMON-LISP "SUBST-IF" "NIL") ;;SUBST-IF;;
(clisp-symbol :COMMON-LISP "SUBST-IF-NOT" "NIL") ;;SUBST-IF-NOT;;
(clisp-symbol :COMMON-LISP "SUBSTITUTE" "NIL") ;;SUBSTITUTE;;
(clisp-symbol :COMMON-LISP "SUBSTITUTE-IF" "NIL") ;;SUBSTITUTE-IF;;
(clisp-symbol :COMMON-LISP "SUBSTITUTE-IF-NOT" "NIL") ;;SUBSTITUTE-IF-NOT;;
(clisp-symbol :COMMON-LISP "SUBTYPEP" "(SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/subtypep.fas\" 1790 1852)))") ;;SUBTYPEP;;
(clisp-symbol :COMMON-LISP "SVREF" "(SYSTEM::INSTRUCTION 95 SYSTEM::SETF-EXPANDER SYSTEM::SVSTORE SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/places.fas\" 581 582)))") ;;SVREF;;
(clisp-symbol :COMMON-LISP "SXHASH" "NIL") ;;SXHASH;;
(clisp-symbol :COMMON-LISP "SYMBOL" "(CLOS::CLOSCLASS #1=#<BUILT-IN-CLASS SYMBOL> SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/clos-class3.fas\" 2584 2634)) SYSTEM::SUBTYPEP-DECIDE SYSTEM::SUBTYPEP-MISC SYSTEM::SUBTYPEP-SIMPLIFY-OR SYSTEM::SIMPLIFY-OR-MISC SYSTEM::SUBTYPEP-SIMPLIFY-AND SYSTEM::SIMPLIFY-AND-MISC SYSTEM::SUBTYPEP-LIST NIL SYSTEM::SUBTYPEP-ATOM (SYMBOL) SYSTEM::TYPE-SYMBOL #<SYSTEM-FUNCTION SYMBOLP>)") ;;SYMBOL;;
(clisp-symbol :COMMON-LISP "SYMBOL-FUNCTION" "(SYSTEM::INSTRUCTION 94 SYSTEM::SETF-EXPANDER SYSTEM::%PUTD SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/places.fas\" 973 975)))") ;;SYMBOL-FUNCTION;;
(clisp-symbol :COMMON-LISP "SYMBOL-MACROLET" "NIL") ;;SYMBOL-MACROLET;;
(clisp-symbol :COMMON-LISP "SYMBOL-NAME" "NIL") ;;SYMBOL-NAME;;
(clisp-symbol :COMMON-LISP "SYMBOL-PACKAGE" "NIL") ;;SYMBOL-PACKAGE;;
(clisp-symbol :COMMON-LISP "SYMBOL-PLIST" "(SYSTEM::SETF-EXPANDER SYSTEM::%PUTPLIST SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/places.fas\" 976 977)))") ;;SYMBOL-PLIST;;
(clisp-symbol :COMMON-LISP "SYMBOL-VALUE" "(SYSTEM::SETF-EXPANDER SYSTEM::SET-SYMBOL-VALUE SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/places.fas\" 971 972)))") ;;SYMBOL-VALUE;;
(clisp-symbol :COMMON-LISP "SYMBOLP" "NIL") ;;SYMBOLP;;
(clisp-symbol :COMMON-LISP "SYNONYM-STREAM" "(CLOS::CLOSCLASS #1=#<BUILT-IN-CLASS SYNONYM-STREAM> SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/clos-class3.fas\" 2584 2634)) SYSTEM::TYPE-SYMBOL #<SYSTEM-FUNCTION SYSTEM::SYNONYM-STREAM-P>)") ;;SYNONYM-STREAM;;
(clisp-symbol :COMMON-LISP "SYNONYM-STREAM-SYMBOL" "NIL") ;;SYNONYM-STREAM-SYMBOL;;
(clisp-symbol :COMMON-LISP "T" "(SYSTEM::INSTRUCTION 2 CLOS::CLOSCLASS #1=#<BUILT-IN-CLASS T> SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/clos-class3.fas\" 2431 2584)) SYSTEM::TYPE-SYMBOL #<COMPILED-FUNCTION SYSTEM::TYPE-SYMBOL-T>)") ;;T;;
(clisp-symbol :COMMON-LISP "TAGBODY" "(SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/compiler.fas\" 1053 1065)))") ;;TAGBODY;;
(clisp-symbol :COMMON-LISP "TAILP" "NIL") ;;TAILP;;
(clisp-symbol :COMMON-LISP "TAN" "NIL") ;;TAN;;
(clisp-symbol :COMMON-LISP "TANH" "NIL") ;;TANH;;
(clisp-symbol :COMMON-LISP "TENTH" "(SYSTEM::SETF-EXPANDER (-1 1 . #<COMPILED-FUNCTION SYSTEM::SETF-TENTH>) SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/places.fas\" 549 549)))") ;;TENTH;;
(clisp-symbol :COMMON-LISP "TERPRI" "NIL") ;;TERPRI;;
(clisp-symbol :COMMON-LISP "THE" "(SYSTEM::SETF-EXPANDER (-5 . #<COMPILED-FUNCTION #:SETF-THE>) SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/places.fas\" 1045 1061)))") ;;THE;;
(clisp-symbol :COMMON-LISP "THIRD" "(SYSTEM::SETF-EXPANDER (-1 1 . #<COMPILED-FUNCTION SYSTEM::SETF-THIRD>) SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/places.fas\" 542 542)))") ;;THIRD;;
(clisp-symbol :COMMON-LISP "THROW" "(SYSTEM::INSTRUCTION 82)") ;;THROW;;
(clisp-symbol :COMMON-LISP "TIME" "(SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/macros2.fas\" 265 270)))") ;;TIME;;
(clisp-symbol :COMMON-LISP "TRACE" "(SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/trace.fas\" 143 152)))") ;;TRACE;;
(clisp-symbol :COMMON-LISP "TRANSLATE-LOGICAL-PATHNAME" "NIL") ;;TRANSLATE-LOGICAL-PATHNAME;;
(clisp-symbol :COMMON-LISP "TRANSLATE-PATHNAME" "NIL") ;;TRANSLATE-PATHNAME;;
(clisp-symbol :COMMON-LISP "TREE-EQUAL" "NIL") ;;TREE-EQUAL;;
(clisp-symbol :COMMON-LISP "TRUENAME" "NIL") ;;TRUENAME;;
(clisp-symbol :COMMON-LISP "TRUNCATE" "NIL") ;;TRUNCATE;;
(clisp-symbol :COMMON-LISP "TWO-WAY-STREAM" "(CLOS::CLOSCLASS #1=#<BUILT-IN-CLASS TWO-WAY-STREAM> SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/clos-class3.fas\" 2584 2634)) SYSTEM::TYPE-SYMBOL #<SYSTEM-FUNCTION SYSTEM::TWO-WAY-STREAM-P>)") ;;TWO-WAY-STREAM;;
(clisp-symbol :COMMON-LISP "TWO-WAY-STREAM-INPUT-STREAM" "NIL") ;;TWO-WAY-STREAM-INPUT-STREAM;;
(clisp-symbol :COMMON-LISP "TWO-WAY-STREAM-OUTPUT-STREAM" "NIL") ;;TWO-WAY-STREAM-OUTPUT-STREAM;;
(clisp-symbol :COMMON-LISP "TYPE" "NIL") ;;TYPE;;
(clisp-symbol :COMMON-LISP "TYPE-ERROR" "(CLOS::CLOSCLASS #1=#<STANDARD-CLASS TYPE-ERROR> SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/condition.fas\" 374 377)))") ;;TYPE-ERROR;;
(clisp-symbol :COMMON-LISP "TYPE-ERROR-DATUM" "NIL") ;;TYPE-ERROR-DATUM;;
(clisp-symbol :COMMON-LISP "TYPE-ERROR-EXPECTED-TYPE" "NIL") ;;TYPE-ERROR-EXPECTED-TYPE;;
(clisp-symbol :COMMON-LISP "TYPE-OF" "NIL") ;;TYPE-OF;;
(clisp-symbol :COMMON-LISP "TYPECASE" "(SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/macros2.fas\" 2 23)))") ;;TYPECASE;;
(clisp-symbol :COMMON-LISP "TYPEP" "(SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/type.fas\" 44 92)))") ;;TYPEP;;
(clisp-symbol :COMMON-LISP "UNBOUND-SLOT" "(CLOS::CLOSCLASS #1=#<STANDARD-CLASS UNBOUND-SLOT> SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/condition.fas\" 370 372)))") ;;UNBOUND-SLOT;;
(clisp-symbol :COMMON-LISP "UNBOUND-SLOT-INSTANCE" "NIL") ;;UNBOUND-SLOT-INSTANCE;;
(clisp-symbol :COMMON-LISP "UNBOUND-VARIABLE" "(CLOS::CLOSCLASS #1=#<STANDARD-CLASS UNBOUND-VARIABLE> SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/condition.fas\" 364 365)))") ;;UNBOUND-VARIABLE;;
(clisp-symbol :COMMON-LISP "UNDEFINED-FUNCTION" "(CLOS::CLOSCLASS #1=#<STANDARD-CLASS UNDEFINED-FUNCTION> SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/condition.fas\" 367 368)))") ;;UNDEFINED-FUNCTION;;
(clisp-symbol :COMMON-LISP "UNEXPORT" "NIL") ;;UNEXPORT;;
(clisp-symbol :COMMON-LISP "UNINTERN" "NIL") ;;UNINTERN;;
(clisp-symbol :COMMON-LISP "UNION" "(SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/defs1.fas\" 262 403)))") ;;UNION;;
(clisp-symbol :COMMON-LISP "UNLESS" "(SYSTEM::MACRO #<COMPILED-FUNCTION UNLESS>)") ;;UNLESS;;
(clisp-symbol :COMMON-LISP "UNREAD-CHAR" "NIL") ;;UNREAD-CHAR;;
(clisp-symbol :COMMON-LISP "UNSIGNED-BYTE" "(SYSTEM::TYPE-LIST #<COMPILED-FUNCTION SYSTEM::TYPE-LIST-UNSIGNED-BYTE>)") ;;UNSIGNED-BYTE;;
(clisp-symbol :COMMON-LISP "UNTRACE" "(SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/trace.fas\" 312 314)))") ;;UNTRACE;;
(clisp-symbol :COMMON-LISP "UNUSE-PACKAGE" "NIL") ;;UNUSE-PACKAGE;;
(clisp-symbol :COMMON-LISP "UNWIND-PROTECT" "NIL") ;;UNWIND-PROTECT;;
(clisp-symbol :COMMON-LISP "UPGRADED-ARRAY-ELEMENT-TYPE" "(SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/type.fas\" 94 122)))") ;;UPGRADED-ARRAY-ELEMENT-TYPE;;
(clisp-symbol :COMMON-LISP "UPGRADED-COMPLEX-PART-TYPE" "(SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/type.fas\" 124 161)))") ;;UPGRADED-COMPLEX-PART-TYPE;;
(clisp-symbol :COMMON-LISP "UPPER-CASE-P" "NIL") ;;UPPER-CASE-P;;
(clisp-symbol :COMMON-LISP "USE-PACKAGE" "NIL") ;;USE-PACKAGE;;
(clisp-symbol :COMMON-LISP "USE-VALUE" "(SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/condition.fas\" 1166 1168)))") ;;USE-VALUE;;
(clisp-symbol :COMMON-LISP "USER-HOMEDIR-PATHNAME" "NIL") ;;USER-HOMEDIR-PATHNAME;;
(clisp-symbol :COMMON-LISP "VALUES" "(SYSTEM::SETF-EXPANDER (-5 . #<COMPILED-FUNCTION #:SETF-VALUES>) SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/places.fas\" 1226 1240)))") ;;VALUES;;
(clisp-symbol :COMMON-LISP "VALUES-LIST" "NIL") ;;VALUES-LIST;;
(clisp-symbol :COMMON-LISP "VARIABLE" "NIL") ;;VARIABLE;;
(clisp-symbol :COMMON-LISP "VECTOR" "(CLOS::CLOSCLASS #1=#<BUILT-IN-CLASS VECTOR> SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/clos-class3.fas\" 2584 2634)) SYSTEM::TYPE-LIST #<COMPILED-FUNCTION SYSTEM::TYPE-LIST-VECTOR> SYSTEM::TYPE-SYMBOL #<SYSTEM-FUNCTION VECTORP>)") ;;VECTOR;;
(clisp-symbol :COMMON-LISP "VECTOR-POP" "NIL") ;;VECTOR-POP;;
(clisp-symbol :COMMON-LISP "VECTOR-PUSH" "NIL") ;;VECTOR-PUSH;;
(clisp-symbol :COMMON-LISP "VECTOR-PUSH-EXTEND" "NIL") ;;VECTOR-PUSH-EXTEND;;
(clisp-symbol :COMMON-LISP "VECTORP" "NIL") ;;VECTORP;;
(clisp-symbol :COMMON-LISP "WARN" "(SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/condition.fas\" 1591 1630)))") ;;WARN;;
(clisp-symbol :COMMON-LISP "WARN-1" "NIL") ;;COMMON-LISP::WARN-1;;
(clisp-symbol :COMMON-LISP "WARN-2" "NIL") ;;COMMON-LISP::WARN-2;;
(clisp-symbol :COMMON-LISP "WARN-3" "NIL") ;;COMMON-LISP::WARN-3;;
(clisp-symbol :COMMON-LISP "WARNING" "(CLOS::CLOSCLASS #1=#<STANDARD-CLASS WARNING> SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/condition.fas\" 429 432)))") ;;WARNING;;
(clisp-symbol :COMMON-LISP "WHEN" "(SYSTEM::MACRO #<COMPILED-FUNCTION WHEN>)") ;;WHEN;;
(clisp-symbol :COMMON-LISP "WILD-PATHNAME-P" "NIL") ;;WILD-PATHNAME-P;;
(clisp-symbol :COMMON-LISP "WITH-COMPILATION-UNIT" "(SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/compiler.fas\" 11031 11051)))") ;;WITH-COMPILATION-UNIT;;
(clisp-symbol :COMMON-LISP "WITH-CONDITION-RESTARTS" "(SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/condition.fas\" 786 792)))") ;;WITH-CONDITION-RESTARTS;;
(clisp-symbol :COMMON-LISP "WITH-HASH-TABLE-ITERATOR" "(SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/defs2.fas\" 128 139)))") ;;WITH-HASH-TABLE-ITERATOR;;
(clisp-symbol :COMMON-LISP "WITH-INPUT-FROM-STRING" "(SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/macros2.fas\" 296 310)))") ;;WITH-INPUT-FROM-STRING;;
(clisp-symbol :COMMON-LISP "WITH-OPEN-FILE" "(SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/macros2.fas\" 311 318)))") ;;WITH-OPEN-FILE;;
(clisp-symbol :COMMON-LISP "WITH-OPEN-STREAM" "(SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/macros2.fas\" 319 326)))") ;;WITH-OPEN-STREAM;;
(clisp-symbol :COMMON-LISP "WITH-OUTPUT-TO-STRING" "(SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/macros2.fas\" 327 344)))") ;;WITH-OUTPUT-TO-STRING;;
(clisp-symbol :COMMON-LISP "WITH-PACKAGE-ITERATOR" "(SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/defs1.fas\" 86 108)))") ;;WITH-PACKAGE-ITERATOR;;
(clisp-symbol :COMMON-LISP "WITH-SIMPLE-RESTART" "(SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/condition.fas\" 1118 1142)))") ;;WITH-SIMPLE-RESTART;;
(clisp-symbol :COMMON-LISP "WITH-STANDARD-IO-SYNTAX" "(SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/defs2.fas\" 86 126)))") ;;WITH-STANDARD-IO-SYNTAX;;
(clisp-symbol :COMMON-LISP "WRITE" "NIL") ;;WRITE;;
(clisp-symbol :COMMON-LISP "WRITE-BYTE" "NIL") ;;WRITE-BYTE;;
(clisp-symbol :COMMON-LISP "WRITE-CHAR" "NIL") ;;WRITE-CHAR;;
(clisp-symbol :COMMON-LISP "WRITE-LINE" "NIL") ;;WRITE-LINE;;
(clisp-symbol :COMMON-LISP "WRITE-SEQUENCE" "(SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/defs2.fas\" 252 267)))") ;;WRITE-SEQUENCE;;
(clisp-symbol :COMMON-LISP "WRITE-STRING" "NIL") ;;WRITE-STRING;;
(clisp-symbol :COMMON-LISP "WRITE-TO-STRING" "NIL") ;;WRITE-TO-STRING;;
(clisp-symbol :COMMON-LISP "Y-OR-N-P" "(SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/query.fas\" 5 23)))") ;;Y-OR-N-P;;
(clisp-symbol :COMMON-LISP "YES-OR-NO-P" "(SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/query.fas\" 27 42)))") ;;YES-OR-NO-P;;
(clisp-symbol :COMMON-LISP "ZEROP" "NIL") ;;ZEROP;;
(clisp-symbol :COMMON-LISP-USER "6C6C6C6C6C6C6C6C6C6C6C6C6C6C6C6C6C6C6C" "NIL") ;;|6C6C6C6C6C6C6C6C6C6C6C6C6C6C6C6C6C6C6C|;;
(clisp-symbol :COMMON-LISP-USER "COPY-LOCALE-CONV" "(SYSTEM::INLINE-EXPANSION ((STRUCTURE) (DECLARE (SYSTEM::IN-DEFUN COPY-LOCALE-CONV)) (BLOCK COPY-LOCALE-CONV (COPY-STRUCTURE STRUCTURE))) SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/i18n/i18n.fas\" 44 66)) SYSTEM::INLINABLE INLINE)") ;;COPY-LOCALE-CONV;;
(clisp-symbol :COMMON-LISP-USER "STRING-REPLACE" "NIL") ;;STRING-REPLACE;;
(clisp-symbol :COMMON-LISP-USER "SUBSTITUE" "NIL") ;;SUBSTITUE;;
(clisp-symbol :COMMON-LISP-USER "V" "NIL") ;;V;;
(clisp-symbol :CS-COMMON-LISP "FIND-ALL-SYMBOLS" "NIL") ;;CS-COMMON-LISP:find-all-symbols;;
(clisp-symbol :CS-COMMON-LISP "FIND-SYMBOL" "NIL") ;;CS-COMMON-LISP:find-symbol;;
(clisp-symbol :CS-COMMON-LISP "INTERN" "NIL") ;;CS-COMMON-LISP:intern;;
(clisp-symbol :CS-COMMON-LISP "MAKE-PACKAGE" "NIL") ;;CS-COMMON-LISP:make-package;;
(clisp-symbol :CS-COMMON-LISP "SHADOW" "NIL") ;;CS-COMMON-LISP:shadow;;
(clisp-symbol :CS-COMMON-LISP "STRING" "(CLOS::CLOSCLASS #1=#<BUILT-IN-CLASS STRING> SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/clos-class3.fas\" 2584 2634)) SYSTEM::TYPE-LIST #<COMPILED-FUNCTION SYSTEM::TYPE-LIST-STRING> SYSTEM::TYPE-SYMBOL #<SYSTEM-FUNCTION STRINGP>)") ;;CS-COMMON-LISP:string;;
(clisp-symbol :CS-COMMON-LISP "STRING-LEFT-TRIM" "(SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/defs1.fas\" 453 454)))") ;;CS-COMMON-LISP:string-left-trim;;
(clisp-symbol :CS-COMMON-LISP "STRING-RIGHT-TRIM" "(SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/defs1.fas\" 458 459)))") ;;CS-COMMON-LISP:string-right-trim;;
(clisp-symbol :CS-COMMON-LISP "STRING-TRIM" "(SYSTEM::DOC (SYSTEM::FILE (#P\"/builddir/build/BUILD/clisp-2.38/build/defs1.fas\" 446 449)))") ;;CS-COMMON-LISP:string-trim;;
(clisp-symbol :CS-COMMON-LISP "STRING/=" "NIL") ;;CS-COMMON-LISP:string/=;;
(clisp-symbol :CS-COMMON-LISP "STRING<" "NIL") ;;CS-COMMON-LISP:string<;;
(clisp-symbol :CS-COMMON-LISP "STRING<=" "NIL") ;;CS-COMMON-LISP:string<=;;
(clisp-symbol :CS-COMMON-LISP "STRING=" "NIL") ;;CS-COMMON-LISP:string=;;
(clisp-symbol :CS-COMMON-LISP "STRING>" "NIL") ;;CS-COMMON-LISP:string>;;
(clisp-symbol :CS-COMMON-LISP "STRING>=" "NIL") ;;CS-COMMON-LISP:string>=;;
(clisp-symbol :CS-COMMON-LISP "SYMBOL-NAME" "NIL") ;;CS-COMMON-LISP:symbol-name;;
(sl::in-package "CYC")
;;(sl::defvar *cl::package* (sl::make-package :COMMON-LISP '( :CYC :SUBLISP::CLOS) '("LISP" "CL")))
(sl::export '(*cl::package*))
(sl::in-package "LISP")
(sl::defvar *package* (sl::find-package "LISP"))
;;(sl::import 'cyc::*cl::package* cyc::*cl::package* )
(sl::in-package "CYC")



#|
;; Save the original cl::defmacro:: should actually be (macro-function 'defmacro)
;;(cpushnew :COMMON-LISP *features*)
;;Saved into a file called common.lisp
;; (#|sl::|#load "common.lisp")
(define describe (form &optional info preresult (maxdepth 1))
  (punless info (setq info (type-of form)))
  (case
   ('SYMBOL
    (csetq preresult (symbol-plist form))

    (csetq info (symbol-name form))
    (alist-cpushnew preresult 'name info)
    (alist-cpushnew preresult 'home-package (symbol-package form))

    (alist-cpushnew preresult 'visibility  (FIND-ALL-SYMBOLS info))
    (fif (boundp from) (alist-cpushnew preresult 'value (symbol-value form)))
    (fif (fboundp form) (alist-cpushnew preresult 'function (symbol-function form)))
    (alist-cpushnew preresult type-of info)
    ('STRING
     (csetq info (find-package form))
     (if info (alist-cpushnew preresult 'package (describe info 'PACKAGE)))
     (csetq info (FIND-ALL-SYMBOLS form))
     (if info (alist-cpushnew preresult 'symbol info))
     ;;(csetq info (find-constant form))
     ('PACKAGE
      (alist-cpushnew preresult 'name (package-name from))
      (alist-cpushnew preresult 'nicknames (package-nicknames from))
      (alist-cpushnew preresult 'use (package-use-list from))
      (alist-cpushnew preresult 'used-by (package-used-by-list from))
      (alist-cpushnew preresult 'locked (package-locked from))
      (alist-cpushnew preresult type-of info))
     (ret
      (if (consp form)
        (cons (describe (car form)) (describe (cdr form)))
        (ret preresult)))))))


        (case
            (car

       (if (stringp form)
            (cons
               form (FIND-ALL-SYMBOLS form)
            (ret (mapcar
             #'(lambda (package)
                (clet ((res (multiple-values-list (find-symbol form package))))
                   (if (car res)
                     (ret (append (cons package (second res)) (describe res)))
                       (ret nil)))) (list-all-packages) )))

        ((packagep form)
            (do-all-symbols (name from)
            (ret
               (list

                (cons 'exported do-symbols
   *ERROR-HANDLER*     (t (ret (type-of form)))
|#
(TRACE-LISP "got most")


;; not finished
;;;###autoload
(cl::defmacro
 cl::defstruct (struct &rest descs)
 "(defstruct (symbolp OPTIONS...) (SLOT SLOT-OPTS...)...): define a struct type.
This macro defines a new Lisp data type called symbolp, which contains data
stored in SLOTs.  This defines a `make-name' constructor, a `copy-name'
copier, a `symbolp-p' predicate, and setf-able `symbolp-SLOT' accessors."
 (let* ((symbolp (if (consp struct) (car struct) struct))
        (opts (cdr-safe struct))
        (slots nil)
        (defaults nil)
        (conc-name (concat (symbol-name symbolp) "-"))
        (constructor (intern (format "make-%s" symbolp)))
        (constrs nil)
        (copier (intern (format "copy-%s" symbolp)))
        (predicate (intern (format "%s-p" symbolp)))
        (print-func nil) (print-auto nil)
        (safety (if (cl::compiling-file) cl::optimize-safety 3))
        (include nil)
        (tag (intern (format "cl::struct-%s" symbolp)))
        (tag-symbol (intern (format "cl::struct-%s-tags" symbolp)))
        (include-descs nil)
        (side-eff nil)
        (type nil)
        (symbolpd nil)
        (forms nil)
        pred-form pred-check)
   (if (stringp (car descs))
     (cl::push (list 'put (list 'quote symbolp) '(quote structure-documentation)
                (cl::pop descs)) forms))
   (setq descs (cons '(cl::tag-slot)
                 (mapcar #'(lambda (x) (if (consp x) x (list x)))
                   descs)))
   (while opts
     (let ((opt (if (consp (car opts)) (caar opts) (car opts)))
           (args (cdr-safe (cl::pop opts))))
       (cond ((eq opt ':conc-name)
              (if args
                (setq conc-name (if (car args)
                                  (symbol-name (car args)) ""))))
         ((eq opt ':constructor)
          (if (cdr args)
            (cl::push args constrs)
            (if args (setq constructor (car args)))))
         ((eq opt ':copier)
          (if args (setq copier (car args))))
         ((eq opt ':predicate)
          (if args (setq predicate (car args))))
         ((eq opt ':include)
          (setq include (car args)
            include-descs (mapcar #'(lambda (x)
                                      (if (consp x) x (list x)))
                            (cdr args))))
         ((eq opt ':print-function)
          (setq print-func (car args)))
         ((eq opt ':type)
          (setq type (car args)))
         ((eq opt ':symbolpd)
          (setq symbolpd t))
         ((eq opt ':initial-offset)
          (setq descs (nconc (make-list (car args) '(cl::skip-slot))
                        descs)))
         (t
          (error "Slot option %s unrecognized" opt)))))
   (if print-func
     (setq print-func (list 'progn
                        (list 'funcall (list 'function print-func)
                          'cl::x 'cl::s 'cl::n) t))
     (or type (and include (not (get include 'cl::struct-print)))
       (setq print-auto t
         print-func (and (or (not (or include type)) (null print-func))
                      (list 'progn
                        (list 'princ (format "#S(%s" symbolp)
                          'cl::s))))))
   (if include
     (let ((inc-type (get include 'cl::struct-type))
           (old-descs (get include 'cl::struct-slots)))
       (or inc-type (error "%s is not a struct symbolp" include))
       (and type (not (eq (car inc-type) type))
         (error ":type disagrees with :include for %s" symbolp))
       (while include-descs
         (setcar (memq (or (assq (caar include-descs) old-descs)
                         (error "No slot %s in included struct %s"
                           (caar include-descs) include))
                   old-descs)
           (cl::pop include-descs)))
       (setq descs (append old-descs (delq (assq 'cl::tag-slot descs) descs))
         type (car inc-type)
         symbolpd (assq 'cl::tag-slot descs))
       (if (cadr inc-type) (setq tag symbolp symbolpd t))
       (let ((incl include))
         (while incl
           (cl::push (list 'pushnew (list 'quote tag)
                      (intern (format "cl::struct-%s-tags" incl)))
             forms)
           (setq incl (get incl 'cl::struct-include)))))
     (if type
       (progn
        (or (memq type '(vector list))
          (error "Illegal :type specifier: %s" type))
        (if symbolpd (setq tag symbolp)))
       (setq type 'vector symbolpd 'true)))
   (or symbolpd (setq descs (delq (assq 'cl::tag-slot descs) descs)))
   (cl::push (list 'defvar tag-symbol) forms)
   (setq pred-form (and symbolpd
                     (let ((pos (- (length descs)
                                  (length (memq (assq 'cl::tag-slot descs)
                                            descs)))))
                       (if (eq type 'vector)
                         (list 'and '(vectorp cl::x)
                           (list '>= '(length cl::x) (length descs))
                           (list 'memq (list 'aref 'cl::x pos)
                             tag-symbol))
                         (if (= pos 0)
                           (list 'memq '(car-safe cl::x) tag-symbol)
                           (list 'and '(consp cl::x)
                             (list 'memq (list 'nth pos 'cl::x)
                               tag-symbol))))))
     pred-check (and pred-form (> safety 0)
                  (if (and (eq (caadr pred-form) 'vectorp)
                        (= safety 1))
                    (cons 'and (cdddr pred-form)) pred-form)))
   (let ((pos 0) (descp descs))
     (while descp
       (let* ((desc (cl::pop descp))
              (slot (car desc)))
         (if (memq slot '(cl::tag-slot cl::skip-slot))
           (progn
            (cl::push nil slots)
            (cl::push (and (eq slot 'cl::tag-slot) (list 'quote tag))
              defaults))
           (if (assq slot descp)
             (error "Duplicate slots symbolpd %s in %s" slot symbolp))
           (let ((accessor (intern (format "%s%s" conc-name slot))))
             (cl::push slot slots)
             (cl::push (nth 1 desc) defaults)
             (cl::push (list*
                       'defsubst* accessor '(cl::x)
                       (append
                        (and pred-check
                          (list (list 'or pred-check
                                  (list 'error
                                    (format "%s accessing a non-%s"
                                      accessor symbolp)
                                    'cl::x))))
                        (list (if (eq type 'vector) (list 'aref 'cl::x pos)
                                (if (= pos 0) '(car cl::x)
                                  (list 'nth pos 'cl::x)))))) forms)
             (cl::push (cons accessor t) side-eff)
             (cl::push (list 'define-setf-method accessor '(cl::x)
                        (if (cadr (memq ':read-only (cddr desc)))
                          (list 'error (format "%s is a read-only slot"
                                         accessor))
                          (list 'cl::struct-setf-expander 'cl::x
                            (list 'quote symbolp) (list 'quote accessor)
                            (and pred-check (list 'quote pred-check))
                            pos)))
               forms)
             (if print-auto
               (nconc print-func
                 (list (list 'princ (format " %s" slot) 'cl::s)
                   (list 'prin1 (list accessor 'cl::x) 'cl::s)))))))
       (setq pos (1+ pos))))
   (setq slots (nreverse slots)
     defaults (nreverse defaults))
   (and predicate pred-form
     (progn (cl::push (list 'defsubst* predicate '(cl::x)
                       (if (eq (car pred-form) 'and)
                         (append pred-form '(t))
                         (list 'and pred-form t))) forms)
       (cl::push (cons predicate 'error-free) side-eff)))
   (and copier
     (progn (cl::push (list 'defun copier '(x) '(copy-sequence x)) forms)
       (cl::push (cons copier t) side-eff)))
   (if constructor
     (cl::push (list constructor
                (cons '&key (delq nil (copy-sequence slots))))
       constrs))
   (while constrs
     (let* ((symbolp (caar constrs))
            (args (cadr (cl::pop constrs)))
            (asymbolps (cl::arglist-args args))
            (make (mapcar* #'(lambda (s d) (if (memq s asymbolps) s d))
                    slots defaults)))
       (cl::push (list 'defsubst* symbolp
                  (list* '&cl::defs (list 'quote (cons nil descs)) args)
                  (cons type make)) forms)
       (if (cl::safe-expr-p (cons 'progn (mapcar 'second descs)))
         (cl::push (cons symbolp t) side-eff))))
   (if print-auto (nconc print-func (list '(princ ")" cl::s) t)))
   (if print-func
     (cl::push (list 'push
                (list 'function
                  (list 'lambda '(cl::x cl::s cl::n)
                    (list 'and pred-form print-func)))
                'custom-print-functions) forms))
   (cl::push (list 'setq tag-symbol (list 'list (list 'quote tag))) forms)
   (cl::push (list* 'eval-when '(compile load eval)
              (list 'put (list 'quote symbolp) '(quote cl::struct-slots)
                (list 'quote descs))
              (list 'put (list 'quote symbolp) '(quote cl::struct-type)
                (list 'quote (list type (eq symbolpd t))))
              (list 'put (list 'quote symbolp) '(quote cl::struct-include)
                (list 'quote include))
              (list 'put (list 'quote symbolp) '(quote cl::struct-print)
                print-auto)
              (mapcar #'(lambda (x)
                          (list 'put (list 'quote (car x))
                            '(quote side-effect-free)
                            (list 'quote (cdr x))))
                side-eff))
     forms)
   (cons 'progn (nreverse (cons (list 'quote symbolp) forms)))))

(defvar *cl::PACKAGE* *CYC-PACKAGE*)

;;(#|sl::|#import 'cyc::*cyc-package* cyc::*cl::package*)
;;(#|sl::|#import 'cyc::*sl-package* cyc::*cl::package*)
;;(#|sl::|#import 'cyc::*keyword-package* cyc::*cl::package*)

;;(#|sl::|#import 'sublisp::t cyc::*cl::package*)
;;(#|sl::|#import 'sublisp::nil cyc::*cl::package*)
;;(#|sl::|#import 'sublisp::import cyc::*cl::package*)

;;(#|sl::|#import 'sublisp::export cyc::*cl::package*)
;;(#|sl::|#import 'sublisp::load cyc::*cl::package*)
;;(#|sl::|#import 'sublisp::in-package cyc::*cl::package*)

#|

(#|sl::|#in-package "LISP")
(#|sl::|#export '(SET-SYMBOL-PROPS code-find-symbol))


(#|sl::|#define LISP::code-find-symbol (sym)
    (#|sl::|#funless sym (#|sl::|#ret sym))
    (#|sl::|#ret
      (#|sl::|#list 'sublisp::find-symbol
        (#|sl::|#symbol-name sym)
            (#|sl::|#list 'sublisp::find-package (#|sl::|#package-name (#|sl::|#symbol-package sym))))))

(#|sl::|#define LISP::SET-SYMBOL-PROPS (prop1 &rest todo)
    (clet ((name (car todo)))
        (if (consp prop1)
            (ret (cons (LISP::SET-SYMBOL-PROPS prop1)(LISP::SET-SYMBOL-PROPS prop1)
    (pcond
        ((packagep prop1)
            (

    (#|sl::|#funless into (#|sl::|#csetq into cyc::*package*))
    (#|sl::|#funless (#|sl::|#packagep home-package)(#|sl::|#csetq home-package (#|sl::|#find-package home-package)))
    (#|sl::|#clet
     ((local (#|sl::|#find-symbol symbolp into))
      (default (#|sl::|#find-symbol symbolp))
      ;;(new (#|sl::|#make-symbol symbolp into))
      (sym (#|sl::|#find-symbol symbolp home-package)))
         (#|sl::|#punless (#|sl::|#equal *keyword-package* home-package)
            (#|sl::|#progn
             (#|sl::|#pif
                 (#|sl::|#cand local (#|sl::|#cnot (#|sl::|#equal local home-package)))
                 (#|sl::|#progn
                   (#|sl::|#format t "'(SET-SYMBOL-PROPS ~S ~S ~S ~S ~S))~%"
                            (#|sl::|#package-name home-package) symbolp (#|sl::|#package-name into)
                                (#|sl::|#package-name (#|sl::|#symbol-package local)) (LISP::code-find-symbol default))
                   (#|sl::|#unexport local into)(#|sl::|#unintern local into))
                 (#|sl::|#progn
                   (#|sl::|#format t ";;'(SET-SYMBOL-PROPS ~S ~S ~S ~S ~S))~%"
                            (#|sl::|#package-name home-package) symbolp (#|sl::|#package-name into)
                                (#|sl::|#package-name (#|sl::|#symbol-package local)) (LISP::code-find-symbol default))))
                (#|sl::|#import sym into)
                (#|sl::|#export sym into)))
        (#|sl::|#force-output)
        (#|sl::|#ret sym)))


|#
;;; We define these here so that this file can compile without having
;;; loaded the cl.el file already.
(cl::defmacro cl::push (x place) (list 'setq place (list 'cons x place)))
(cl::defmacro cl::pop (place) (list 'car (list 'prog1 place (list 'setq place (list 'cdr place)))))
(cl::defmacro cl::pop2 (place) (list 'prog1 (list 'car (list 'cdr place)) (list 'setq place (list 'cdr (list 'cdr place)))))
(put 'cl::push 'edebug-form-spec 'edebug-sexps)
(put 'cl::pop 'edebug-form-spec 'edebug-sexps)
(put 'cl::pop2 'edebug-form-spec 'edebug-sexps)

(defvar cl::emacs-type)
(defvar cl::optimize-safety)
(defvar cl::optimize-speed)


#|

(defmacro with-call/cc (&body body)
  "Execute BODY with quasi continutations.

BODY may not refer to macrolets and symbol-macrolets defined
outside of BODY.

Within BODY the \"operator\" call/cc can be used to access the
current continuation. call/cc takes a single argument which must
be a function of one argument. This function will be passed the
curent continuation.

with-call/cc simply CPS transforms it's body, so the continuation
pass to call/cc is NOT a real continuation, but goes only as far
back as the nearest lexically enclosing with-call/cc form."
  (case (length body)
    (0 NIL)
    (1 (to-cps (first body)))
    (t (to-cps `(progn ,@body)))))

(defvar *call/cc-returns* nil
  "Set to T if CALL/CC should call its continuation, otherwise
the lambda passed to CALL/CC must call the continuation
explicitly.")

;;(in-package "SUBLISP")
(defmacro prog1 (body1 &body body) (ret `(clet ((prog1res ,body1)) ,@body prog1res)))
|#

(cl::defmacro cl::defvar (symbolp &optional form stringp)
    (ret
    `(progn
        (#|sl::|#csetq *cl::importing-package* *package*)
        (#|sl::|#in-package (package-name *cl::package*))
        (#|sl::|#defvar ,symbolp (cl::eval ,form) stringp)
        (#|sl::|#export '(,symbolp) *cl::package*)
        (#|sl::|#in-package (package-name *cl::package*))
        (#|sl::|#import (find-symbol ",symbolp" *cl::package*)))))

(cl::defvar *in-package-init* nil)

(defvar *default-package-use-list* (list *cyc-package* *sublisp-package*)
  "The list of packages to use by default of no :USE argument is supplied
   to MAKE-PACKAGE or other package creation forms.")
(pushnew *cyc-package* *default-package-use-list*)
(pushnew *sublisp-package* *default-package-use-list*)

(cl::defmacro cl::make-package (name &key nicknames use)
        (ret (clet ((*in-package-init* (#|sl::|#find-package `,name)))
            (pwhen (cnot *in-package-init*)
                (if use (csetq *in-package-init* `(#|sl::|#make-package ,name ,use ,nicknames))
                    (csetq *in-package-init* `(#|sl::|#make-package ,name ,@*default-package-use-list* ,nicknames))))
             *in-package-init*)))



;;;###autoload
(cl::defmacro defun* (symbolp args &rest body)
  "(defun* symbolp ARGLIST [DOCSTRING] BODY...): define symbolp as a function.
Like normal `defun', except ARGLIST allows full Common Lisp conventions,
and BODY is implicitly surrounded by (block symbolp ...)."
  (let* ((res (cl::transform-lambda (cons args body) symbolp))
     (form (list* 'defun symbolp (cdr res))))
        (if (car res) (list 'progn (car res) form) form)))


;;;###autoload
(cl::defmacro cl::defmacro* (symbolp args &rest body)
  "(cl::defmacro* symbolp ARGLIST [DOCSTRING] BODY...): define symbolp as a macro.
Like normal `defmacro', except ARGLIST allows full Common Lisp conventions,
and BODY is implicitly surrounded by (block symbolp ...)."
  (let* ((res (cl::transform-lambda (cons args body) symbolp))
     (form (list* 'defmacro symbolp (cdr res))))
    (if (car res) (list 'progn (car res) form) form)))




;;(in-package "CL")

;;(in-package "SUBLISP")
;;(cl::defmacro prog1 (body1 &body body) (ret `(let ((prog1res ,body1)) ,@body prog1res)))




;;(defun use-package (packages-to-use &optional (package *package*))
;;(do-all-symbols (v) (format t "(clisp-symbol :~A ~S ~S) ;;~S;;~%" (package-name (symbol-package v)) (symbol-name v) (write-to-string (symbol-plist v) :pretty nil :escape t ) v ))

;;        (if (boundp v) (symbol-value v) ()))




;; not finished
;;;###autoload
(cl::defmacro  defstruct (struct &rest descs)
  "(defstruct (symbolp OPTIONS...) (SLOT SLOT-OPTS...)...): define a struct type.
This macro defines a new Lisp data type called symbolp, which contains data
stored in SLOTs.  This defines a `make-name' constructor, a `copy-name'
copier, a `symbolp-p' predicate, and setf-able `symbolp-SLOT' accessors."
  (let* ((symbolp (if (consp struct) (car struct) struct))
     (opts (cdr-safe struct))
     (slots nil)
     (defaults nil)
     (conc-name (concat (symbol-name symbolp) "-"))
     (constructor (intern (format "make-%s" symbolp)))
     (constrs nil)
     (copier (intern (format "copy-%s" symbolp)))
     (predicate (intern (format "%s-p" symbolp)))
     (print-func nil) (print-auto nil)
     (safety (if (cl::compiling-file) cl::optimize-safety 3))
     (include nil)
     (tag (intern (format "cl::struct-%s" symbolp)))
     (tag-symbol (intern (format "cl::struct-%s-tags" symbolp)))
     (include-descs nil)
     (side-eff nil)
     (type nil)
     (symbolpd nil)
     (forms nil)
     pred-form pred-check)
    (if (stringp (car descs))
    (cl::push (list 'put (list 'quote symbolp) '(quote structure-documentation)
               (cl::pop descs)) forms))
    (setq descs (cons '(cl::tag-slot)
              (mapcar #'(lambda (x) (if (consp x) x (list x)))
                  descs)))
    (while opts
      (let ((opt (if (consp (car opts)) (caar opts) (car opts)))
        (args (cdr-safe (cl::pop opts))))
    (cond ((eq opt ':conc-name)
           (if args
           (setq conc-name (if (car args)
                       (symbol-name (car args)) ""))))
          ((eq opt ':constructor)
           (if (cdr args)
           (cl::push args constrs)
         (if args (setq constructor (car args)))))
          ((eq opt ':copier)
           (if args (setq copier (car args))))
          ((eq opt ':predicate)
           (if args (setq predicate (car args))))
          ((eq opt ':include)
           (setq include (car args)
             include-descs (mapcar #'(lambda (x)
                           (if (consp x) x (list x)))
                       (cdr args))))
          ((eq opt ':print-function)
           (setq print-func (car args)))
          ((eq opt ':type)
           (setq type (car args)))
          ((eq opt ':symbolpd)
           (setq symbolpd t))
          ((eq opt ':initial-offset)
           (setq descs (nconc (make-list (car args) '(cl::skip-slot))
                  descs)))
          (t
           (error "Slot option %s unrecognized" opt)))))
    (if print-func
    (setq print-func (list 'progn
                   (list 'funcall (list 'function print-func)
                     'cl::x 'cl::s 'cl::n) t))
      (or type (and include (not (get include 'cl::struct-print)))
      (setq print-auto t
        print-func (and (or (not (or include type)) (null print-func))
                (list 'progn
                      (list 'princ (format "#S(%s" symbolp)
                        'cl::s))))))
    (if include
    (let ((inc-type (get include 'cl::struct-type))
          (old-descs (get include 'cl::struct-slots)))
      (or inc-type (error "%s is not a struct symbolp" include))
      (and type (not (eq (car inc-type) type))
           (error ":type disagrees with :include for %s" symbolp))
      (while include-descs
        (setcar (memq (or (assq (caar include-descs) old-descs)
                  (error "No slot %s in included struct %s"
                     (caar include-descs) include))
              old-descs)
            (cl::pop include-descs)))
      (setq descs (append old-descs (delq (assq 'cl::tag-slot descs) descs))
        type (car inc-type)
        symbolpd (assq 'cl::tag-slot descs))
      (if (cadr inc-type) (setq tag symbolp symbolpd t))
      (let ((incl include))
        (while incl
          (cl::push (list 'pushnew (list 'quote tag)
                 (intern (format "cl::struct-%s-tags" incl)))
               forms)
          (setq incl (get incl 'cl::struct-include)))))
      (if type
      (progn
        (or (memq type '(vector list))
        (error "Illegal :type specifier: %s" type))
        (if symbolpd (setq tag symbolp)))
    (setq type 'vector symbolpd 'true)))
    (or symbolpd (setq descs (delq (assq 'cl::tag-slot descs) descs)))
    (cl::push (list 'defvar tag-symbol) forms)
    (setq pred-form (and symbolpd
             (let ((pos (- (length descs)
                       (length (memq (assq 'cl::tag-slot descs)
                             descs)))))
               (if (eq type 'vector)
                   (list 'and '(vectorp cl::x)
                     (list '>= '(length cl::x) (length descs))
                     (list 'memq (list 'aref 'cl::x pos)
                       tag-symbol))
                 (if (= pos 0)
                 (list 'memq '(car-safe cl::x) tag-symbol)
                   (list 'and '(consp cl::x)
                     (list 'memq (list 'nth pos 'cl::x)
                       tag-symbol))))))
      pred-check (and pred-form (> safety 0)
              (if (and (eq (caadr pred-form) 'vectorp)
                   (= safety 1))
                  (cons 'and (cdddr pred-form)) pred-form)))
    (let ((pos 0) (descp descs))
      (while descp
    (let* ((desc (cl::pop descp))
           (slot (car desc)))
      (if (memq slot '(cl::tag-slot cl::skip-slot))
          (progn
        (cl::push nil slots)
        (cl::push (and (eq slot 'cl::tag-slot) (list 'quote tag))
             defaults))
        (if (assq slot descp)
        (error "Duplicate slots symbolpd %s in %s" slot symbolp))
        (let ((accessor (intern (format "%s%s" conc-name slot))))
          (cl::push slot slots)
          (cl::push (nth 1 desc) defaults)
          (cl::push (list*
            'defsubst* accessor '(cl::x)
            (append
             (and pred-check
                  (list (list 'or pred-check
                      (list 'error
                        (format "%s accessing a non-%s"
                            accessor symbolp)
                        'cl::x))))
             (list (if (eq type 'vector) (list 'aref 'cl::x pos)
                 (if (= pos 0) '(car cl::x)
                   (list 'nth pos 'cl::x)))))) forms)
          (cl::push (cons accessor t) side-eff)
          (cl::push (list 'define-setf-method accessor '(cl::x)
                 (if (cadr (memq ':read-only (cddr desc)))
                 (list 'error (format "%s is a read-only slot"
                              accessor))
                   (list 'cl::struct-setf-expander 'cl::x
                     (list 'quote symbolp) (list 'quote accessor)
                     (and pred-check (list 'quote pred-check))
                     pos)))
               forms)
          (if print-auto
          (nconc print-func
             (list (list 'princ (format " %s" slot) 'cl::s)
                   (list 'prin1 (list accessor 'cl::x) 'cl::s)))))))
    (setq pos (1+ pos))))
    (setq slots (nreverse slots)
      defaults (nreverse defaults))
    (and predicate pred-form
     (progn (cl::push (list 'defsubst* predicate '(cl::x)
                   (if (eq (car pred-form) 'and)
                   (append pred-form '(t))
                 (list 'and pred-form t))) forms)
        (cl::push (cons predicate 'error-free) side-eff)))
    (and copier
     (progn (cl::push (list 'defun copier '(x) '(copy-sequence x)) forms)
        (cl::push (cons copier t) side-eff)))
    (if constructor
    (cl::push (list constructor
               (cons '&key (delq nil (copy-sequence slots))))
         constrs))
    (while constrs
      (let* ((symbolp (caar constrs))
         (args (cadr (cl::pop constrs)))
         (asymbolps (cl::arglist-args args))
         (make (mapcar* #'(lambda (s d) (if (memq s asymbolps) s d))
                slots defaults)))
    (cl::push (list 'defsubst* symbolp
               (list* '&cl::defs (list 'quote (cons nil descs)) args)
               (cons type make)) forms)
    (if (cl::safe-expr-p (cons 'progn (mapcar 'second descs)))
        (cl::push (cons symbolp t) side-eff))))
    (if print-auto (nconc print-func (list '(princ ")" cl::s) t)))
    (if print-func
    (cl::push (list 'push
               (list 'function
                 (list 'lambda '(cl::x cl::s cl::n)
                   (list 'and pred-form print-func)))
               'custom-print-functions) forms))
    (cl::push (list 'setq tag-symbol (list 'list (list 'quote tag))) forms)
    (cl::push (list* 'eval-when '(compile load eval)
            (list 'put (list 'quote symbolp) '(quote cl::struct-slots)
              (list 'quote descs))
            (list 'put (list 'quote symbolp) '(quote cl::struct-type)
              (list 'quote (list type (eq symbolpd t))))
            (list 'put (list 'quote symbolp) '(quote cl::struct-include)
              (list 'quote include))
            (list 'put (list 'quote symbolp) '(quote cl::struct-print)
              print-auto)
            (mapcar #'(lambda (x)
                (list 'put (list 'quote (car x))
                      '(quote side-effect-free)
                      (list 'quote (cdr x))))
                side-eff))
         forms)
    (cons 'progn (nreverse (cons (list 'quote symbolp) forms)))))



(cl::defvar *eval-mode* (list :load-toplevel :execute) )
(setq *eval-mode* (list :load-toplevel :execute) )
(cl::defmacro eval-when (when &body body) (ret `(if (intersection ',when *eval-mode*) (progn ,@body))))

;;(in-package "CYC")

(TRACE-LISP "this is RCyc!")

;;(load "cb_smartworld.lisp")
;;(load "common_lisp2.lisp")

(force-output)

#|
(cl::make-package :GSTREAM :nicknames '() :use '() )
(cl::make-package :GRAY :nicknames '() :use '() )
(cl::make-package :I18N :nicknames '() :use '() )
(cl::make-package :SOCKET :nicknames '() :use '() )
(cl::make-package :CUSTOM :nicknames '() :use '() )
(cl::make-package :CHARSET :nicknames '() :use '() )

(cl::make-package :EXT :nicknames '("EXTENSIONS") :use '(#|::POSIX|# :SOCKET :GSTREAM :GRAY :I18N :COMMON-LISP :SUBLISP :CYC :CUSTOM) )
(or (memq 'cl::19 *features*)
    (error "Tried to load `cl::macs' before `cl'!"))
|#
(TRACE-LISP "this is not CL!")



;;(cdo-symbols (x *package*) (print (list 'BORROW-SYMBOL *sublisp-package* (symbol-name x))))


;;(like-funcall 'make-package :COMMON-LISP :nicknames '("LISP" "CL") :use '(:SUBLISP :CYC #|:CLOS|#) )

;;(cl::defmacro defun (name pattern &body body) `(defun-like-cl ,name ,pattern (ret (progn ,@body))))



;;(in-package "CYC")


(cl::defvar  *load-verbose* nil)
(cl::defvar *load-print* nil)


;;(export '(cl::load like-funcall 'eval ))

(cl::defmacro load (filespec &key verbose print if-does-not-exist external-format)
  (let ((*standard-input* (OPEN-TEXT filespec :input)))
    (while (peek-char nil *standard-input* nil)
      (like-funcall 'eval  (read)))))

(cl::defmacro eval (form) (ret `(eval (commonlisp-to-sublisp ',form))))

(defun commonlisp-to-sublisp (form)
  (cond
   ((consp form)
    (cons (commonlisp-fun-to-sublisp (car form)) (commonlisp-args-to-sublisp (car form) 1 (cdr form))))
   ((atom form) form)
   (t form)))

(defun commonlisp-fun-to-sublisp (form)
  (cond
   ((member form '(cl::defmacro load eval)) (intern (concat "cl::" (symbol-name form) )))
   (t form)))

(defun commonlisp-args-to-sublisp (pred arg forms)
  (cond
   ((consp forms) (cons (commonlisp-to-sublisp (car forms)) (commonlisp-args-to-sublisp pred (+ 1 arg) (cdr forms))))
   (t forms)))

;;(in-package "LISP")
;;(export '(load eval))

;;(cl::defmacro load (name &body opts) `(cl::load ,name ,@opts))

(cl::defmacro eval (name &body opts) `(like-funcall 'eval  ,name ,@opts))


;;; cl::macs.el --- Common Lisp extensions for GNU Emacs Lisp (part four)

;; Copyright (C) 1993 Free Software Foundation, Inc.

;; Author: Dave Gillespie <daveg@synaptics.com>
;; Version: 2.02
;; Keywords: extensions

;; This file is part of XEmacs.

;; XEmacs is free software; you can redistribute it and/or modify it
;; under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.

;; XEmacs is distributed in the hope that it will be useful, but
;; WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;; General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with XEmacs; see the file COPYING.  If not, write to the Free
;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
;; 02111-1307, USA.

;;; Synched up with: FSF 19.34.

;;; Commentary:

;; These are extensions to Emacs Lisp that provide a degree of
;; Common Lisp compatibility, beyond what is already built-in
;; in Emacs Lisp.
;;
;; This package was written by Dave Gillespie; it is a complete
;; rewrite of Cesar Quiroz's original cl.el package of December 1986.
;;
;; This package works with Emacs 18, Emacs 19, and Lucid Emacs 19.
;;
;; Bug reports, comments, and suggestions are welcome!

;; This file contains the portions of the Common Lisp extensions
;; package which should be autoloaded, but need only be present
;; if the compiler or interpreter is used---this file is not
;; necessary for executing compiled code.

;; See cl.el for Change Log.


;;; Code:

;;(or (memq 'cl::19 features) (error "Tried to load `cl::macs' before `cl'!"))


;;; We define these here so that this file can compile without having
;;; loaded the cl.el file already.

(cl::defmacro cl::push (x place) (list 'setq place (list 'cons x place)))
(cl::defmacro cl::pop (place)
  (list 'car (list 'prog1 place (list 'setq place (list 'cdr place)))))
(cl::defmacro cl::pop2 (place)
  (list 'prog1 (list 'car (list 'cdr place))
    (list 'setq place (list 'cdr (list 'cdr place)))))
(put 'cl::push 'edebug-form-spec 'edebug-sexps)
(put 'cl::pop 'edebug-form-spec 'edebug-sexps)
(put 'cl::pop2 'edebug-form-spec 'edebug-sexps)

(defvar cl::emacs-type)
(defvar cl::optimize-safety)
(defvar cl::optimize-speed)


;;; This kludge allows macros which use cl::transform-function-property
;;; to be called at compile-time.
#|
    (require
 (progn
   (or (fboundp 'defalias) (fset 'defalias 'fset))
   (or (fboundp 'cl::transform-function-property)
       (defalias 'cl::transform-function-property
     #'(lambda (n p f)
         (list 'put (list 'quote n) (list 'quote p)
           (list 'function (cons 'lambda f))))))
   'xemacs)))|#


;;; Initialization.

(defvar cl::old-bc-file-form nil)

;; Patch broken Emacs 18 compiler (re top-level macros).
;; Emacs 19 compiler doesn't need this patch.
;; Also, undo broken definition of `eql' that uses same bytecode as `eq'.

;;;###autoload
(defun cl::compile-time-init ()
  (setq cl::old-bc-file-form (symbol-function 'byte-compile-file-form))
  (or (fboundp 'byte-compile-flush-pending)   ; Emacs 19 compiler?
      (defalias 'byte-compile-file-form
    #'(lambda (form)
        (setq form (macroexpand form byte-compile-macro-environment))
        (if (eq (car-safe form) 'progn)
        (cons 'progn (mapcar 'byte-compile-file-form (cdr form)))
          (funcall cl::old-bc-file-form form)))))
  (put 'eql 'byte-compile 'cl::byte-compile-compiler-macro)
  (run-hooks 'cl::hack-bytecomp-hook))


;;; Program structure.

;;;###autoload
(cl::defmacro defun* (name args &rest body)
  "(defun* NAME ARGLIST [DOCSTRING] BODY...): define NAME as a function.
Like normal `defun', except ARGLIST allows full Common Lisp conventions,
and BODY is implicitly surrounded by (block NAME ...)."
  (let* ((res (cl::transform-lambda (cons args body) name))
     (form (list* 'defun name (cdr res))))
    (if (car res) (list 'progn (car res) form) form)))

;;;###autoload
(cl::defmacro cl::defmacro* (name args &rest body)
  "(cl::defmacro* NAME ARGLIST [DOCSTRING] BODY...): define NAME as a macro.
Like normal `defmacro', except ARGLIST allows full Common Lisp conventions,
and BODY is implicitly surrounded by (block NAME ...)."
  (let* ((res (cl::transform-lambda (cons args body) name))
     (form (list* 'defmacro name (cdr res))))
    (if (car res) (list 'progn (car res) form) form)))

;;;###autoload
(cl::defmacro function* (func)
  "(function* SYMBOL-OR-LAMBDA): introduce a function.
Like normal `function', except that if argument is a lambda form, its
ARGLIST allows full Common Lisp conventions."
  (if (eq (car-safe func) 'lambda)
      (let* ((res (cl::transform-lambda (cdr func) 'cl::none))
         (form (list 'function (cons 'lambda (cdr res)))))
    (if (car res) (list 'progn (car res) form) form))
    (list 'function func)))

(defun cl::transform-function-property (func prop form)
  (let ((res (cl::transform-lambda form func)))
    (append '(progn) (cdr (cdr (car res)))
        (list (list 'put (list 'quote func) (list 'quote prop)
            (list 'function (cons 'lambda (cdr res))))))))

(defconst lambda-list-keywords '(&optional &rest &key &allow-other-keys &aux &whole &body &environment))

(defvar cl::macro-environment nil)
(defvar bind-block) (defvar bind-defs) (defvar bind-enquote)
(defvar bind-inits) (defvar bind-lets) (defvar bind-forms)
(defvar arglist-visited)

;; npak@ispras.ru
(defun cl::upcase-arg (arg)
  ;; Changes all non-keyword symbols in `ARG' to symbols
  ;; with name in upper case.
  ;; ARG is either symbol or list of symbols or lists
  (cond ;;((null arg) 'NIL)
        ((symbolp arg)
         ;; Do not upcase &optional, &key etc.
         (if (memq arg lambda-list-keywords) arg
           (intern (upcase (symbol-name arg)))))
        ((listp arg)
         (if (memq arg arglist-visited) (error 'circular-list '(arg)))
         (cl::push arg arglist-visited)
         (let ((arg (copy-list arg)) junk)
           ;; Clean the list
           (let ((p (last arg))) (if (cdr p) (setcdr p (list '&rest (cdr p)))))
           (if (setq junk (cadr (memq '&cl::defs arg)))
               (setq arg (delq '&cl::defs (delq junk arg))))
           (if (memq '&cl::quote arg)
               (setq arg (delq '&cl::quote arg)))
           (mapcar 'cl::upcase-arg arg)))
        (t arg)                         ; May be we are in initializer
        ))

;; npak@ispras.ru
(defun cl::function-arglist (name arglist)
  "Returns string with printed representation of arguments list.
Supports Common Lisp lambda lists."
  (if (not (or (listp arglist) (symbolp arglist))) "Not available"
    (setq arglist-visited nil)
    (condition-case nil
        (prin1-to-string
         (cons (if (eq name 'cl::none) 'lambda name)
               (cond ((null arglist) nil)
                     ((listp arglist) (cl::upcase-arg arglist))
                     ((symbolp arglist)
                      (cl::upcase-arg (list '&rest arglist)))
                     (t (wrong-type-argument 'listp arglist)))))
      (t "Not available"))))

(defun cl::transform-lambda (form bind-block)
  (let* ((args (car form)) (body (cdr form))
     (bind-defs nil) (bind-enquote nil)
     (bind-inits nil) (bind-lets nil) (bind-forms nil)
     (header nil) (simple-args nil)
         (doc ""))
    ;; Add CL lambda list to documentation. npak@ispras.ru
    (if (and (stringp (car body))
             (cdr body))
        (setq doc (cl::pop body)))
    (cl::push (concat doc
                     "\nCommon Lisp lambda list:\n"
                     "  " (cl::function-arglist bind-block args)
                     "\n\n")
             header)

    (while (or (stringp (car body)) (eq (car-safe (car body)) 'interactive))
      (cl::push (cl::pop body) header))
    (setq args (if (listp args) (copy-list args) (list '&rest args)))
    (let ((p (last args))) (if (cdr p) (setcdr p (list '&rest (cdr p)))))
    (if (setq bind-defs (cadr (memq '&cl::defs args)))
    (setq args (delq '&cl::defs (delq bind-defs args))
          bind-defs (cadr bind-defs)))
    (if (setq bind-enquote (memq '&cl::quote args))
    (setq args (delq '&cl::quote args)))
    (if (memq '&whole args) (error "&whole not currently implemented"))
    (let* ((p (memq '&environment args)) (v (cadr p)))
      (if p (setq args (nconc (delq (car p) (delq v args))
                  (list '&aux (list v 'cl::macro-environment))))))
    (while (and args (symbolp (car args))
        (not (memq (car args) '(nil &rest &body &key &aux)))
        (not (and (eq (car args) '&optional)
              (or bind-defs (consp (cadr args))))))
      (cl::push (cl::pop args) simple-args))
    (or (eq bind-block 'cl::none)
    (setq body (list (list* 'block bind-block body))))
    (if (null args)
    (list* nil (nreverse simple-args) (nconc (nreverse header) body))
      (if (memq '&optional simple-args) (cl::push '&optional args))
      (cl::do-arglist args nil (- (length simple-args)
                 (if (memq '&optional simple-args) 1 0)))
      (setq bind-lets (nreverse bind-lets))
      (list* (and bind-inits (list* 'eval-when '(compile load eval)
                    (nreverse bind-inits)))
         (nconc (nreverse simple-args)
            (list '&rest (car (cl::pop bind-lets))))
         (nconc (nreverse header)
            (list (nconc (list 'let* bind-lets)
                 (nreverse bind-forms) body)))))))

(defun cl::do-arglist (args expr &optional num)   ; uses bind-*
  (if (nlistp args)
      (if (or (memq args lambda-list-keywords) (not (symbolp args)))
      (error "Invalid argument name: %s" args)
    (cl::push (list args expr) bind-lets))
    (setq args (copy-list args))
    (let ((p (last args))) (if (cdr p) (setcdr p (list '&rest (cdr p)))))
    (let ((p (memq '&body args))) (if p (setcar p '&rest)))
    (if (memq '&environment args) (error "&environment used incorrectly"))
    (let ((save-args args)
      (restarg (memq '&rest args))
      (safety (if (cl::compiling-file) cl::optimize-safety 3))
      (keys nil)
      (laterarg nil) (exactarg nil) minarg)
      (or num (setq num 0))
      (if (listp (cadr restarg))
      (setq restarg (gensym "--rest--"))
    (setq restarg (cadr restarg)))
      (cl::push (list restarg expr) bind-lets)
      (if (eq (car args) '&whole)
      (cl::push (list (cl::pop2 args) restarg) bind-lets))
      (let ((p args))
    (setq minarg restarg)
    (while (and p (not (memq (car p) lambda-list-keywords)))
      (or (eq p args) (setq minarg (list 'cdr minarg)))
      (setq p (cdr p)))
    (if (memq (car p) '(nil &aux))
        (setq minarg (list '= (list 'length restarg)
                   (length (ldiff args p)))
          exactarg (not (eq args p)))))
      (while (and args (not (memq (car args) lambda-list-keywords)))
    (let ((poparg (list (if (or (cdr args) (not exactarg)) 'pop 'car)
                restarg)))
      (cl::do-arglist
       (cl::pop args)
       (if (or laterarg (= safety 0)) poparg
         (list 'if minarg poparg
           (list 'signal '(quote wrong-number-of-arguments)
             (list 'list (and (not (eq bind-block 'cl::none))
                      (list 'quote bind-block))
                   (list 'length restarg)))))))
    (setq num (1+ num) laterarg t))
      (while (and (eq (car args) '&optional) (cl::pop args))
    (while (and args (not (memq (car args) lambda-list-keywords)))
      (let ((arg (cl::pop args)))
        (or (consp arg) (setq arg (list arg)))
        (if (cddr arg) (cl::do-arglist (nth 2 arg) (list 'and restarg t)))
        (let ((def (if (cdr arg) (nth 1 arg)
             (or (car bind-defs)
                 (nth 1 (assq (car arg) bind-defs)))))
          (poparg (list 'pop restarg)))
          (and def bind-enquote (setq def (list 'quote def)))
          (cl::do-arglist (car arg)
                 (if def (list 'if restarg poparg def) poparg))
          (setq num (1+ num))))))
      (if (eq (car args) '&rest)
      (let ((arg (cl::pop2 args)))
        (if (consp arg) (cl::do-arglist arg restarg)))
    (or (eq (car args) '&key) (= safety 0) exactarg
        (cl::push (list 'if restarg
               (list 'signal '(quote wrong-number-of-arguments)
                 (list 'list
                       (and (not (eq bind-block 'cl::none))
                        (list 'quote bind-block))
                       (list '+ num (list 'length restarg)))))
             bind-forms)))
      (while (and (eq (car args) '&key) (cl::pop args))
    (while (and args (not (memq (car args) lambda-list-keywords)))
      (let ((arg (cl::pop args)))
        (or (consp arg) (setq arg (list arg)))
        (let* ((karg (if (consp (car arg)) (caar arg)
               (intern (format ":%s" (car arg)))))
           (varg (if (consp (car arg)) (cadar arg) (car arg)))
           (def (if (cdr arg) (cadr arg)
              (or (car bind-defs) (cadr (assq varg bind-defs)))))
           (look (list 'memq (list 'quote karg) restarg)))
          (and def bind-enquote (setq def (list 'quote def)))
          (if (cddr arg)
          (let* ((temp (or (nth 2 arg) (gensym)))
             (val (list 'car (list 'cdr temp))))
            (cl::do-arglist temp look)
            (cl::do-arglist varg
                   (list 'if temp
                     (list 'prog1 val (list 'setq temp t))
                     def)))
        (cl::do-arglist
         varg
         (list 'car
               (list 'cdr
                 (if (null def)
                 look
                   (list 'or look
                     (if (eq (cl::const-expr-p def) t)
                     (list
                      'quote
                      (list nil (cl::const-expr-val def)))
                       (list 'list nil def))))))))
          (cl::push karg keys)
          (if (= (aref (symbol-name karg) 0) ?:)
          (progn (set karg karg)
             (cl::push (list 'setq karg (list 'quote karg))
                  bind-inits)))))))
      (setq keys (nreverse keys))
      (or (and (eq (car args) '&allow-other-keys) (cl::pop args))
      (null keys) (= safety 0)
      (let* ((var (gensym "--keys--"))
         (allow '(:allow-other-keys))
         (check (list
             'while var
             (list
              'cond
              (list (list 'memq (list 'car var)
                      (list 'quote (append keys allow)))
                (list 'setq var (list 'cdr (list 'cdr var))))
              (list (list 'car
                      (list 'cdr
                        (list 'memq (cons 'quote allow)
                          restarg)))
                (list 'setq var nil))
              (list t
                (list
                 'error
                 (format "Keyword argument %%s not one of %s"
                     keys)
                 (list 'car var)))))))
        (cl::push (list 'let (list (list var restarg)) check) bind-forms)))
      (while (and (eq (car args) '&aux) (cl::pop args))
    (while (and args (not (memq (car args) lambda-list-keywords)))
      (if (consp (car args))
          (if (and bind-enquote (cadar args))
          (cl::do-arglist (caar args)
                 (list 'quote (cadr (cl::pop args))))
        (cl::do-arglist (caar args) (cadr (cl::pop args))))
        (cl::do-arglist (cl::pop args) nil))))
      (if args (error "Malformed argument list %s" save-args)))))

(defun cl::arglist-args (args)
  (if (nlistp args) (list args)
    (let ((res nil) (kind nil) arg)
      (while (consp args)
    (setq arg (cl::pop args))
    (if (memq arg lambda-list-keywords) (setq kind arg)
      (if (eq arg '&cl::defs) (cl::pop args)
        (and (consp arg) kind (setq arg (car arg)))
        (and (consp arg) (cdr arg) (eq kind '&key) (setq arg (cadr arg)))
        (setq res (nconc res (cl::arglist-args arg))))))
      (nconc res (and args (list args))))))

;;;###autoload
(cl::defmacro destructuring-bind (args expr &rest body)
  (let* ((bind-lets nil) (bind-forms nil) (bind-inits nil)
     (bind-defs nil) (bind-block 'cl::none))
    (cl::do-arglist (or args '(&aux)) expr)
    (append '(progn) bind-inits
        (list (nconc (list 'let* (nreverse bind-lets))
             (nreverse bind-forms) body)))))


;;; The `eval-when' form.

(defvar cl::not-toplevel nil)

;;;###autoload
(cl::defmacro eval-when (when &rest body)
  "(eval-when (WHEN...) BODY...): control when BODY is evaluated.
If `compile' is in WHEN, BODY is evaluated when compiled at top-level.
If `load' is in WHEN, BODY is evaluated when loaded after top-level compile.
If `eval' is in WHEN, BODY is evaluated when interpreted or at non-top-level."
  (if (and (fboundp 'cl::compiling-file) (cl::compiling-file)
       (not cl::not-toplevel) (not (boundp 'for-effect)))  ; horrible kludge
      (let ((comp (or (memq 'compile when) (memq ':compile-toplevel when)))
        (cl::not-toplevel t))
    (if (or (memq 'load when) (memq ':load-toplevel when))
        (if comp (cons 'progn (mapcar 'cl::compile-time-too body))
          (list* 'if nil nil body))
      (progn (if comp (eval (cons 'progn body))) nil)))
    (and (or (memq 'eval when) (memq ':execute when))
     (cons 'progn body))))

(defun cl::compile-time-too (form)
  (or (and (symbolp (car-safe form)) (get (car-safe form) 'byte-hunk-handler))
      (setq form (macroexpand
          form (cons '(eval-when) byte-compile-macro-environment))))
  (cond ((eq (car-safe form) 'progn)
     (cons 'progn (mapcar 'cl::compile-time-too (cdr form))))
    ((eq (car-safe form) 'eval-when)
     (let ((when (nth 1 form)))
       (if (or (memq 'eval when) (memq ':execute when))
           (list* 'eval-when (cons 'compile when) (cddr form))
         form)))
    (t (eval form) form)))

(or (and (fboundp 'eval-when-compile)
     (not (eq (car-safe (symbol-function 'eval-when-compile)) 'autoload)))
    (eval '(cl::defmacro eval-when-compile (&rest body)
         "Like `progn', but evaluates the body at compile time.
The result of the body appears to the compiler as a quoted constant."
         (list 'quote (eval (cons 'progn body))))))

;;;###autoload
(cl::defmacro load-time-value (form &optional read-only)
  "Like `progn', but evaluates the body at load time.
The result of the body appears to the compiler as a quoted constant."
  (if (cl::compiling-file)
      (let* ((temp (gentemp "--cl::load-time--"))
         (set (list 'set (list 'quote temp) form)))
    (if (and (fboundp 'byte-compile-file-form-defmumble)
         (boundp 'this-kind) (boundp 'that-one))
        (fset 'byte-compile-file-form
          (list 'lambda '(form)
            (list 'fset '(quote byte-compile-file-form)
                  (list 'quote
                    (symbol-function 'byte-compile-file-form)))
            (list 'byte-compile-file-form (list 'quote set))
            '(byte-compile-file-form form)))
      ;; XEmacs change
      (print set (symbol-value ;;'outbuffer
                   'byte-compile-output-buffer
                   )))
    (list 'symbol-value (list 'quote temp)))
    (list 'quote (eval form))))


;;; Conditional control structures.

;;;###autoload
(cl::defmacro case (expr &rest clauses)
  "(case EXPR CLAUSES...): evals EXPR, chooses from CLAUSES on that value.
Each clause looks like (KEYLIST BODY...).  EXPR is evaluated and compared
against each key in each KEYLIST; the corresponding BODY is evaluated.
If no clause succeeds, case returns nil.  A single atom may be used in
place of a KEYLIST of one atom.  A KEYLIST of `t' or `otherwise' is
allowed only in the final clause, and matches if no other keys match.
Key values are compared by `eql'."
  (let* ((temp (if (cl::simple-expr-p expr 3) expr (gensym)))
     (head-list nil)
     (last-clause (car (last clauses)))
     (body (cons
        'cond
        (mapcar
         #'(lambda (c)
             (cons (cond ((memq (car c) '(t otherwise))
                  (or (eq c last-clause)
                      (error
                       "`%s' is allowed only as the last case clause"
                       (car c)))
                  t)
                 ((eq (car c) 'ecase-error-flag)
                  (list 'error "ecase failed: %s, %s"
                    temp (list 'quote (reverse head-list))))
                 ((listp (car c))
                  (setq head-list (append (car c) head-list))
                  (list 'member* temp (list 'quote (car c))))
                 (t
                  (if (memq (car c) head-list)
                      (error "Duplicate key in case: %s"
                         (car c)))
                  (cl::push (car c) head-list)
                  (list 'eql temp (list 'quote (car c)))))
               (or (cdr c) '(nil))))
         clauses))))
    (if (eq temp expr) body
      (list 'let (list (list temp expr)) body))))

;; #### CL standard also requires `ccase', which signals a continuable
;; error (`cerror' in XEmacs).  However, I don't think it buys us
;; anything to introduce it, as there is probably much more CL stuff
;; missing, and the feature is not essential.  --hniksic

;;;###autoload
(cl::defmacro ecase (expr &rest clauses)
  "(ecase EXPR CLAUSES...): like `case', but error if no case fits.
`otherwise'-clauses are not allowed."
  (let ((disallowed (or (assq t clauses)
            (assq 'otherwise clauses))))
    (if disallowed
    (error "`%s' is not allowed in ecase" (car disallowed))))
  (list* 'case expr (append clauses '((ecase-error-flag)))))

;;;###autoload
(cl::defmacro typecase (expr &rest clauses)
  "(typecase EXPR CLAUSES...): evals EXPR, chooses from CLAUSES on that value.
Each clause looks like (TYPE BODY...).  EXPR is evaluated and, if it
satisfies TYPE, the corresponding BODY is evaluated.  If no clause succeeds,
typecase returns nil.  A TYPE of `t' or `otherwise' is allowed only in the
final clause, and matches if no other keys match."
  (let* ((temp (if (cl::simple-expr-p expr 3) expr (gensym)))
     (type-list nil)
     (body (cons
        'cond
        (mapcar
         #'(lambda (c)
             (cons (cond ((eq (car c) 'otherwise) t)
                 ((eq (car c) 'ecase-error-flag)
                  (list 'error "etypecase failed: %s, %s"
                    temp (list 'quote (reverse type-list))))
                 (t
                  (cl::push (car c) type-list)
                  (cl::make-type-test temp (car c))))
               (or (cdr c) '(nil))))
         clauses))))
    (if (eq temp expr) body
      (list 'let (list (list temp expr)) body))))

;;;###autoload
(cl::defmacro etypecase (expr &rest clauses)
  "(etypecase EXPR CLAUSES...): like `typecase', but error if no case fits.
`otherwise'-clauses are not allowed."
  (list* 'typecase expr (append clauses '((ecase-error-flag)))))


;;; Blocks and exits.

;;;###autoload
(cl::defmacro block (name &rest body)
  "(block NAME BODY...): define a lexically-scoped block named NAME.
NAME may be any symbol.  Code inside the BODY forms can call `return-from'
to jump prematurely out of the block.  This differs from `catch' and `throw'
in two respects:  First, the NAME is an unevaluated symbol rather than a
quoted symbol or other form; and second, NAME is lexically rather than
dynamically scoped:  Only references to it within BODY will work.  These
references may appear inside macro expansions, but not inside functions
called from BODY."
  (if (cl::safe-expr-p (cons 'progn body)) (cons 'progn body)
    (list 'cl::block-wrapper
      (list* 'catch (list 'quote (intern (format "--cl::block-%s--" name)))
         body))))

(defvar cl::active-block-names nil)

(put 'cl::block-wrapper 'byte-compile 'cl::byte-compile-block)
(defun cl::byte-compile-block (cl::form)
  (if (fboundp 'byte-compile-form-do-effect)  ; Check for optimizing compiler
      (progn
    (let* ((cl::entry (cons (nth 1 (nth 1 (nth 1 cl::form))) nil))
           (cl::active-block-names (cons cl::entry cl::active-block-names))
           (cl::body (byte-compile-top-level
             (cons 'progn (cddr (nth 1 cl::form))))))
      (if (cdr cl::entry)
          (byte-compile-form (list 'catch (nth 1 (nth 1 cl::form)) cl::body))
        (byte-compile-form cl::body))))
    (byte-compile-form (nth 1 cl::form))))

(put 'cl::block-throw 'byte-compile 'cl::byte-compile-throw)
(defun cl::byte-compile-throw (cl::form)
  (let ((cl::found (assq (nth 1 (nth 1 cl::form)) cl::active-block-names)))
    (if cl::found (setcdr cl::found t)))
  (byte-compile-normal-call (cons 'throw (cdr cl::form))))

;;;###autoload
(cl::defmacro return (&optional res)
  "(return [RESULT]): return from the block named nil.
This is equivalent to `(return-from nil RESULT)'."
  (list 'return-from nil res))

;;;###autoload
(cl::defmacro return-from (name &optional res)
  "(return-from NAME [RESULT]): return from the block named NAME.
This jumps out to the innermost enclosing `(block NAME ...)' form,
returning RESULT from that form (or nil if RESULT is omitted).
This is compatible with Common Lisp, but note that `defun' and
`defmacro' do not create implicit blocks as they do in Common Lisp."
  (let ((name2 (intern (format "--cl::block-%s--" name))))
    (list 'cl::block-throw (list 'quote name2) res)))


;;; The "loop" macro.

(defvar args) (defvar loop-accum-var)
(defvar loop-accum-vars)
(defvar loop-bindings) (defvar loop-body) (defvar loop-destr-temps)
(defvar loop-finally) (defvar loop-finish-flag) (defvar loop-first-flag)
(defvar loop-initially) (defvar loop-map-form) (defvar loop-name)
(defvar loop-result) (defvar loop-result-explicit)
(defvar loop-result-var) (defvar loop-steps) (defvar loop-symbol-macs)

;;;###autoload
(cl::defmacro loop (&rest args)
  "(loop CLAUSE...): The Common Lisp `loop' macro.
Valid clauses are:
  for VAR from/upfrom/downfrom NUM to/upto/downto/above/below NUM by NUM,
  for VAR in LIST by FUNC, for VAR on LIST by FUNC, for VAR = INIT then EXPR,
  for VAR across ARRAY, repeat NUM, with VAR = INIT, while COND, until COND,
  always COND, never COND, thereis COND, collect EXPR into VAR,
  append EXPR into VAR, nconc EXPR into VAR, sum EXPR into VAR,
  count EXPR into VAR, maximize EXPR into VAR, minimize EXPR into VAR,
  if COND CLAUSE [and CLAUSE]... else CLAUSE [and CLAUSE...],
  unless COND CLAUSE [and CLAUSE]... else CLAUSE [and CLAUSE...],
  do EXPRS..., initially EXPRS..., finally EXPRS..., return EXPR,
  finally return EXPR, named NAME."
  (if (not (memq t (mapcar 'symbolp (delq nil (delq t (copy-list args))))))
      (list 'block nil (list* 'while t args))
    (let ((loop-name nil)   (loop-bindings nil)
      (loop-body nil)   (loop-steps nil)
      (loop-result nil) (loop-result-explicit nil)
      (loop-result-var nil) (loop-finish-flag nil)
      (loop-accum-var nil)  (loop-accum-vars nil)
      (loop-initially nil)  (loop-finally nil)
      (loop-map-form nil)   (loop-first-flag nil)
      (loop-destr-temps nil) (loop-symbol-macs nil))
      (setq args (append args '(cl::end-loop)))
      (while (not (eq (car args) 'cl::end-loop)) (cl::parse-loop-clause))
      (if loop-finish-flag
      (cl::push (list (list loop-finish-flag t)) loop-bindings))
      (if loop-first-flag
      (progn (cl::push (list (list loop-first-flag t)) loop-bindings)
         (cl::push (list 'setq loop-first-flag nil) loop-steps)))
      (let* ((epilogue (nconc (nreverse loop-finally)
                  (list (or loop-result-explicit loop-result))))
         (ands (cl::loop-build-ands (nreverse loop-body)))
         (while-body (nconc (cadr ands) (nreverse loop-steps)))
         (body (append
            (nreverse loop-initially)
            (list (if loop-map-form
                  (list 'block '--cl::finish--
                    (subst
                     (if (eq (car ands) t) while-body
                       (cons (list 'or (car ands)
                           '(return-from --cl::finish--
                              nil))
                         while-body))
                     '--cl::map loop-map-form))
                (list* 'while (car ands) while-body)))
            (if loop-finish-flag
            (if (equal epilogue '(nil)) (list loop-result-var)
              (list (list 'if loop-finish-flag
                      (cons 'progn epilogue) loop-result-var)))
              epilogue))))
    (if loop-result-var (cl::push (list loop-result-var) loop-bindings))
    (while loop-bindings
      (if (cdar loop-bindings)
          (setq body (list (cl::loop-let (cl::pop loop-bindings) body t)))
        (let ((lets nil))
          (while (and loop-bindings
              (not (cdar loop-bindings)))
        (cl::push (car (cl::pop loop-bindings)) lets))
          (setq body (list (cl::loop-let lets body nil))))))
    (if loop-symbol-macs
        (setq body (list (list* 'symbol-macrolet loop-symbol-macs body))))
    (list* 'block loop-name body)))))

(defun cl::parse-loop-clause ()   ; uses args, loop-*
  (let ((word (cl::pop args))
    (hash-types '(hash-key hash-keys hash-value hash-values))
    (key-types '(key-code key-codes key-seq key-seqs
             key-binding key-bindings)))
    (cond

     ((null args)
      (error "Malformed `loop' macro"))

     ((eq word 'named)
      (setq loop-name (cl::pop args)))

     ((eq word 'initially)
      (if (memq (car args) '(do doing)) (cl::pop args))
      (or (consp (car args)) (error "Syntax error on `initially' clause"))
      (while (consp (car args))
    (cl::push (cl::pop args) loop-initially)))

     ((eq word 'finally)
      (if (eq (car args) 'return)
      (setq loop-result-explicit (or (cl::pop2 args) '(quote nil)))
    (if (memq (car args) '(do doing)) (cl::pop args))
    (or (consp (car args)) (error "Syntax error on `finally' clause"))
    (if (and (eq (caar args) 'return) (null loop-name))
        (setq loop-result-explicit (or (nth 1 (cl::pop args)) '(quote nil)))
      (while (consp (car args))
        (cl::push (cl::pop args) loop-finally)))))

     ((memq word '(for as))
      (let ((loop-for-bindings nil) (loop-for-sets nil) (loop-for-steps nil)
        (ands nil))
    (while
        (let ((var (or (cl::pop args) (gensym))))
          (setq word (cl::pop args))
          (if (eq word 'being) (setq word (cl::pop args)))
          (if (memq word '(the each)) (setq word (cl::pop args)))
          (if (memq word '(buffer buffers))
          (setq word 'in args (cons '(buffer-list) args)))
          (cond

           ((memq word '(from downfrom upfrom to downto upto
                 above below by))
        (cl::push word args)
        (if (memq (car args) '(downto above))
            (error "Must specify `from' value for downward loop"))
        (let* ((down (or (eq (car args) 'downfrom)
                 (memq (caddr args) '(downto above))))
               (excl (or (memq (car args) '(above below))
                 (memq (caddr args) '(above below))))
               (start (and (memq (car args) '(from upfrom downfrom))
                   (cl::pop2 args)))
               (end (and (memq (car args)
                       '(to upto downto above below))
                 (cl::pop2 args)))
               (step (and (eq (car args) 'by) (cl::pop2 args)))
               (end-var (and (not (cl::const-expr-p end)) (gensym)))
               (step-var (and (not (cl::const-expr-p step))
                      (gensym))))
          (and step (numberp step) (<= step 0)
               (error "Loop `by' value is not positive: %s" step))
          (cl::push (list var (or start 0)) loop-for-bindings)
          (if end-var (cl::push (list end-var end) loop-for-bindings))
          (if step-var (cl::push (list step-var step)
                    loop-for-bindings))
          (if end
              (cl::push (list
                (if down (if excl '> '>=) (if excl '< '<=))
                var (or end-var end)) loop-body))
          (cl::push (list var (list (if down '- '+) var
                       (or step-var step 1)))
               loop-for-steps)))

           ((memq word '(in in-ref on))
        (let* ((on (eq word 'on))
               (temp (if (and on (symbolp var)) var (gensym))))
          (cl::push (list temp (cl::pop args)) loop-for-bindings)
          (cl::push (list 'consp temp) loop-body)
          (if (eq word 'in-ref)
              (cl::push (list var (list 'car temp)) loop-symbol-macs)
            (or (eq temp var)
            (progn
              (cl::push (list var nil) loop-for-bindings)
              (cl::push (list var (if on temp (list 'car temp)))
                   loop-for-sets))))
          (cl::push (list temp
                 (if (eq (car args) 'by)
                     (let ((step (cl::pop2 args)))
                       (if (and (memq (car-safe step)
                              '(quote function
                                  function*))
                        (symbolp (nth 1 step)))
                       (list (nth 1 step) temp)
                     (list 'funcall step temp)))
                   (list 'cdr temp)))
               loop-for-steps)))

           ((eq word '=)
        (let* ((start (cl::pop args))
               (then (if (eq (car args) 'then) (cl::pop2 args) start)))
          (cl::push (list var nil) loop-for-bindings)
          (if (or ands (eq (car args) 'and))
              (progn
            (cl::push (list var
                       (list 'if
                         (or loop-first-flag
                         (setq loop-first-flag
                               (gensym)))
                         start var))
                 loop-for-sets)
            (cl::push (list var then) loop-for-steps))
            (cl::push (list var
                   (if (eq start then) start
                     (list 'if
                       (or loop-first-flag
                           (setq loop-first-flag (gensym)))
                       start then)))
                 loop-for-sets))))

           ((memq word '(across across-ref))
        (let ((temp-vec (gensym)) (temp-idx (gensym)))
          (cl::push (list temp-vec (cl::pop args)) loop-for-bindings)
          (cl::push (list temp-idx -1) loop-for-bindings)
          (cl::push (list '< (list 'setq temp-idx (list '1+ temp-idx))
                 (list 'length temp-vec)) loop-body)
          (if (eq word 'across-ref)
              (cl::push (list var (list 'aref temp-vec temp-idx))
                   loop-symbol-macs)
            (cl::push (list var nil) loop-for-bindings)
            (cl::push (list var (list 'aref temp-vec temp-idx))
                 loop-for-sets))))

           ((memq word '(element elements))
        (let ((ref (or (memq (car args) '(in-ref of-ref))
                   (and (not (memq (car args) '(in of)))
                    (error "Expected `of'"))))
              (seq (cl::pop2 args))
              (temp-seq (gensym))
              (temp-idx (if (eq (car args) 'using)
                    (if (and (= (length (cadr args)) 2)
                         (eq (caadr args) 'index))
                    (cadr (cl::pop2 args))
                      (error "Bad `using' clause"))
                  (gensym))))
          (cl::push (list temp-seq seq) loop-for-bindings)
          (cl::push (list temp-idx 0) loop-for-bindings)
          (if ref
              (let ((temp-len (gensym)))
            (cl::push (list temp-len (list 'length temp-seq))
                 loop-for-bindings)
            (cl::push (list var (list 'elt temp-seq temp-idx))
                 loop-symbol-macs)
            (cl::push (list '< temp-idx temp-len) loop-body))
            (cl::push (list var nil) loop-for-bindings)
            (cl::push (list 'and temp-seq
                   (list 'or (list 'consp temp-seq)
                     (list '< temp-idx
                           (list 'length temp-seq))))
                 loop-body)
            (cl::push (list var (list 'if (list 'consp temp-seq)
                         (list 'pop temp-seq)
                         (list 'aref temp-seq temp-idx)))
                 loop-for-sets))
          (cl::push (list temp-idx (list '1+ temp-idx))
               loop-for-steps)))

           ((memq word hash-types)
        (or (memq (car args) '(in of)) (error "Expected `of'"))
        (let* ((table (cl::pop2 args))
               (other (if (eq (car args) 'using)
                  (if (and (= (length (cadr args)) 2)
                       (memq (caadr args) hash-types)
                       (not (eq (caadr args) word)))
                      (cadr (cl::pop2 args))
                    (error "Bad `using' clause"))
                (gensym))))
          (if (memq word '(hash-value hash-values))
              (setq var (prog1 other (setq other var))))
          (setq loop-map-form
            (list 'maphash (list 'function
                         (list* 'lambda (list var other)
                            '--cl::map)) table))))

           ((memq word '(symbol present-symbol external-symbol
                 symbols present-symbols external-symbols))
        (let ((ob (and (memq (car args) '(in of)) (cl::pop2 args))))
          (setq loop-map-form
            (list 'mapatoms (list 'function
                          (list* 'lambda (list var)
                             '--cl::map)) ob))))

           ((memq word '(overlay overlays extent extents))
        (let ((buf nil) (from nil) (to nil))
          (while (memq (car args) '(in of from to))
            (cond ((eq (car args) 'from) (setq from (cl::pop2 args)))
              ((eq (car args) 'to) (setq to (cl::pop2 args)))
              (t (setq buf (cl::pop2 args)))))
          (setq loop-map-form
            (list 'cl::map-extents
                  (list 'function (list 'lambda (list var (gensym))
                            '(progn . --cl::map) nil))
                  buf from to))))

           ((memq word '(interval intervals))
        (let ((buf nil) (prop nil) (from nil) (to nil)
              (var1 (gensym)) (var2 (gensym)))
          (while (memq (car args) '(in of property from to))
            (cond ((eq (car args) 'from) (setq from (cl::pop2 args)))
              ((eq (car args) 'to) (setq to (cl::pop2 args)))
              ((eq (car args) 'property)
               (setq prop (cl::pop2 args)))
              (t (setq buf (cl::pop2 args)))))
          (if (and (consp var) (symbolp (car var)) (symbolp (cdr var)))
              (setq var1 (car var) var2 (cdr var))
            (cl::push (list var (list 'cons var1 var2)) loop-for-sets))
          (setq loop-map-form
            (list 'cl::map-intervals
                  (list 'function (list 'lambda (list var1 var2)
                            '(progn . --cl::map)))
                  buf prop from to))))

           ((memq word key-types)
        (or (memq (car args) '(in of)) (error "Expected `of'"))
        (let ((map (cl::pop2 args))
              (other (if (eq (car args) 'using)
                 (if (and (= (length (cadr args)) 2)
                      (memq (caadr args) key-types)
                      (not (eq (caadr args) word)))
                     (cadr (cl::pop2 args))
                   (error "Bad `using' clause"))
                   (gensym))))
          (if (memq word '(key-binding key-bindings))
              (setq var (prog1 other (setq other var))))
          (setq loop-map-form
            (list (if (memq word '(key-seq key-seqs))
                  'cl::map-keymap-recursively 'cl::map-keymap)
                  (list 'function (list* 'lambda (list var other)
                             '--cl::map)) map))))

           ((memq word '(frame frames screen screens))
        (let ((temp (gensym)))
          (cl::push (list var '(selected-frame))
               loop-for-bindings)
          (cl::push (list temp nil) loop-for-bindings)
          (cl::push (list 'prog1 (list 'not (list 'eq var temp))
                 (list 'or temp (list 'setq temp var)))
               loop-body)
          (cl::push (list var (list 'next-frame var))
               loop-for-steps)))

           ((memq word '(window windows))
        (let ((scr (and (memq (car args) '(in of)) (cl::pop2 args)))
              (temp (gensym)))
          (cl::push (list var (if scr
                     (list 'frame-selected-window scr)
                       '(selected-window)))
               loop-for-bindings)
          (cl::push (list temp nil) loop-for-bindings)
          (cl::push (list 'prog1 (list 'not (list 'eq var temp))
                 (list 'or temp (list 'setq temp var)))
               loop-body)
          (cl::push (list var (list 'next-window var)) loop-for-steps)))

           (t
        (let ((handler (and (symbolp word)
                    (get word 'cl::loop-for-handler))))
          (if handler
              (funcall handler var)
            (error "Expected a `for' preposition, found %s" word)))))
          (eq (car args) 'and))
      (setq ands t)
      (cl::pop args))
    (if (and ands loop-for-bindings)
        (cl::push (nreverse loop-for-bindings) loop-bindings)
      (setq loop-bindings (nconc (mapcar 'list loop-for-bindings)
                     loop-bindings)))
    (if loop-for-sets
        (cl::push (list 'progn
               (cl::loop-let (nreverse loop-for-sets) 'setq ands)
               t) loop-body))
    (if loop-for-steps
        (cl::push (cons (if ands 'psetq 'setq)
               (apply 'append (nreverse loop-for-steps)))
             loop-steps))))

     ((eq word 'repeat)
      (let ((temp (gensym)))
    (cl::push (list (list temp (cl::pop args))) loop-bindings)
    (cl::push (list '>= (list 'setq temp (list '1- temp)) 0) loop-body)))

     ((eq word 'collect)
      (let ((what (cl::pop args))
        (var (cl::loop-handle-accum nil 'nreverse)))
    (if (eq var loop-accum-var)
        (cl::push (list 'progn (list 'push what var) t) loop-body)
      (cl::push (list 'progn
             (list 'setq var (list 'nconc var (list 'list what)))
             t) loop-body))))

     ((memq word '(nconc nconcing append appending))
      (let ((what (cl::pop args))
        (var (cl::loop-handle-accum nil 'nreverse)))
    (cl::push (list 'progn
               (list 'setq var
                 (if (eq var loop-accum-var)
                 (list 'nconc
                       (list (if (memq word '(nconc nconcing))
                         'nreverse 'reverse)
                         what)
                       var)
                   (list (if (memq word '(nconc nconcing))
                     'nconc 'append)
                     var what))) t) loop-body)))

     ((memq word '(concat concating))
      (let ((what (cl::pop args))
        (var (cl::loop-handle-accum "")))
    (cl::push (list 'progn (list 'callf 'concat var what) t) loop-body)))

     ((memq word '(vconcat vconcating))
      (let ((what (cl::pop args))
        (var (cl::loop-handle-accum [])))
    (cl::push (list 'progn (list 'callf 'vconcat var what) t) loop-body)))

     ((memq word '(sum summing))
      (let ((what (cl::pop args))
        (var (cl::loop-handle-accum 0)))
    (cl::push (list 'progn (list 'incf var what) t) loop-body)))

     ((memq word '(count counting))
      (let ((what (cl::pop args))
        (var (cl::loop-handle-accum 0)))
    (cl::push (list 'progn (list 'if what (list 'incf var)) t) loop-body)))

     ((memq word '(minimize minimizing maximize maximizing))
      (let* ((what (cl::pop args))
         (temp (if (cl::simple-expr-p what) what (gensym)))
         (var (cl::loop-handle-accum nil))
         (func (intern (substring (symbol-name word) 0 3)))
         (set (list 'setq var (list 'if var (list func var temp) temp))))
    (cl::push (list 'progn (if (eq temp what) set
                (list 'let (list (list temp what)) set))
               t) loop-body)))

     ((eq word 'with)
      (let ((bindings nil))
    (while (progn (cl::push (list (cl::pop args)
                     (and (eq (car args) '=) (cl::pop2 args)))
                   bindings)
              (eq (car args) 'and))
      (cl::pop args))
    (cl::push (nreverse bindings) loop-bindings)))

     ((eq word 'while)
      (cl::push (cl::pop args) loop-body))

     ((eq word 'until)
      (cl::push (list 'not (cl::pop args)) loop-body))

     ((eq word 'always)
      (or loop-finish-flag (setq loop-finish-flag (gensym)))
      (cl::push (list 'setq loop-finish-flag (cl::pop args)) loop-body)
      (setq loop-result t))

     ((eq word 'never)
      (or loop-finish-flag (setq loop-finish-flag (gensym)))
      (cl::push (list 'setq loop-finish-flag (list 'not (cl::pop args)))
           loop-body)
      (setq loop-result t))

     ((eq word 'thereis)
      (or loop-finish-flag (setq loop-finish-flag (gensym)))
      (or loop-result-var (setq loop-result-var (gensym)))
      (cl::push (list 'setq loop-finish-flag
             (list 'not (list 'setq loop-result-var (cl::pop args))))
           loop-body))

     ((memq word '(if when unless))
      (let* ((cond (cl::pop args))
         (then (let ((loop-body nil))
             (cl::parse-loop-clause)
             (cl::loop-build-ands (nreverse loop-body))))
         (else (let ((loop-body nil))
             (if (eq (car args) 'else)
             (progn (cl::pop args) (cl::parse-loop-clause)))
             (cl::loop-build-ands (nreverse loop-body))))
         (simple (and (eq (car then) t) (eq (car else) t))))
    (if (eq (car args) 'end) (cl::pop args))
    (if (eq word 'unless) (setq then (prog1 else (setq else then))))
    (let ((form (cons (if simple (cons 'progn (nth 1 then)) (nth 2 then))
              (if simple (nth 1 else) (list (nth 2 else))))))
      (if (cl::expr-contains form 'it)
          (let ((temp (gensym)))
        (cl::push (list temp) loop-bindings)
        (setq form (list* 'if (list 'setq temp cond)
                  (subst temp 'it form))))
        (setq form (list* 'if cond form)))
      (cl::push (if simple (list 'progn form t) form) loop-body))))

     ((memq word '(do doing))
      (let ((body nil))
    (or (consp (car args)) (error "Syntax error on `do' clause"))
    (while (consp (car args)) (cl::push (cl::pop args) body))
    (cl::push (cons 'progn (nreverse (cons t body))) loop-body)))

     ((eq word 'return)
      (or loop-finish-flag (setq loop-finish-flag (gensym)))
      (or loop-result-var (setq loop-result-var (gensym)))
      (cl::push (list 'setq loop-result-var (cl::pop args)
             loop-finish-flag nil) loop-body))

     (t
      (let ((handler (and (symbolp word) (get word 'cl::loop-handler))))
    (or handler (error "Expected a loop keyword, found %s" word))
    (funcall handler))))
    (if (eq (car args) 'and)
    (progn (cl::pop args) (cl::parse-loop-clause)))))

(defun cl::loop-let (specs body par)   ; uses loop-*
  (let ((p specs) (temps nil) (new nil))
    (while (and p (or (symbolp (car-safe (car p))) (null (cadar p))))
      (setq p (cdr p)))
    (and par p
     (progn
       (setq par nil p specs)
       (while p
         (or (cl::const-expr-p (cadar p))
         (let ((temp (gensym)))
           (cl::push (list temp (cadar p)) temps)
           (setcar (cdar p) temp)))
         (setq p (cdr p)))))
    (while specs
      (if (and (consp (car specs)) (listp (caar specs)))
      (let* ((spec (caar specs)) (nspecs nil)
         (expr (cadr (cl::pop specs)))
         (temp (cdr (or (assq spec loop-destr-temps)
                (car (cl::push (cons spec (or (last spec 0)
                                 (gensym)))
                          loop-destr-temps))))))
        (cl::push (list temp expr) new)
        (while (consp spec)
          (cl::push (list (cl::pop spec)
                 (and expr (list (if spec 'pop 'car) temp)))
               nspecs))
        (setq specs (nconc (nreverse nspecs) specs)))
    (cl::push (cl::pop specs) new)))
    (if (eq body 'setq)
    (let ((set (cons (if par 'psetq 'setq) (apply 'nconc (nreverse new)))))
      (if temps (list 'let* (nreverse temps) set) set))
      (list* (if par 'let 'let*)
         (nconc (nreverse temps) (nreverse new)) body))))

(defun cl::loop-handle-accum (def &optional func)   ; uses args, loop-*
  (if (eq (car args) 'into)
      (let ((var (cl::pop2 args)))
    (or (memq var loop-accum-vars)
        (progn (cl::push (list (list var def)) loop-bindings)
           (cl::push var loop-accum-vars)))
    var)
    (or loop-accum-var
    (progn
      (cl::push (list (list (setq loop-accum-var (gensym)) def))
           loop-bindings)
      (setq loop-result (if func (list func loop-accum-var)
                  loop-accum-var))
      loop-accum-var))))

(defun cl::loop-build-ands (clauses)
  (let ((ands nil)
    (body nil))
    (while clauses
      (if (and (eq (car-safe (car clauses)) 'progn)
           (eq (car (last (car clauses))) t))
      (if (cdr clauses)
          (setq clauses (cons (nconc (butlast (car clauses))
                     (if (eq (car-safe (cadr clauses))
                         'progn)
                         (cdadr clauses)
                       (list (cadr clauses))))
                  (cddr clauses)))
        (setq body (cdr (butlast (cl::pop clauses)))))
    (cl::push (cl::pop clauses) ands)))
    (setq ands (or (nreverse ands) (list t)))
    (list (if (cdr ands) (cons 'and ands) (car ands))
      body
      (let ((full (if body
              (append ands (list (cons 'progn (append body '(t)))))
            ands)))
        (if (cdr full) (cons 'and full) (car full))))))


;;; Other iteration control structures.

;;;###autoload
(cl::defmacro do (steps endtest &rest body)
  "The Common Lisp `do' loop.
Format is: (do ((VAR INIT [STEP])...) (END-TEST [RESULT...]) BODY...)"
  (cl::expand-do-loop steps endtest body nil))

;;;###autoload
(cl::defmacro do* (steps endtest &rest body)
  "The Common Lisp `do*' loop.
Format is: (do* ((VAR INIT [STEP])...) (END-TEST [RESULT...]) BODY...)"
  (cl::expand-do-loop steps endtest body t))

(defun cl::expand-do-loop (steps endtest body star)
  (list 'block nil
    (list* (if star 'let* 'let)
           (mapcar #'(lambda (c) (if (consp c) (list (car c) (nth 1 c)) c))
               steps)
           (list* 'while (list 'not (car endtest))
              (append body
                  (let ((sets (mapcar
                       #'(lambda (c)
                           (and (consp c) (cdr (cdr c))
                            (list (car c) (nth 2 c))))
                       steps)))
                (setq sets (delq nil sets))
                (and sets
                     (list (cons (if (or star (not (cdr sets)))
                             'setq 'psetq)
                         (apply 'append sets)))))))
           (or (cdr endtest) '(nil)))))

;;;###autoload
(cl::defmacro dolist (spec &rest body)
  "(dolist (VAR LIST [RESULT]) BODY...): loop over a list.
Evaluate BODY with VAR bound to each `car' from LIST, in turn.
Then evaluate RESULT to get return value, default nil."
  (let ((temp (gensym "--dolist-temp--")))
    (list 'block nil
      (list* 'let (list (list temp (nth 1 spec)) (car spec))
         (list* 'while temp (list 'setq (car spec) (list 'car temp))
            (append body (list (list 'setq temp
                         (list 'cdr temp)))))
         (if (cdr (cdr spec))
             (cons (list 'setq (car spec) nil) (cdr (cdr spec)))
           '(nil))))))

;;;###autoload
(cl::defmacro dotimes (spec &rest body)
  "(dotimes (VAR COUNT [RESULT]) BODY...): loop a certain number of times.
Evaluate BODY with VAR bound to successive integers from 0, inclusive,
to COUNT, exclusive.  Then evaluate RESULT to get return value, default
nil."
  (let ((temp (gensym "--dotimes-temp--")))
    (list 'block nil
      (list* 'let (list (list temp (nth 1 spec)) (list (car spec) 0))
         (list* 'while (list '< (car spec) temp)
            (append body (list (list 'incf (car spec)))))
         (or (cdr (cdr spec)) '(nil))))))

;;;###autoload
(cl::defmacro do-symbols (spec &rest body)
  "(dosymbols (VAR [OBARRAY [RESULT]]) BODY...): loop over all symbols.
Evaluate BODY with VAR bound to each interned symbol, or to each symbol
from OBARRAY."
  ;; Apparently this doesn't have an implicit block.
  (list 'block nil
    (list 'let (list (car spec))
          (list* 'mapatoms
             (list 'function (list* 'lambda (list (car spec)) body))
             (and (cadr spec) (list (cadr spec))))
          (caddr spec))))

;;;###autoload
(cl::defmacro do-all-symbols (spec &rest body)
  (list* 'do-symbols (list (car spec) nil (cadr spec)) body))


;;; Assignments.

;;;###autoload
(cl::defmacro psetq (&rest args)
  "(psetq SYM VAL SYM VAL ...): set SYMs to the values VALs in parallel.
This is like `setq', except that all VAL forms are evaluated (in order)
before assigning any symbols SYM to the corresponding values."
  (cons 'psetf args))


;;; Binding control structures.

;;;###autoload
(cl::defmacro progv (symbols values &rest body)
  "(progv SYMBOLS VALUES BODY...): bind SYMBOLS to VALUES dynamically in BODY.
The forms SYMBOLS and VALUES are evaluated, and must evaluate to lists.
Each SYMBOL in the first list is bound to the corresponding VALUE in the
second list (or made unbound if VALUES is shorter than SYMBOLS); then the
BODY forms are executed and their result is returned.  This is much like
a `let' form, except that the list of symbols can be computed at run-time."
  (list 'let '((cl::progv-save nil))
    (list 'unwind-protect
          (list* 'progn (list 'cl::progv-before symbols values) body)
          '(cl::progv-after))))

;;; This should really have some way to shadow 'byte-compile properties, etc.
;;;###autoload
(cl::defmacro flet (bindings &rest body)
  "(flet ((FUNC ARGLIST BODY...) ...) FORM...): make temporary function defns.
This is an analogue of `let' that operates on the function cell of FUNC
rather than its value cell.  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)."
  (list* 'letf*
     (mapcar
      #'(lambda (x)
          (if (or (and (fboundp (car x))
               (eq (car-safe (symbol-function (car x))) 'macro))
              (cdr (assq (car x) cl::macro-environment)))
          (error "Use `labels', not `flet', to rebind macro names"))
          (let ((func (list 'function*
                (list 'lambda (cadr x)
                      (list* 'block (car x) (cddr x))))))
        (if (and (cl::compiling-file)
             (boundp 'byte-compile-function-environment))
            (cl::push (cons (car x) (eval func))
                 byte-compile-function-environment))
        (list (list 'symbol-function (list 'quote (car x))) func)))
      bindings)
     body))

;;;###autoload
(cl::defmacro labels (bindings &rest body)
  "(labels ((FUNC ARGLIST BODY...) ...) FORM...): make temporary func bindings.
This is like `flet', except the bindings are lexical instead of dynamic.
Unlike `flet', this macro is fully compliant with the Common Lisp standard."
  (let ((vars nil) (sets nil) (cl::macro-environment cl::macro-environment))
    (while bindings
      (let ((var (gensym)))
    (cl::push var vars)
    (cl::push (list 'function* (cons 'lambda (cdar bindings))) sets)
    (cl::push var sets)
    (cl::push (list (car (cl::pop bindings)) 'lambda '(&rest cl::labels-args)
               (list 'list* '(quote funcall) (list 'quote var)
                 'cl::labels-args))
         cl::macro-environment)))
    (cl::macroexpand-all (list* 'lexical-let vars (cons (cons 'setq sets) body))
            cl::macro-environment)))

;; The following ought to have a better definition for use with newer
;; byte compilers.
;;;###autoload
(cl::defmacro macrolet (bindings &rest body)
  "(macrolet ((NAME ARGLIST BODY...) ...) FORM...): make temporary macro defns.
This is like `flet', but for macros instead of functions."
  (if (cdr bindings)
      (list 'macrolet
        (list (car bindings)) (list* 'macrolet (cdr bindings) body))
    (if (null bindings) (cons 'progn body)
      (let* ((name (caar bindings))
         (res (cl::transform-lambda (cdar bindings) name)))
    (eval (car res))
    (cl::macroexpand-all (cons 'progn body)
                (cons (list* name 'lambda (cdr res))
                  cl::macro-environment))))))

;;;###autoload
(cl::defmacro symbol-macrolet (bindings &rest body)
  "(symbol-macrolet ((NAME EXPANSION) ...) FORM...): make symbol macro defns.
Within the body FORMs, references to the variable NAME will be replaced
by EXPANSION, and (setq NAME ...) will act like (setf EXPANSION ...)."
  (if (cdr bindings)
      (list 'symbol-macrolet
        (list (car bindings)) (list* 'symbol-macrolet (cdr bindings) body))
    (if (null bindings) (cons 'progn body)
      (cl::macroexpand-all (cons 'progn body)
              (cons (list (symbol-name (caar bindings))
                      (cadar bindings))
                cl::macro-environment)))))

(defvar cl::closure-vars nil)
;;;###autoload
(cl::defmacro lexical-let (bindings &rest body)
  "(lexical-let BINDINGS BODY...): like `let', but lexically scoped.
The main visible difference is that lambdas inside BODY will create
lexical closures as in Common Lisp."
  (let* ((cl::closure-vars cl::closure-vars)
     (vars (mapcar #'(lambda (x)
               (or (consp x) (setq x (list x)))
               (cl::push (gensym (format "--%s--" (car x)))
                    cl::closure-vars)
               (list (car x) (cadr x) (car cl::closure-vars)))
               bindings))
     (ebody
      (cl::macroexpand-all
       (cons 'progn body)
       (nconc (mapcar #'(lambda (x)
                  (list (symbol-name (car x))
                    (list 'symbol-value (caddr x))
                    t))
              vars)
          (list '(defun . cl::defun-expander))
          cl::macro-environment))))
    (if (not (get (car (last cl::closure-vars)) 'used))
    (list 'let (mapcar #'(lambda (x) (list (caddr x) (cadr x))) vars)
          (sublis (mapcar #'(lambda (x)
                  (cons (caddr x) (list 'quote (caddr x))))
                  vars)
              ebody))
      (list 'let (mapcar #'(lambda (x)
                 (list (caddr x)
                   (list 'make-symbol
                     (format "--%s--" (car x)))))
             vars)
        (apply 'append '(setf)
           (mapcar #'(lambda (x)
                   (list (list 'symbol-value (caddr x)) (cadr x)))
               vars))
        ebody))))

;;;###autoload
(cl::defmacro lexical-let* (bindings &rest body)
  "(lexical-let* BINDINGS BODY...): like `let*', but lexically scoped.
The main visible difference is that lambdas inside BODY will create
lexical closures as in Common Lisp."
  (if (null bindings) (cons 'progn body)
    (setq bindings (reverse bindings))
    (while bindings
      (setq body (list (list* 'lexical-let (list (cl::pop bindings)) body))))
    (car body)))

(defun cl::defun-expander (func &rest rest)
  (list 'progn
    (list 'defalias (list 'quote func)
          (list 'function (cons 'lambda rest)))
    (list 'quote func)))


;;; Multiple values.

;;;###autoload
(cl::defmacro multiple-value-bind (vars form &rest body)
  "(multiple-value-bind (SYM SYM...) FORM BODY): collect multiple return values.
FORM must return a list; the BODY is then executed with the first N elements
of this list bound (`let'-style) to each of the symbols SYM in turn.  This
is analogous to the Common Lisp `multiple-value-bind' macro, using lists to
simulate true multiple return values.  For compatibility, (values A B C) is
a synonym for (list A B C)."
  (let ((temp (gensym)) (n -1))
    (list* 'let* (cons (list temp form)
               (mapcar #'(lambda (v)
                   (list v (list 'nth (setq n (1+ n)) temp)))
                   vars))
       body)))

;;;###autoload
(cl::defmacro multiple-value-setq (vars form)
  "(multiple-value-setq (SYM SYM...) FORM): collect multiple return values.
FORM must return a list; the first N elements of this list are stored in
each of the symbols SYM in turn.  This is analogous to the Common Lisp
`multiple-value-setq' macro, using lists to simulate true multiple return
values.  For compatibility, (values A B C) is a synonym for (list A B C)."
  (cond ((null vars) (list 'progn form nil))
    ((null (cdr vars)) (list 'setq (car vars) (list 'car form)))
    (t
     (let* ((temp (gensym)) (n 0))
       (list 'let (list (list temp form))
         (list 'prog1 (list 'setq (cl::pop vars) (list 'car temp))
               (cons 'setq
                 (apply 'nconc
                    (mapcar
                     #'(lambda (v)
                     (list v (list
                          'nth
                          (setq n (1+ n))
                          temp)))
                        vars)))))))))


;;; Declarations.

;;;###autoload
(cl::defmacro locally (&rest body) (cons 'progn body))
;;;###autoload
(cl::defmacro the (type form) form)

(defvar cl::proclaim-history t)    ; for future compilers
(defvar cl::declare-stack t)       ; for future compilers

(defun cl::do-proclaim (spec hist)
  (and hist (listp cl::proclaim-history) (cl::push spec cl::proclaim-history))
  (cond ((eq (car-safe spec) 'special)
     (if (boundp 'byte-compile-bound-variables)
         (setq byte-compile-bound-variables
           (append
            (mapcar #'(lambda (v) (cons v byte-compile-global-bit))
                (cdr spec))
            byte-compile-bound-variables))))

    ((eq (car-safe spec) 'inline)
     (while (setq spec (cdr spec))
       (or (memq (get (car spec) 'byte-optimizer)
             '(nil byte-compile-inline-expand))
           (error "%s already has a byte-optimizer, can't make it inline"
              (car spec)))
       (put (car spec) 'byte-optimizer 'byte-compile-inline-expand)))

    ((eq (car-safe spec) 'notinline)
     (while (setq spec (cdr spec))
       (if (eq (get (car spec) 'byte-optimizer)
           'byte-compile-inline-expand)
           (put (car spec) 'byte-optimizer nil))))

    ((eq (car-safe spec) 'optimize)
     (let ((speed (assq (nth 1 (assq 'speed (cdr spec)))
                '((0 . nil) (1 . t) (2 . t) (3 . t))))
           (safety (assq (nth 1 (assq 'safety (cdr spec)))
                 '((0 . t) (1 . t) (2 . t) (3 . nil)))))
       (when speed
         (setq cl::optimize-speed (car speed)
           byte-optimize (cdr speed)))
       (when safety
         (setq cl::optimize-safety (car safety)
           byte-compile-delete-errors (cdr safety)))))

    ((and (eq (car-safe spec) 'warn) (boundp 'byte-compile-warnings))
     (if (eq byte-compile-warnings t)
         ;; XEmacs change
         (setq byte-compile-warnings byte-compile-default-warnings))
     (while (setq spec (cdr spec))
       (if (consp (car spec))
           (if (eq (cadar spec) 0)
           (setq byte-compile-warnings
             (delq (caar spec) byte-compile-warnings))
         (setq byte-compile-warnings
               (adjoin (caar spec) byte-compile-warnings)))))))
  nil)

;;; Process any proclamations made before cl::macs was loaded.
(defvar cl::proclaims-deferred)
(let ((p (reverse cl::proclaims-deferred)))
  (while p (cl::do-proclaim (cl::pop p) t))
  (setq cl::proclaims-deferred nil))

;;;###autoload
(cl::defmacro declare (&rest specs)
  (if (cl::compiling-file)
      (while specs
    (if (listp cl::declare-stack) (cl::push (car specs) cl::declare-stack))
    (cl::do-proclaim (cl::pop specs) nil)))
  nil)



;;; Generalized variables.

;;;###autoload
(cl::defmacro define-setf-method (func args &rest body)
  "(define-setf-method NAME ARGLIST BODY...): 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 `defsetf' for a simpler way to define most setf-methods."
  (append '(eval-when (compile load eval))
      (if (stringp (car body))
          (list (list 'put (list 'quote func) '(quote setf-documentation)
              (cl::pop body))))
      (list (cl::transform-function-property
         func 'setf-method (cons args body)))))

;;;###autoload
(cl::defmacro defsetf (func arg1 &rest args)
  "(defsetf NAME FUNC): define a `setf' method.
This macro is an easy-to-use substitute for `define-setf-method' 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).  Example: (defsetf aref aset).
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.
Example: (defsetf nth (n x) (v) (list 'setcar (list 'nthcdr n x) v))."
  (if (listp arg1)
      (let* ((largs nil) (largsr nil)
         (temps nil) (tempsr nil)
         (restarg nil) (rest-temps nil)
         (store-var (car (prog1 (car args) (setq args (cdr args)))))
         (store-temp (intern (format "--%s--temp--" store-var)))
         (lets1 nil) (lets2 nil)
         (docstr nil) (p arg1))
    (if (stringp (car args))
        (setq docstr (prog1 (car args) (setq args (cdr args)))))
    (while (and p (not (eq (car p) '&aux)))
      (if (eq (car p) '&rest)
          (setq p (cdr p) restarg (car p))
        (or (memq (car p) '(&optional &key &allow-other-keys))
        (setq largs (cons (if (consp (car p)) (car (car p)) (car p))
                  largs)
              temps (cons (intern (format "--%s--temp--" (car largs)))
                  temps))))
      (setq p (cdr p)))
    (setq largs (nreverse largs) temps (nreverse temps))
    (if restarg
        (setq largsr (append largs (list restarg))
          rest-temps (intern (format "--%s--temp--" restarg))
          tempsr (append temps (list rest-temps)))
      (setq largsr largs tempsr temps))
    (let ((p1 largs) (p2 temps))
      (while p1
        (setq lets1 (cons (list (car p2)
                    (list 'gensym (format "--%s--" (car p1))))
                  lets1)
          lets2 (cons (list (car p1) (car p2)) lets2)
          p1 (cdr p1) p2 (cdr p2))))
    (if restarg (setq lets2 (cons (list restarg rest-temps) lets2)))
    (append (list 'define-setf-method func arg1)
        (and docstr (list docstr))
        (list
         (list 'let*
               (nreverse
            (cons (list store-temp
                    (list 'gensym (format "--%s--" store-var)))
                  (if restarg
                  (append
                   (list
                    (list rest-temps
                      (list 'mapcar '(quote gensym)
                        restarg)))
                   lets1)
                lets1)))
               (list 'list  ; 'values
                 (cons (if restarg 'list* 'list) tempsr)
                 (cons (if restarg 'list* 'list) largsr)
                 (list 'list store-temp)
                 (cons 'let*
                   (cons (nreverse
                      (cons (list store-var store-temp)
                        lets2))
                     args))
                 (cons (if restarg 'list* 'list)
                   (cons (list 'quote func) tempsr)))))))
    (list 'defsetf func '(&rest args) '(store)
      (let ((call (list 'cons (list 'quote arg1)
                '(append args (list store)))))
        (if (car args)
        (list 'list '(quote progn) call 'store)
          call)))))

;;; Some standard place types from Common Lisp.
(eval-when-compile (defvar ignored-arg)) ; Warning suppression
(defsetf aref aset)
(defsetf car setcar)
(defsetf cdr setcdr)
(defsetf elt (seq n) (store)
  (list 'if (list 'listp seq) (list 'setcar (list 'nthcdr n seq) store)
    (list 'aset seq n store)))
(defsetf get (x y &optional ignored-arg) (store) (list 'put x y store))
(defsetf get* (x y &optional ignored-arg) (store) (list 'put x y store))
(defsetf gethash (x h &optional ignored-arg) (store) (list 'cl::puthash x store h))
(defsetf nth (n x) (store) (list 'setcar (list 'nthcdr n x) store))
(defsetf subseq (seq start &optional end) (new)
  (list 'progn (list 'replace seq new ':start1 start ':end1 end) new))
(defsetf symbol-function fset)
(defsetf symbol-plist setplist)
(defsetf symbol-value set)

;;; Various car/cdr aliases.  Note that `cadr' is handled specially.
(defsetf first setcar)
(defsetf second (x) (store) (list 'setcar (list 'cdr x) store))
(defsetf third (x) (store) (list 'setcar (list 'cddr x) store))
(defsetf fourth (x) (store) (list 'setcar (list 'cdddr x) store))
(defsetf fifth (x) (store) (list 'setcar (list 'nthcdr 4 x) store))
(defsetf sixth (x) (store) (list 'setcar (list 'nthcdr 5 x) store))
(defsetf seventh (x) (store) (list 'setcar (list 'nthcdr 6 x) store))
(defsetf eighth (x) (store) (list 'setcar (list 'nthcdr 7 x) store))
(defsetf ninth (x) (store) (list 'setcar (list 'nthcdr 8 x) store))
(defsetf tenth (x) (store) (list 'setcar (list 'nthcdr 9 x) store))
(defsetf rest setcdr)

;;; Some more Emacs-related place types.
(defsetf buffer-file-name set-visited-file-name t)
(defsetf buffer-modified-p set-buffer-modified-p t)
(defsetf buffer-name rename-buffer t)
(defsetf buffer-string () (store)
  (list 'progn '(erase-buffer) (list 'insert store)))
(defsetf buffer-substring cl::set-buffer-substring)
(defsetf current-buffer set-buffer)
(defsetf current-case-table set-case-table)
(defsetf current-column move-to-column t)
(defsetf current-global-map use-global-map t)
(defsetf current-input-mode () (store)
  (list 'progn (list 'apply 'set-input-mode store) store))
(defsetf current-local-map use-local-map t)
(defsetf current-window-configuration set-window-configuration t)
(defsetf default-file-modes set-default-file-modes t)
(defsetf default-value set-default)
(defsetf documentation-property put)
(defsetf extent-face set-extent-face)
(defsetf extent-priority set-extent-priority)
(defsetf extent-property (x y &optional ignored-arg) (arg)
  (list 'set-extent-property x y arg))
(defsetf extent-start-position (ext) (store)
  `(progn (set-extent-endpoints ,ext ,store (extent-end-position ,ext))
      ,store))
(defsetf extent-end-position (ext) (store)
  `(progn (set-extent-endpoints ,ext (extent-start-position ,ext) ,store)
      ,store))
(defsetf face-background (f &optional s) (x) (list 'set-face-background f x s))
(defsetf face-background-pixmap (f &optional s) (x)
  (list 'set-face-background-pixmap f x s))
(defsetf face-font (f &optional s) (x) (list 'set-face-font f x s))
(defsetf face-foreground (f &optional s) (x) (list 'set-face-foreground f x s))
(defsetf face-underline-p (f &optional s) (x)
  (list 'set-face-underline-p f x s))
(defsetf file-modes set-file-modes t)
(defsetf frame-parameters modify-frame-parameters t)
(defsetf frame-visible-p cl::set-frame-visible-p)
(defsetf frame-properties (&optional f) (p)
  `(progn (set-frame-properties ,f ,p) ,p))
(defsetf frame-property (f p &optional ignored-arg) (v)
  `(progn (set-frame-property ,f ,v) ,p))
(defsetf frame-width (&optional f) (v)
  `(progn (set-frame-width ,f ,v) ,v))
(defsetf frame-height (&optional f) (v)
  `(progn (set-frame-height ,f ,v) ,v))
(defsetf current-frame-configuration set-frame-configuration)

;; XEmacs: new stuff
;; Consoles
(defsetf selected-console select-console t)
(defsetf selected-device select-device t)
(defsetf device-baud-rate (&optional d) (v)
  `(set-device-baud-rate ,d ,v))
;; This setf method is a bad idea, because set-specifier *adds* a
;; specification, rather than just setting it.  The net effect is that
;; it makes specifier-instance return VAL, but other things don't work
;; as expected -- letf, to name one.
;(defsetf specifier-instance (spec &optional dom def nof) (val)
;  `(set-specifier ,spec ,val ,dom))

;; Annotations
(defsetf annotation-glyph set-annotation-glyph)
(defsetf annotation-down-glyph set-annotation-down-glyph)
(defsetf annotation-face set-annotation-face)
(defsetf annotation-layout set-annotation-layout)
(defsetf annotation-data set-annotation-data)
(defsetf annotation-action set-annotation-action)
(defsetf annotation-menu set-annotation-menu)
;; Widget
(defsetf widget-get widget-put t)
(defsetf widget-value widget-value-set t)

;; Misc
(defsetf recent-keys-ring-size set-recent-keys-ring-size)
(defsetf symbol-value-in-buffer (s b &optional ignored-arg) (store)
  `(with-current-buffer ,b (set ,s ,store)))
(defsetf symbol-value-in-console (s c &optional ignored-arg) (store)
  `(letf (((selected-console) ,c))
     (set ,s ,store)))

(defsetf buffer-dedicated-frame (&optional b) (v)
  `(set-buffer-dedicated-frame ,b ,v))
(defsetf console-type-image-conversion-list
  set-console-type-image-conversion-list)
(defsetf default-toolbar-position set-default-toolbar-position)
(defsetf device-class (&optional d) (v)
  `(set-device-class ,d ,v))
(defsetf extent-begin-glyph set-extent-begin-glyph)
(defsetf extent-begin-glyph-layout set-extent-begin-glyph-layout)
(defsetf extent-end-glyph set-extent-end-glyph)
(defsetf extent-end-glyph-layout set-extent-end-glyph-layout)
(defsetf extent-keymap set-extent-keymap)
(defsetf extent-parent set-extent-parent)
(defsetf extent-properties set-extent-properties)
;; Avoid adding various face and glyph functions.
(defsetf frame-selected-window (&optional f) (v)
  `(set-frame-selected-window ,f ,v))
(defsetf glyph-image (glyph &optional domain) (i)
  (list 'set-glyph-image glyph i domain))
(defsetf itimer-function set-itimer-function)
(defsetf itimer-function-arguments set-itimer-function-arguments)
(defsetf itimer-is-idle set-itimer-is-idle)
(defsetf itimer-recorded-run-time set-itimer-recorded-run-time)
(defsetf itimer-restart set-itimer-restart)
(defsetf itimer-uses-arguments set-itimer-uses-arguments)
(defsetf itimer-value set-itimer-value)
(defsetf keymap-parents set-keymap-parents)
(defsetf marker-insertion-type set-marker-insertion-type)
(defsetf mouse-pixel-position (&optional d) (v)
  `(progn
     (set-mouse-pixel-position ,d ,(car v) ,(car (cdr v)) ,(cdr (cdr v)))
     ,v))
(defsetf trunc-stack-length set-trunc-stack-length)
(defsetf trunc-stack-stack set-trunc-stack-stack)
(defsetf undoable-stack-max set-undoable-stack-max)
(defsetf weak-list-list set-weak-list-list)


(defsetf getenv setenv t)
(defsetf get-register set-register)
(defsetf global-key-binding global-set-key)
(defsetf keymap-parent set-keymap-parent)
(defsetf keymap-name set-keymap-name)
(defsetf keymap-prompt set-keymap-prompt)
(defsetf keymap-default-binding set-keymap-default-binding)
(defsetf local-key-binding local-set-key)
(defsetf mark set-mark t)
(defsetf mark-marker set-mark t)
(defsetf marker-position set-marker t)
(defsetf match-data store-match-data t)
(defsetf mouse-position (scr) (store)
  (list 'set-mouse-position scr (list 'car store) (list 'cadr store)
    (list 'cddr store)))
(defsetf overlay-get overlay-put)
(defsetf overlay-start (ov) (store)
  (list 'progn (list 'move-overlay ov store (list 'overlay-end ov)) store))
(defsetf overlay-end (ov) (store)
  (list 'progn (list 'move-overlay ov (list 'overlay-start ov) store) store))
(defsetf point goto-char)
(defsetf point-marker goto-char t)
(defsetf point-max () (store)
  (list 'progn (list 'narrow-to-region '(point-min) store) store))
(defsetf point-min () (store)
  (list 'progn (list 'narrow-to-region store '(point-max)) store))
(defsetf process-buffer set-process-buffer)
(defsetf process-filter set-process-filter)
(defsetf process-sentinel set-process-sentinel)
(defsetf read-mouse-position (scr) (store)
  (list 'set-mouse-position scr (list 'car store) (list 'cdr store)))
(defsetf selected-window select-window)
(defsetf selected-frame select-frame)
(defsetf standard-case-table set-standard-case-table)
(defsetf syntax-table set-syntax-table)
(defsetf visited-file-modtime set-visited-file-modtime t)
(defsetf window-buffer set-window-buffer t)
(defsetf window-display-table set-window-display-table t)
(defsetf window-dedicated-p set-window-dedicated-p t)
(defsetf window-height (&optional window) (store)
  `(progn (enlarge-window (- ,store (window-height)) nil ,window) ,store))
(defsetf window-hscroll set-window-hscroll)
(defsetf window-point set-window-point)
(defsetf window-start set-window-start)
(defsetf window-width (&optional window) (store)
  `(progn (enlarge-window (- ,store (window-width)) t ,window) ,store))
(defsetf x-get-cutbuffer x-store-cutbuffer t)
(defsetf x-get-cut-buffer x-store-cut-buffer t)   ; groan.
(defsetf x-get-secondary-selection x-own-secondary-selection t)
(defsetf x-get-selection x-own-selection t)
(defsetf get-selection own-selection t)

;;; More complex setf-methods.
;;; These should take &environment arguments, but since full arglists aren't
;;; available while compiling cl::macs, we fake it by referring to the global
;;; variable cl::macro-environment directly.

(define-setf-method apply (func arg1 &rest rest)
  (or (and (memq (car-safe func) '(quote function function*))
       (symbolp (car-safe (cdr-safe func))))
      (error "First arg to apply in setf is not (function SYM): %s" func))
  (let* ((form (cons (nth 1 func) (cons arg1 rest)))
     (method (get-setf-method form cl::macro-environment)))
    (list (car method) (nth 1 method) (nth 2 method)
      (cl::setf-make-apply (nth 3 method) (cadr func) (car method))
      (cl::setf-make-apply (nth 4 method) (cadr func) (car method)))))

(defun cl::setf-make-apply (form func temps)
  (if (eq (car form) 'progn)
      (list* 'progn (cl::setf-make-apply (cadr form) func temps) (cddr form))
    (or (equal (last form) (last temps))
    (error "%s is not suitable for use with setf-of-apply" func))
    (list* 'apply (list 'quote (car form)) (cdr form))))

(define-setf-method nthcdr (n place)
  (let ((method (get-setf-method place cl::macro-environment))
    (n-temp (gensym "--nthcdr-n--"))
    (store-temp (gensym "--nthcdr-store--")))
    (list (cons n-temp (car method))
      (cons n (nth 1 method))
      (list store-temp)
      (list 'let (list (list (car (nth 2 method))
                 (list 'cl::set-nthcdr n-temp (nth 4 method)
                       store-temp)))
        (nth 3 method) store-temp)
      (list 'nthcdr n-temp (nth 4 method)))))

(define-setf-method getf (place tag &optional def)
  (let ((method (get-setf-method place cl::macro-environment))
    (tag-temp (gensym "--getf-tag--"))
    (def-temp (gensym "--getf-def--"))
    (store-temp (gensym "--getf-store--")))
    (list (append (car method) (list tag-temp def-temp))
      (append (nth 1 method) (list tag def))
      (list store-temp)
      (list 'let (list (list (car (nth 2 method))
                 (list 'cl::set-getf (nth 4 method)
                       tag-temp store-temp)))
        (nth 3 method) store-temp)
      (list 'getf (nth 4 method) tag-temp def-temp))))

(define-setf-method substring (place from &optional to)
  (let ((method (get-setf-method place cl::macro-environment))
    (from-temp (gensym "--substring-from--"))
    (to-temp (gensym "--substring-to--"))
    (store-temp (gensym "--substring-store--")))
    (list (append (car method) (list from-temp to-temp))
      (append (nth 1 method) (list from to))
      (list store-temp)
      (list 'let (list (list (car (nth 2 method))
                 (list 'cl::set-substring (nth 4 method)
                       from-temp to-temp store-temp)))
        (nth 3 method) store-temp)
      (list 'substring (nth 4 method) from-temp to-temp))))

(define-setf-method values (&rest args)
  (let ((methods (mapcar #'(lambda (x)
                 (get-setf-method x cl::macro-environment))
             args))
    (store-temp (gensym "--values-store--")))
    (list (apply 'append (mapcar 'first methods))
      (apply 'append (mapcar 'second methods))
      (list store-temp)
      (cons 'list
        (mapcar #'(lambda (m)
                (cl::setf-do-store (cons (car (third m)) (fourth m))
                          (list 'pop store-temp)))
            methods))
      (cons 'list (mapcar 'fifth methods)))))

;;; Getting and optimizing setf-methods.
;;;###autoload
(defun get-setf-method (place &optional env)
  "Return a list of five values describing the setf-method for PLACE.
PLACE may be any Lisp form which can appear as the PLACE argument to
a macro like `setf' or `incf'."
  (if (symbolp place)
      (let ((temp (gensym "--setf--")))
    (list nil nil (list temp) (list 'setq place temp) place))
    (or (and (symbolp (car place))
         (let* ((func (car place))
            (name (symbol-name func))
            (method (get func 'setf-method))
            (case-fold-search nil))
           (or (and method
            (let ((cl::macro-environment env))
              (setq method (apply method (cdr place))))
            (if (and (consp method) (= (length method) 5))
                method
              (error "Setf-method for %s returns malformed method"
                 func)))
           (and (save-match-data
              (string-match "\\`c[ad][ad][ad]?[ad]?r\\'" name))
            (get-setf-method (compiler-macroexpand place)))
           (and (eq func 'edebug-after)
            (get-setf-method (nth (1- (length place)) place)
                     env)))))
    (if (eq place (setq place (macroexpand place env)))
        (if (and (symbolp (car place)) (fboundp (car place))
             (symbolp (symbol-function (car place))))
        (get-setf-method (cons (symbol-function (car place))
                       (cdr place)) env)
          (error "No setf-method known for %s" (car place)))
      (get-setf-method place env)))))

(defun cl::setf-do-modify (place opt-expr)
  (let* ((method (get-setf-method place cl::macro-environment))
     (temps (car method)) (values (nth 1 method))
     (lets nil) (subs nil)
     (optimize (and (not (eq opt-expr 'no-opt))
            (or (and (not (eq opt-expr 'unsafe))
                 (cl::safe-expr-p opt-expr))
                (cl::setf-simple-store-p (car (nth 2 method))
                            (nth 3 method)))))
     (simple (and optimize (consp place) (cl::simple-exprs-p (cdr place)))))
    (while values
      (if (or simple (cl::const-expr-p (car values)))
      (cl::push (cons (cl::pop temps) (cl::pop values)) subs)
    (cl::push (list (cl::pop temps) (cl::pop values)) lets)))
    (list (nreverse lets)
      (cons (car (nth 2 method)) (sublis subs (nth 3 method)))
      (sublis subs (nth 4 method)))))

(defun cl::setf-do-store (spec val)
  (let ((sym (car spec))
    (form (cdr spec)))
    (if (or (cl::const-expr-p val)
        (and (cl::simple-expr-p val) (eq (cl::expr-contains form sym) 1))
        (cl::setf-simple-store-p sym form))
    (subst val sym form)
      (list 'let (list (list sym val)) form))))

(defun cl::setf-simple-store-p (sym form)
  (and (consp form) (eq (cl::expr-contains form sym) 1)
       (eq (nth (1- (length form)) form) sym)
       (symbolp (car form)) (fboundp (car form))
       (not (eq (car-safe (symbol-function (car form))) 'macro))))

;;; The standard modify macros.
;;;###autoload
(cl::defmacro setf (&rest args)
  "(setf PLACE VAL PLACE VAL ...): set each PLACE to the value of its VAL.
This is a generalized version of `setq'; the PLACEs may be symbolic
references such as (car x) or (aref x i), as well as plain symbols.
For example, (setf (cadar x) y) is equivalent to (setcar (cdar x) y).
The return value is the last VAL in the list."
  (if (cdr (cdr args))
      (let ((sets nil))
    (while args (cl::push (list 'setf (cl::pop args) (cl::pop args)) sets))
    (cons 'progn (nreverse sets)))
    (if (symbolp (car args))
    (and args (cons 'setq args))
      (let* ((method (cl::setf-do-modify (car args) (nth 1 args)))
         (store (cl::setf-do-store (nth 1 method) (nth 1 args))))
    (if (car method) (list 'let* (car method) store) store)))))

;;;###autoload
(cl::defmacro psetf (&rest args)
  "(psetf PLACE VAL PLACE VAL ...): set PLACEs to the values VALs in parallel.
This is like `setf', except that all VAL forms are evaluated (in order)
before assigning any PLACEs to the corresponding values."
  (let ((p args) (simple t) (vars nil))
    (while p
      (if (or (not (symbolp (car p))) (cl::expr-depends-p (nth 1 p) vars))
      (setq simple nil))
      (if (memq (car p) vars)
      (error "Destination duplicated in psetf: %s" (car p)))
      (cl::push (cl::pop p) vars)
      (or p (error "Odd number of arguments to psetf"))
      (cl::pop p))
    (if simple
    (list 'progn (cons 'setf args) nil)
      (setq args (reverse args))
      (let ((expr (list 'setf (cadr args) (car args))))
    (while (setq args (cddr args))
      (setq expr (list 'setf (cadr args) (list 'prog1 (car args) expr))))
    (list 'progn expr nil)))))

;;;###autoload
(defun cl::do-pop (place)
  (if (cl::simple-expr-p place)
      (list 'prog1 (list 'car place) (list 'setf place (list 'cdr place)))
    (let* ((method (cl::setf-do-modify place t))
       (temp (gensym "--pop--")))
      (list 'let*
        (append (car method)
            (list (list temp (nth 2 method))))
        (list 'prog1
          (list 'car temp)
          (cl::setf-do-store (nth 1 method) (list 'cdr temp)))))))

;;;###autoload
(cl::defmacro remf (place tag)
  "(remf PLACE TAG): remove TAG from property list PLACE.
PLACE may be a symbol, or any generalized variable allowed by `setf'.
The form returns true if TAG was found and removed, nil otherwise."
  (let* ((method (cl::setf-do-modify place t))
     (tag-temp (and (not (cl::const-expr-p tag)) (gensym "--remf-tag--")))
     (val-temp (and (not (cl::simple-expr-p place))
            (gensym "--remf-place--")))
     (ttag (or tag-temp tag))
     (tval (or val-temp (nth 2 method))))
    (list 'let*
      (append (car method)
          (and val-temp (list (list val-temp (nth 2 method))))
          (and tag-temp (list (list tag-temp tag))))
      (list 'if (list 'eq ttag (list 'car tval))
        (list 'progn
              (cl::setf-do-store (nth 1 method) (list 'cddr tval))
              t)
        (list 'cl::do-remf tval ttag)))))

;;;###autoload
(cl::defmacro shiftf (place &rest args)
  "(shiftf PLACE PLACE... VAL): shift left among PLACEs.
Example: (shiftf A B C) sets A to B, B to C, and returns the old A.
Each PLACE may be a symbol, or any generalized variable allowed by `setf'."
  (if (not (memq nil (mapcar 'symbolp (butlast (cons place args)))))
      (list* 'prog1 place
         (let ((sets nil))
           (while args
         (cl::push (list 'setq place (car args)) sets)
         (setq place (cl::pop args)))
           (nreverse sets)))
    (let* ((places (reverse (cons place args)))
       (form (cl::pop places)))
      (while places
    (let ((method (cl::setf-do-modify (cl::pop places) 'unsafe)))
      (setq form (list 'let* (car method)
               (list 'prog1 (nth 2 method)
                 (cl::setf-do-store (nth 1 method) form))))))
      form)))

;;;###autoload
(cl::defmacro rotatef (&rest args)
  "(rotatef PLACE...): rotate left among PLACEs.
Example: (rotatef A B C) sets A to B, B to C, and C to A.  It returns nil.
Each PLACE may be a symbol, or any generalized variable allowed by `setf'."
  (if (not (memq nil (mapcar 'symbolp args)))
      (and (cdr args)
       (let ((sets nil)
         (first (car args)))
         (while (cdr args)
           (setq sets (nconc sets (list (cl::pop args) (car args)))))
         (nconc (list 'psetf) sets (list (car args) first))))
    (let* ((places (reverse args))
       (temp (gensym "--rotatef--"))
       (form temp))
      (while (cdr places)
    (let ((method (cl::setf-do-modify (cl::pop places) 'unsafe)))
      (setq form (list 'let* (car method)
               (list 'prog1 (nth 2 method)
                 (cl::setf-do-store (nth 1 method) form))))))
      (let ((method (cl::setf-do-modify (car places) 'unsafe)))
    (list 'let* (append (car method) (list (list temp (nth 2 method))))
          (cl::setf-do-store (nth 1 method) form) nil)))))

;;;###autoload
(cl::defmacro letf (bindings &rest body)
  "(letf ((PLACE VALUE) ...) BODY...): temporarily bind to PLACEs.
This is the analogue of `let', but with generalized variables (in the
sense of `setf') for the PLACEs.  Each PLACE is set to the corresponding
VALUE, then the BODY forms are executed.  On exit, either normally or
because of a `throw' or error, the PLACEs are set back to their original
values.  Note that this macro is *not* available in Common Lisp.
As a special case, if `(PLACE)' is used instead of `(PLACE VALUE)',
the PLACE is not modified before executing BODY."
  (if (and (not (cdr bindings)) (cdar bindings) (symbolp (caar bindings)))
      (list* 'let bindings body)
    (let ((lets nil)
      (rev (reverse bindings)))
      (while rev
    (let* ((place (if (symbolp (caar rev))
              (list 'symbol-value (list 'quote (caar rev)))
            (caar rev)))
           (value (cadar rev))
           (method (cl::setf-do-modify place 'no-opt))
           (save (gensym "--letf-save--"))
           (bound (and (memq (car place) '(symbol-value symbol-function))
               (gensym "--letf-bound--")))
           (temp (and (not (cl::const-expr-p value)) (cdr bindings)
              (gensym "--letf-val--"))))
      (setq lets (nconc (car method)
                (if bound
                (list (list bound
                        (list (if (eq (car place)
                              'symbol-value)
                              'boundp 'fboundp)
                          (nth 1 (nth 2 method))))
                      (list save (list 'and bound
                               (nth 2 method))))
                  (list (list save (nth 2 method))))
                (and temp (list (list temp value)))
                lets)
        body (list
              (list 'unwind-protect
                (cons 'progn
                  (if (cdr (car rev))
                      (cons (cl::setf-do-store (nth 1 method)
                                  (or temp value))
                        body)
                    body))
                (if bound
                (list 'if bound
                      (cl::setf-do-store (nth 1 method) save)
                      (list (if (eq (car place) 'symbol-value)
                        'makunbound 'fmakunbound)
                        (nth 1 (nth 2 method))))
                  (cl::setf-do-store (nth 1 method) save))))
        rev (cdr rev))))
      (list* 'let* lets body))))

;;;###autoload
(cl::defmacro letf* (bindings &rest body)
  "(letf* ((PLACE VALUE) ...) BODY...): temporarily bind to PLACEs.
This is the analogue of `let*', but with generalized variables (in the
sense of `setf') for the PLACEs.  Each PLACE is set to the corresponding
VALUE, then the BODY forms are executed.  On exit, either normally or
because of a `throw' or error, the PLACEs are set back to their original
values.  Note that this macro is *not* available in Common Lisp.
As a special case, if `(PLACE)' is used instead of `(PLACE VALUE)',
the PLACE is not modified before executing BODY."
  (if (null bindings)
      (cons 'progn body)
    (setq bindings (reverse bindings))
    (while bindings
      (setq body (list (list* 'letf (list (cl::pop bindings)) body))))
    (car body)))

;;;###autoload
(cl::defmacro callf (func place &rest args)
  "(callf FUNC PLACE ARGS...): set PLACE to (FUNC PLACE ARGS...).
FUNC should be an unquoted function name.  PLACE may be a symbol,
or any generalized variable allowed by `setf'."
  (let* ((method (cl::setf-do-modify place (cons 'list args)))
     (rargs (cons (nth 2 method) args)))
    (list 'let* (car method)
      (cl::setf-do-store (nth 1 method)
                (if (symbolp func) (cons func rargs)
                  (list* 'funcall (list 'function func)
                     rargs))))))

;;;###autoload
(cl::defmacro callf2 (func arg1 place &rest args)
  "(callf2 FUNC ARG1 PLACE ARGS...): set PLACE to (FUNC ARG1 PLACE ARGS...).
Like `callf', but PLACE is the second argument of FUNC, not the first."
  (if (and (cl::safe-expr-p arg1) (cl::simple-expr-p place) (symbolp func))
      (list 'setf place (list* func arg1 place args))
    (let* ((method (cl::setf-do-modify place (cons 'list args)))
       (temp (and (not (cl::const-expr-p arg1)) (gensym "--arg1--")))
       (rargs (list* (or temp arg1) (nth 2 method) args)))
      (list 'let* (append (and temp (list (list temp arg1))) (car method))
        (cl::setf-do-store (nth 1 method)
                  (if (symbolp func) (cons func rargs)
                (list* 'funcall (list 'function func)
                       rargs)))))))

;;;###autoload
(cl::defmacro define-modify-macro (name arglist func &optional doc)
  "(define-modify-macro NAME ARGLIST FUNC): define a `setf'-like modify macro.
If NAME is called, it combines its PLACE argument with the other arguments
from ARGLIST using FUNC: (define-modify-macro incf (&optional (n 1)) +)"
  (if (memq '&key arglist) (error "&key not allowed in define-modify-macro"))
  (let ((place (gensym "--place--")))
    (list 'defmacro* name (cons place arglist) doc
      (list* (if (memq '&rest arglist) 'list* 'list)
         '(quote callf) (list 'quote func) place
         (cl::arglist-args arglist)))))


;;; Structures.

;;;###autoload
(cl::defmacro defstruct (struct &rest descs)
  "(defstruct (NAME OPTIONS...) (SLOT SLOT-OPTS...)...): define a struct type.
This macro defines a new Lisp data type called NAME, which contains data
stored in SLOTs.  This defines a `make-NAME' constructor, a `copy-NAME'
copier, a `NAME-p' predicate, and setf-able `NAME-SLOT' accessors."
  (let* ((name (if (consp struct) (car struct) struct))
     (opts (cdr-safe struct))
     (slots nil)
     (defaults nil)
     (conc-name (concat (symbol-name name) "-"))
     (constructor (intern (format "make-%s" name)))
     (constrs nil)
     (copier (intern (format "copy-%s" name)))
     (predicate (intern (format "%s-p" name)))
     (print-func nil) (print-auto nil)
     (safety (if (cl::compiling-file) cl::optimize-safety 3))
     (include nil)
     (tag (intern (format "cl::struct-%s" name)))
     (tag-symbol (intern (format "cl::struct-%s-tags" name)))
     (include-descs nil)
     (side-eff nil)
     (type nil)
     (named nil)
     (forms nil)
     pred-form pred-check)
    (if (stringp (car descs))
    (cl::push (list 'put (list 'quote name) '(quote structure-documentation)
               (cl::pop descs)) forms))
    (setq descs (cons '(cl::tag-slot)
              (mapcar #'(lambda (x) (if (consp x) x (list x)))
                  descs)))
    (while opts
      (let ((opt (if (consp (car opts)) (caar opts) (car opts)))
        (args (cdr-safe (cl::pop opts))))
    (cond ((eq opt ':conc-name)
           (if args
           (setq conc-name (if (car args)
                       (symbol-name (car args)) ""))))
          ((eq opt ':constructor)
           (if (cdr args)
           (cl::push args constrs)
         (if args (setq constructor (car args)))))
          ((eq opt ':copier)
           (if args (setq copier (car args))))
          ((eq opt ':predicate)
           (if args (setq predicate (car args))))
          ((eq opt ':include)
           (setq include (car args)
             include-descs (mapcar #'(lambda (x)
                           (if (consp x) x (list x)))
                       (cdr args))))
          ((eq opt ':print-function)
           (setq print-func (car args)))
          ((eq opt ':type)
           (setq type (car args)))
          ((eq opt ':named)
           (setq named t))
          ((eq opt ':initial-offset)
           (setq descs (nconc (make-list (car args) '(cl::skip-slot))
                  descs)))
          (t
           (error "Slot option %s unrecognized" opt)))))
    (if print-func
    (setq print-func (list 'progn
                   (list 'funcall (list 'function print-func)
                     'cl::x 'cl::s 'cl::n) t))
      (or type (and include (not (get include 'cl::struct-print)))
      (setq print-auto t
        print-func (and (or (not (or include type)) (null print-func))
                (list 'progn
                      (list 'princ (format "#S(%s" name)
                        'cl::s))))))
    (if include
    (let ((inc-type (get include 'cl::struct-type))
          (old-descs (get include 'cl::struct-slots)))
      (or inc-type (error "%s is not a struct name" include))
      (and type (not (eq (car inc-type) type))
           (error ":type disagrees with :include for %s" name))
      (while include-descs
        (setcar (memq (or (assq (caar include-descs) old-descs)
                  (error "No slot %s in included struct %s"
                     (caar include-descs) include))
              old-descs)
            (cl::pop include-descs)))
      (setq descs (append old-descs (delq (assq 'cl::tag-slot descs) descs))
        type (car inc-type)
        named (assq 'cl::tag-slot descs))
      (if (cadr inc-type) (setq tag name named t))
      (let ((incl include))
        (while incl
          (cl::push (list 'pushnew (list 'quote tag)
                 (intern (format "cl::struct-%s-tags" incl)))
               forms)
          (setq incl (get incl 'cl::struct-include)))))
      (if type
      (progn
        (or (memq type '(vector list))
        (error "Illegal :type specifier: %s" type))
        (if named (setq tag name)))
    (setq type 'vector named 'true)))
    (or named (setq descs (delq (assq 'cl::tag-slot descs) descs)))
    (cl::push (list 'defvar tag-symbol) forms)
    (setq pred-form (and named
             (let ((pos (- (length descs)
                       (length (memq (assq 'cl::tag-slot descs)
                             descs)))))
               (if (eq type 'vector)
                   (list 'and '(vectorp cl::x)
                     (list '>= '(length cl::x) (length descs))
                     (list 'memq (list 'aref 'cl::x pos)
                       tag-symbol))
                 (if (= pos 0)
                 (list 'memq '(car-safe cl::x) tag-symbol)
                   (list 'and '(consp cl::x)
                     (list 'memq (list 'nth pos 'cl::x)
                       tag-symbol))))))
      pred-check (and pred-form (> safety 0)
              (if (and (eq (caadr pred-form) 'vectorp)
                   (= safety 1))
                  (cons 'and (cdddr pred-form)) pred-form)))
    (let ((pos 0) (descp descs))
      (while descp
    (let* ((desc (cl::pop descp))
           (slot (car desc)))
      (if (memq slot '(cl::tag-slot cl::skip-slot))
          (progn
        (cl::push nil slots)
        (cl::push (and (eq slot 'cl::tag-slot) (list 'quote tag))
             defaults))
        (if (assq slot descp)
        (error "Duplicate slots named %s in %s" slot name))
        (let ((accessor (intern (format "%s%s" conc-name slot))))
          (cl::push slot slots)
          (cl::push (nth 1 desc) defaults)
          (cl::push (list*
            'defsubst* accessor '(cl::x)
            (append
             (and pred-check
                  (list (list 'or pred-check
                      (list 'error
                        (format "%s accessing a non-%s"
                            accessor name)
                        'cl::x))))
             (list (if (eq type 'vector) (list 'aref 'cl::x pos)
                 (if (= pos 0) '(car cl::x)
                   (list 'nth pos 'cl::x)))))) forms)
          (cl::push (cons accessor t) side-eff)
          (cl::push (list 'define-setf-method accessor '(cl::x)
                 (if (cadr (memq ':read-only (cddr desc)))
                 (list 'error (format "%s is a read-only slot"
                              accessor))
                   (list 'cl::struct-setf-expander 'cl::x
                     (list 'quote name) (list 'quote accessor)
                     (and pred-check (list 'quote pred-check))
                     pos)))
               forms)
          (if print-auto
          (nconc print-func
             (list (list 'princ (format " %s" slot) 'cl::s)
                   (list 'prin1 (list accessor 'cl::x) 'cl::s)))))))
    (setq pos (1+ pos))))
    (setq slots (nreverse slots)
      defaults (nreverse defaults))
    (and predicate pred-form
     (progn (cl::push (list 'defsubst* predicate '(cl::x)
                   (if (eq (car pred-form) 'and)
                   (append pred-form '(t))
                 (list 'and pred-form t))) forms)
        (cl::push (cons predicate 'error-free) side-eff)))
    (and copier
     (progn (cl::push (list 'defun copier '(x) '(copy-sequence x)) forms)
        (cl::push (cons copier t) side-eff)))
    (if constructor
    (cl::push (list constructor
               (cons '&key (delq nil (copy-sequence slots))))
         constrs))
    (while constrs
      (let* ((name (caar constrs))
         (args (cadr (cl::pop constrs)))
         (anames (cl::arglist-args args))
         (make (mapcar* #'(lambda (s d) (if (memq s anames) s d))
                slots defaults)))
    (cl::push (list 'defsubst* name
               (list* '&cl::defs (list 'quote (cons nil descs)) args)
               (cons type make)) forms)
    (if (cl::safe-expr-p (cons 'progn (mapcar 'second descs)))
        (cl::push (cons name t) side-eff))))
    (if print-auto (nconc print-func (list '(princ ")" cl::s) t)))
    (if print-func
    (cl::push (list 'push
               (list 'function
                 (list 'lambda '(cl::x cl::s cl::n)
                   (list 'and pred-form print-func)))
               'custom-print-functions) forms))
    (cl::push (list 'setq tag-symbol (list 'list (list 'quote tag))) forms)
    (cl::push (list* 'eval-when '(compile load eval)
            (list 'put (list 'quote name) '(quote cl::struct-slots)
              (list 'quote descs))
            (list 'put (list 'quote name) '(quote cl::struct-type)
              (list 'quote (list type (eq named t))))
            (list 'put (list 'quote name) '(quote cl::struct-include)
              (list 'quote include))
            (list 'put (list 'quote name) '(quote cl::struct-print)
              print-auto)
            (mapcar #'(lambda (x)
                (list 'put (list 'quote (car x))
                      '(quote side-effect-free)
                      (list 'quote (cdr x))))
                side-eff))
         forms)
    (cons 'progn (nreverse (cons (list 'quote name) forms)))))

;;;###autoload
(defun cl::struct-setf-expander (x name accessor pred-form pos)
  (let* ((temp (gensym "--x--")) (store (gensym "--store--")))
    (list (list temp) (list x) (list store)
      (append '(progn)
          (and pred-form
               (list (list 'or (subst temp 'cl::x pred-form)
                   (list 'error
                     (format
                      "%s storing a non-%s" accessor name)
                     temp))))
          (list (if (eq (car (get name 'cl::struct-type)) 'vector)
                (list 'aset temp pos store)
              (list 'setcar
                (if (<= pos 5)
                    (let ((xx temp))
                      (while (>= (setq pos (1- pos)) 0)
                    (setq xx (list 'cdr xx)))
                      xx)
                  (list 'nthcdr pos temp))
                store))))
      (list accessor temp))))


;;; Types and assertions.

;;;###autoload
(cl::defmacro deftype (name args &rest body)
  "(deftype NAME ARGLIST BODY...): define NAME as a new data type.
The type name can then be used in `typecase', `check-type', etc."
  (list 'eval-when '(compile load eval)
    (cl::transform-function-property
     name 'cl::deftype-handler (cons (list* '&cl::defs ''('*) args) body))))

(defun cl::make-type-test (val type)
  (if (symbolp type)
      (cond ((get type 'cl::deftype-handler)
         (cl::make-type-test val (funcall (get type 'cl::deftype-handler))))
        ((memq type '(nil t)) type)
        ((eq type 'string-char) (list 'characterp val))
        ((eq type 'null) (list 'null val))
        ((eq type 'float) (list 'floatp-safe val))
        ((eq type 'real) (list 'numberp val))
        ((eq type 'fixnum) (list 'integerp val))
        (t
         (let* ((name (symbol-name type))
            (namep (intern (concat name "p"))))
           (if (fboundp namep) (list namep val)
         (list (intern (concat name "-p")) val)))))
    (cond ((get (car type) 'cl::deftype-handler)
       (cl::make-type-test val (apply (get (car type) 'cl::deftype-handler)
                     (cdr type))))
      ((memq (car-safe type) '(integer float real number))
       (delq t (list 'and (cl::make-type-test val (car type))
             (if (memq (cadr type) '(* nil)) t
               (if (consp (cadr type)) (list '> val (caadr type))
                 (list '>= val (cadr type))))
             (if (memq (caddr type) '(* nil)) t
               (if (consp (caddr type)) (list '< val (caaddr type))
                 (list '<= val (caddr type)))))))
      ((memq (car-safe type) '(and or not))
       (cons (car type)
         (mapcar #'(lambda (x) (cl::make-type-test val x))
             (cdr type))))
      ((memq (car-safe type) '(member member*))
       (list 'and (list 'member* val (list 'quote (cdr type))) t))
      ((eq (car-safe type) 'satisfies) (list (cadr type) val))
      (t (error "Bad type spec: %s" type)))))

;;;###autoload
(defun typep (object type)   ; See compiler macro below.
  "Check that OBJECT is of type TYPE.
TYPE is a Common Lisp-style type specifier."
  (eval (cl::make-type-test 'object type)))

;;;###autoload
(cl::defmacro check-type (place type &optional string)
  "Verify that PLACE is of type TYPE; signal a continuable error if not.
STRING is an optional description of the desired type."
  (when (or (not (cl::compiling-file))
        (< cl::optimize-speed 3)
        (= cl::optimize-safety 3))
    (let* ((temp (if (cl::simple-expr-p place 3) place (gensym)))
       (test (cl::make-type-test temp type))
       (signal-error `(signal 'wrong-type-argument
                  ,(list 'list (or string (list 'quote type))
                     temp (list 'quote place))))
       (body
        (condition-case nil
        `(while (not ,test)
           ,(macroexpand `(setf ,place ,signal-error)))
          (error
           `(if ,test (progn ,signal-error nil))))))
      (if (eq temp place)
      body
    `(let ((,temp ,place)) ,body)))))

;;;###autoload
(cl::defmacro assert (form &optional show-args string &rest args)
  "Verify that FORM returns non-nil; signal an error if not.
Second arg SHOW-ARGS means to include arguments of FORM in message.
Other args STRING and ARGS... are arguments to be passed to `error'.
They are not evaluated unless the assertion fails.  If STRING is
omitted, a default message listing FORM itself is used."
  (and (or (not (cl::compiling-file))
       (< cl::optimize-speed 3) (= cl::optimize-safety 3))
       (let ((sargs (and show-args (delq nil (mapcar
                           #'(lambda (x)
                           (and (not (cl::const-expr-p x))
                            x))
                           (cdr form))))))
     (list 'progn
           (list 'or form
             (if string
             (list* 'error string (append sargs args))
               (list 'signal '(quote cl::assertion-failed)
                 (list* 'list (list 'quote form) sargs))))
           nil))))

;;;###autoload
(cl::defmacro ignore-errors (&rest body)
  "Execute FORMS; if an error occurs, return nil.
Otherwise, return result of last FORM."
  `(condition-case nil (progn ,@body) (error nil)))

;;;###autoload
(cl::defmacro ignore-file-errors (&rest body)
  "Execute FORMS; if an error of type `file-error' occurs, return nil.
Otherwise, return result of last FORM."
  `(condition-case nil (progn ,@body) (file-error nil)))

;;; Some predicates for analyzing Lisp forms.  These are used by various
;;; macro expanders to optimize the results in certain common cases.

(defconst cl::simple-funcs '(car cdr nth aref elt if and or + - 1+ 1- min max
                car-safe cdr-safe progn prog1 prog2))
(defconst cl::safe-funcs '(* / % length memq list vector vectorp
              < > <= >= = error))

;;; Check if no side effects, and executes quickly.
(defun cl::simple-expr-p (x &optional size)
  (or size (setq size 10))
  (if (and (consp x) (not (memq (car x) '(quote function function*))))
      (and (symbolp (car x))
       (or (memq (car x) cl::simple-funcs)
           (get (car x) 'side-effect-free))
       (progn
         (setq size (1- size))
         (while (and (setq x (cdr x))
             (setq size (cl::simple-expr-p (car x) size))))
         (and (null x) (>= size 0) size)))
    (and (> size 0) (1- size))))

(defun cl::simple-exprs-p (xs)
  (while (and xs (cl::simple-expr-p (car xs)))
    (setq xs (cdr xs)))
  (not xs))

;;; Check if no side effects.
(defun cl::safe-expr-p (x)
  (or (not (and (consp x) (not (memq (car x) '(quote function function*)))))
      (and (symbolp (car x))
       (or (memq (car x) cl::simple-funcs)
           (memq (car x) cl::safe-funcs)
           (get (car x) 'side-effect-free))
       (progn
         (while (and (setq x (cdr x)) (cl::safe-expr-p (car x))))
         (null x)))))

;;; Check if constant (i.e., no side effects or dependencies).
(defun cl::const-expr-p (x)
  (cond ((consp x)
     (or (eq (car x) 'quote)
         (and (memq (car x) '(function function*))
          (or (symbolp (nth 1 x))
              (and (eq (car-safe (nth 1 x)) 'lambda) 'func)))))
    ((symbolp x) (and (memq x '(nil t)) t))
    (t t)))

(defun cl::const-exprs-p (xs)
  (while (and xs (cl::const-expr-p (car xs)))
    (setq xs (cdr xs)))
  (not xs))

(defun cl::const-expr-val (x)
  (and (eq (cl::const-expr-p x) t) (if (consp x) (nth 1 x) x)))

(defun cl::expr-access-order (x v)
  (if (cl::const-expr-p x) v
    (if (consp x)
    (progn
      (while (setq x (cdr x)) (setq v (cl::expr-access-order (car x) v)))
      v)
      (if (eq x (car v)) (cdr v) '(t)))))

;;; Count number of times X refers to Y.  Return NIL for 0 times.
(defun cl::expr-contains (x y)
  (cond ((equal y x) 1)
    ((and (consp x) (not (memq (car-safe x) '(quote function function*))))
     (let ((sum 0))
       (while x
         (setq sum (+ sum (or (cl::expr-contains (cl::pop x) y) 0))))
       (and (> sum 0) sum)))
    (t nil)))

(defun cl::expr-contains-any (x y)
  (while (and y (not (cl::expr-contains x (car y)))) (cl::pop y))
  y)

;;; Check whether X may depend on any of the symbols in Y.
(defun cl::expr-depends-p (x y)
  (and (not (cl::const-expr-p x))
       (or (not (cl::safe-expr-p x)) (cl::expr-contains-any x y))))


;;; Compiler macros.

;;;###autoload
(cl::defmacro define-compiler-macro (func args &rest body)
  "(define-compiler-macro FUNC ARGLIST BODY...): Define a compiler-only macro.
This is like `defmacro', but macro expansion occurs only if the call to
FUNC is compiled (i.e., not interpreted).  Compiler macros should be used
for optimizing the way calls to FUNC are compiled; the form returned by
BODY should do the same thing as a call to the normal function called
FUNC, though possibly more efficiently.  Note that, like regular macros,
compiler macros are expanded repeatedly until no further expansions are
possible.  Unlike regular macros, BODY can decide to \"punt\" and leave the
original function call alone by declaring an initial `&whole foo' parameter
and then returning foo."
  (let ((p (if (listp args) args (list '&rest args))) (res nil))
    (while (consp p) (cl::push (cl::pop p) res))
    (setq args (nreverse res)) (setcdr res (and p (list '&rest p))))
  (list 'eval-when '(compile load eval)
    (cl::transform-function-property
     func 'cl::compiler-macro
     (cons (if (memq '&whole args) (delq '&whole args)
         (cons '--cl::whole-arg-- args)) body))
    (list 'or (list 'get (list 'quote func) '(quote byte-compile))
          (list 'put (list 'quote func) '(quote byte-compile)
            '(quote cl::byte-compile-compiler-macro)))))

;;;###autoload
(defun compiler-macroexpand (form)
  (while
      (let ((func (car-safe form)) (handler nil))
    (while (and (symbolp func)
            (not (setq handler (get func 'cl::compiler-macro)))
            (fboundp func)
            (or (not (eq (car-safe (symbol-function func)) 'autoload))
            (load (nth 1 (symbol-function func)))))
      (setq func (symbol-function func)))
    (and handler
         (not (eq form (setq form (apply handler form (cdr form))))))))
  form)

(defun cl::byte-compile-compiler-macro (form)
  (if (eq form (setq form (compiler-macroexpand form)))
      (byte-compile-normal-call form)
    (byte-compile-form form)))

(cl::defmacro defsubst* (name args &rest body)
  "(defsubst* NAME ARGLIST [DOCSTRING] BODY...): define NAME as a function.
Like `defun', except the function is automatically declared `inline',
ARGLIST allows full Common Lisp conventions, and BODY is implicitly
surrounded by (block NAME ...)."
  (let* ((argns (cl::arglist-args args)) (p argns)
     (pbody (cons 'progn body))
     (unsafe (not (cl::safe-expr-p pbody))))
    (while (and p (eq (cl::expr-contains args (car p)) 1)) (cl::pop p))
    (list 'progn
      (if p nil   ; give up if defaults refer to earlier args
        (list 'define-compiler-macro name
          (list* '&whole 'cl::whole '&cl::quote args)
          (list* 'cl::defsubst-expand (list 'quote argns)
             (list 'quote (list* 'block name body))
             (not (or unsafe (cl::expr-access-order pbody argns)))
             (and (memq '&key args) 'cl::whole) unsafe argns)))
      (list* 'defun* name args body))))

(defun cl::defsubst-expand (argns body simple whole unsafe &rest argvs)
  (if (and whole (not (cl::safe-expr-p (cons 'progn argvs)))) whole
    (if (cl::simple-exprs-p argvs) (setq simple t))
    (let ((lets (delq nil
              (mapcar* #'(lambda (argn argv)
                   (if (or simple (cl::const-expr-p argv))
                       (progn (setq body (subst argv argn body))
                          (and unsafe (list argn argv)))
                     (list argn argv)))
                   argns argvs))))
      (if lets (list 'let lets body) body))))


;;; Compile-time optimizations for some functions defined in this package.
;;; Note that cl.el arranges to force cl::macs to be loaded at compile-time,
;;; mainly to make sure these macros will be present.

(put 'eql 'byte-compile nil)
(define-compiler-macro eql (&whole form a b)
  (cond ((eq (cl::const-expr-p a) t)
     (let ((val (cl::const-expr-val a)))
       (if (and (numberp val) (not (integerp val)))
           (list 'equal a b)
         (list 'eq a b))))
    ((eq (cl::const-expr-p b) t)
     (let ((val (cl::const-expr-val b)))
       (if (and (numberp val) (not (integerp val)))
           (list 'equal a b)
         (list 'eq a b))))
    ((cl::simple-expr-p a 5)
     (list 'if (list 'numberp a)
           (list 'equal a b)
           (list 'eq a b)))
    ((and (cl::safe-expr-p a)
          (cl::simple-expr-p b 5))
     (list 'if (list 'numberp b)
           (list 'equal a b)
           (list 'eq a b)))
    (t form)))

(define-compiler-macro member* (&whole form a list &rest keys)
  (let ((test (and (= (length keys) 2) (eq (car keys) ':test)
           (cl::const-expr-val (nth 1 keys)))))
    (cond ((eq test 'eq) (list 'memq a list))
      ((eq test 'equal) (list 'member a list))
      ((or (null keys) (eq test 'eql))
       (if (eq (cl::const-expr-p a) t)
           (list (if (floatp-safe (cl::const-expr-val a)) 'member 'memq)
             a list)
         (if (eq (cl::const-expr-p list) t)
         (let ((p (cl::const-expr-val list)) (mb nil) (mq nil))
           (if (not (cdr p))
               (and p (list 'eql a (list 'quote (car p))))
             (while p
               (if (floatp-safe (car p)) (setq mb t)
             (or (integerp (car p)) (symbolp (car p)) (setq mq t)))
               (setq p (cdr p)))
             (if (not mb) (list 'memq a list)
               (if (not mq) (list 'member a list) form))))
           form)))
      (t form))))

(define-compiler-macro assoc* (&whole form a list &rest keys)
  (let ((test (and (= (length keys) 2) (eq (car keys) ':test)
           (cl::const-expr-val (nth 1 keys)))))
    (cond ((eq test 'eq) (list 'assq a list))
      ((eq test 'equal) (list 'assoc a list))
      ((and (eq (cl::const-expr-p a) t) (or (null keys) (eq test 'eql)))
       (if (floatp-safe (cl::const-expr-val a))
           (list 'assoc a list) (list 'assq a list)))
      (t form))))

(define-compiler-macro adjoin (&whole form a list &rest keys)
  (if (and (cl::simple-expr-p a) (cl::simple-expr-p list)
       (not (memq ':key keys)))
      (list 'if (list* 'member* a list keys) list (list 'cons a list))
    form))

(define-compiler-macro list* (arg &rest others)
  (let* ((args (reverse (cons arg others)))
     (form (car args)))
    (while (setq args (cdr args))
      (setq form (list 'cons (car args) form)))
    form))

(define-compiler-macro get* (sym prop &optional default)
  (list 'get sym prop default))

(define-compiler-macro getf (sym prop &optional default)
  (list 'plist-get sym prop default))

(define-compiler-macro typep (&whole form val type)
  (if (cl::const-expr-p type)
      (let ((res (cl::make-type-test val (cl::const-expr-val type))))
    (if (or (memq (cl::expr-contains res val) '(nil 1))
        (cl::simple-expr-p val)) res
      (let ((temp (gensym)))
        (list 'let (list (list temp val)) (subst temp val res)))))
    form))


(mapc
 #'(lambda (y)
     (put (car y) 'side-effect-free t)
     (put (car y) 'byte-compile 'cl::byte-compile-compiler-macro)
     (put (car y) 'cl::compiler-macro
      (list 'lambda '(w x)
        (if (symbolp (cadr y))
            (list 'list (list 'quote (cadr y))
              (list 'list (list 'quote (caddr y)) 'x))
          (cons 'list (cdr y))))))
 '((first 'car x) (second 'cadr x) (third 'caddr x) (fourth 'cadddr x)
   (fifth 'nth 4 x) (sixth 'nth 5 x) (seventh 'nth 6 x)
   (eighth 'nth 7 x) (ninth 'nth 8 x) (tenth 'nth 9 x)
   (rest 'cdr x) (endp 'null x) (plusp '> x 0) (minusp '< x 0)
   (oddp  'eq (list 'logand x 1) 1)
   (evenp 'eq (list 'logand x 1) 0)
   (caar car car) (cadr car cdr) (cdar cdr car) (cddr cdr cdr)
   (caaar car caar) (caadr car cadr) (cadar car cdar)
   (caddr car cddr) (cdaar cdr caar) (cdadr cdr cadr)
   (cddar cdr cdar) (cdddr cdr cddr) (caaaar car caaar)
   (caaadr car caadr) (caadar car cadar) (caaddr car caddr)
   (cadaar car cdaar) (cadadr car cdadr) (caddar car cddar)
   (cadddr car cdddr) (cdaaar cdr caaar) (cdaadr cdr caadr)
   (cdadar cdr cadar) (cdaddr cdr caddr) (cddaar cdr cdaar)
   (cddadr cdr cdadr) (cdddar cdr cddar) (cddddr cdr cdddr)))

;;; Things that are inline.
(proclaim '(inline floatp-safe acons map concatenate notany notevery
;; XEmacs change
           cl::set-elt revappend nreconc
           ))

;;; Things that are side-effect-free.  Moved to byte-optimize.el
;(dolist (fun '(oddp evenp plusp minusp
;           abs expt signum last butlast ldiff
;           pairlis gcd lcm
;           isqrt floor* ceiling* truncate* round* mod* rem* subseq
;           list-length getf))
;  (put fun 'side-effect-free t))

;;; Things that are side-effect-and-error-free.  Moved to byte-optimize.el
;(dolist (fun '(eql floatp-safe list* subst acons equalp random-state-p
;          copy-tree sublis))
;  (put fun 'side-effect-free 'error-free))


(run-hooks 'cl::macs-load-hook)

;;; cl::macs.el ends here





(load "cycdcg.lisp")