X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fpcl%2Fenv.lisp;h=bf41126775b2bb4f7646e59736107a82290688ed;hb=104ee7ee303efa16e415f5e75df635ac54dba733;hp=b63eaaab2f93875debdedc711f145d2f260724d1;hpb=a530bbe337109d898d5b4a001fc8f1afa3b5dc39;p=sbcl.git

diff --git a/src/pcl/env.lisp b/src/pcl/env.lisp
index b63eaaa..bf41126 100644
--- a/src/pcl/env.lisp
+++ b/src/pcl/env.lisp
@@ -24,14 +24,11 @@
 ;;;; specification.
 
 (in-package "SB-PCL")
-
-(sb-int:file-comment
-  "$Header$")
 
 ;;; FIXME: This stuff isn't part of the ANSI spec, and isn't even
 ;;; exported from PCL, but it looks as though it might be useful,
 ;;; so I don't want to just delete it. Perhaps it should go in
-;;; a contrib/ directory eventually?
+;;; a "contrib" directory eventually?
 
 #|
 ;;; TRACE-METHOD and UNTRACE-METHOD accept method specs as arguments. A
@@ -51,7 +48,7 @@
 ;;;   You can also provide a method object in the place of the method
 ;;;   spec, in which case that method object will be traced.
 ;;;
-;;; For untrace-method, if an argument is given, that method is untraced.
+;;; For UNTRACE-METHOD, if an argument is given, that method is untraced.
 ;;; If no argument is given, all traced methods are untraced.
 (defclass traced-method (method)
      ((method :initarg :method)
@@ -106,45 +103,10 @@
 
 (defun trace-method-internal (ofunction name options)
   (eval `(untrace ,name))
-  (setf (symbol-function name) ofunction)
+  (setf (fdefinition name) ofunction)
   (eval `(trace ,name ,@options))
-  (symbol-function name))
-|#
-
-;(defun compile-method (spec)
-;  (multiple-value-bind (gf method name)
-;      (parse-method-or-spec spec)
-;    (declare (ignore gf))
-;    (compile name (method-function method))
-;    (setf (method-function method) (symbol-function name))))
-
-;;; not used in SBCL
-#|
-(defmacro undefmethod (&rest args)
-  (declare (arglist name {method-qualifier}* specializers))
-  `(undefmethod-1 ',args))
-
-(defun undefmethod-1 (args)
-  (multiple-value-bind (gf method)
-      (parse-method-or-spec args)
-    (when (and gf method)
-      (remove-method gf method)
-      method)))
+  (fdefinition name))
 |#
-
-;;; FIXME: Delete these.
-#|
-(pushnew :pcl *features*)
-(pushnew :portable-commonloops *features*)
-(pushnew :pcl-structures *features*)
-|#
-
-;;; FIXME: This was for some unclean bootstrapping thing we don't
-;;; need in SBCL, right? So we can delete it, right?
-;;; #+cmu
-;;; (when (find-package "OLD-PCL")
-;;;   (setf (symbol-function (find-symbol "PRINT-OBJECT" :old-pcl))
-;;;	(symbol-function 'sb-pcl::print-object)))
 
 ;;;; MAKE-LOAD-FORM
 
@@ -185,10 +147,10 @@
 
 (macrolet ((frob (&rest names)
 	     `(progn
-		,@(mapcar #'(lambda (name)
-			      `(defmethod ,name ((class cl:class))
-				 (funcall #',name
-					  (coerce-to-pcl-class class))))
+		,@(mapcar (lambda (name)
+			    `(defmethod ,name ((class cl:class))
+			       (funcall #',name
+					(coerce-to-pcl-class class))))
 			  names))))
   (frob
     class-direct-slots