/[cmucl]/src/pcl/macros.lisp
ViewVC logotype

Diff of /src/pcl/macros.lisp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.3 by ram, Mon Jun 1 18:38:30 1992 UTC revision 1.3.1.1 by ram, Mon Dec 14 12:53:08 1992 UTC
# Line 590  Line 590 
590    (declare (ignore function-name))    (declare (ignore function-name))
591    #+setf nil    #+setf nil
592    #-setf    #-setf
593    (unless (setfboundp function-name)    (unless (and (setfboundp function-name)
594                   (get function-name 'standard-setf))
595        (setf (get function-name 'standard-setf) t)
596      (let* ((setf-function-name (get-setf-function-name function-name)))      (let* ((setf-function-name (get-setf-function-name function-name)))
597    
598        #+Genera        #+Genera
# Line 713  Line 715 
715    (setf (symbol-function name)    (setf (symbol-function name)
716          (symbol-function new)))          (symbol-function new)))
717    
718  (defun reset-pcl-package () ; Try to do this safely  (defun pcl::reset-pcl-package ()                ; Try to do this safely
719    (let* ((vars '(*pcl-directory* *default-pathname-extensions* *pathname-extensions*))    (let* ((vars '(pcl::*pcl-directory*
720                     pcl::*default-pathname-extensions*
721                     pcl::*pathname-extensions*
722                     pcl::*redefined-functions*))
723           (names (mapcar #'symbol-name vars))           (names (mapcar #'symbol-name vars))
724           (values (mapcar #'symbol-value vars)))           (values (mapcar #'symbol-value vars)))
725      (when (boundp '*redefined-functions*)      (let ((pkg (find-package "PCL")))
726        (dolist (sym *redefined-functions*)        (do-symbols (sym pkg)
727          (setf (symbol-function sym) (original-definition sym)))          (when (eq pkg (symbol-package sym))
728        #||;; maybe even this isn't good enough            (if (constantp sym)
729        #+genera (scl:pkg-kill "PCL")                (unintern sym pkg)
730        #+lucid (lcl:delete-package "PCL")                (progn
731        #-(or genera lucid) (rename-package "PCL" (symbol-name (gensym)))                  (makunbound sym)
732        (make-package "PCL" :use '("LISP"))                  (unless (eq sym 'pcl::reset-pcl-package)
733        ||#                    (fmakunbound sym))
734        (let ((pkg (find-package "PCL")))                  #+cmu (fmakunbound `(setf ,sym))
735          (do-symbols (sym pkg)                  (setf (symbol-plist sym) nil))))))
736            (when (eq pkg (symbol-package sym))      (let ((pkg (find-package "SLOT-ACCESSOR-NAME")))
737              (unless (constantp sym)        (when pkg
               (makunbound sym))  
             (fmakunbound sym)  
             (setf (symbol-plist sym) nil))))  
       (let ((pkg (find-package "SLOT-ACCESSOR-NAME")))  
738          (do-symbols (sym pkg)          (do-symbols (sym pkg)
739            (makunbound sym)            (makunbound sym)
740            (fmakunbound sym)            (fmakunbound sym)
741            (setf (symbol-plist sym) nil)))            (setf (symbol-plist sym) nil))))
742        (let ((pcl (find-package "PCL")))      (let ((pcl (find-package "PCL")))
743          (mapcar #'(lambda (name value)        (mapcar #'(lambda (name value)
744                      (let ((var (intern name pcl)))                    (let ((var (intern name pcl)))
745                        (proclaim `(special ,var))                      (proclaim `(special ,var))
746                        (set var value)))                      (set var value)))
747                  names values)))                names values))
748        nil))      (dolist (sym pcl::*redefined-functions*)
749          (setf (symbol-function sym) (get sym ':definition-before-pcl)))
750        nil))

Legend:
Removed from v.1.3  
changed lines
  Added in v.1.3.1.1

  ViewVC Help
Powered by ViewVC 1.1.5