From e7029a2475adb009ed1b80d400429dcbd35f34ae Mon Sep 17 00:00:00 2001 From: "Kevin M. Rosenberg" Date: Tue, 29 Apr 2003 05:02:21 +0000 Subject: [PATCH] r4681: Auto commit for Debian build --- mop.lisp | 131 +++++++++++++++++++++++++++---------------------------- 1 file changed, 64 insertions(+), 67 deletions(-) diff --git a/mop.lisp b/mop.lisp index 401a55d..b5a5ef1 100644 --- a/mop.lisp +++ b/mop.lisp @@ -7,7 +7,7 @@ ;;;; Programmer: Kevin M. Rosenberg ;;;; Date Started: Apr 2003 ;;;; -;;;; $Id: mop.lisp,v 1.4 2003/04/29 04:59:51 kevin Exp $ +;;;; $Id: mop.lisp,v 1.5 2003/04/29 05:02:21 kevin Exp $ ;;;; ;;;; This file, part of KMRCL, is Copyright (c) 2002 by Kevin M. Rosenberg ;;;; @@ -45,81 +45,78 @@ (in-package #:kmr-mop) -(shadowing-import - #+allegro - '(excl::compute-effective-slot-definition-initargs) - #+lispworks - '(clos::compute-effective-slot-definition-initargs) - #+kmr-sbcl-mop - '(sb-pcl::compute-effective-slot-definition-initargs) - #+kmr-sbcl-pcl - '(sb-pcl:class-of sb-pcl:class-name sb-pcl:class-slots sb-pcl:find-class - sb-pcl::standard-class - sb-pcl:slot-definition-name sb-pcl::finalize-inheritance - sb-pcl::standard-direct-slot-definition - sb-pcl::standard-effective-slot-definition sb-pcl::validate-superclass - sb-pcl::direct-slot-definition-class sb-pcl::compute-effective-slot-definition - sb-pcl::compute-effective-slot-definition-initargs - sb-pcl::slot-value-using-class - sb-pcl:class-prototype sb-pcl:generic-function-method-class sb-pcl:intern-eql-specializer - sb-pcl:make-method-lambda sb-pcl:generic-function-lambda-list - sb-pcl::compute-slots) - #+kmr-cmucl-mop - '(pcl::compute-effective-slot-definition-initargs) - #+kmr-cmucl-pcl - '(pcl:class-of pcl:class-name pcl:class-slots pcl:find-class pcl::standard-class - pcl::slot-definition-name pcl:finalize-inheritance - pcl::standard-direct-slot-definition pcl::standard-effective-slot-definition - pcl::validate-superclass pcl:direct-slot-definition-class - pcl:compute-effective-slot-definition - pcl::compute-effective-slot-definition-initargs - pcl::slot-value-using-class - pcl:class-prototype pcl:generic-function-method-class pcl:intern-eql-specializer - pcl:make-method-lambda pcl:generic-function-lambda-list - pcl::compute-slots) - #+scl - '(clos::compute-effective-slot-definition-initargs - clos::class-prototype - ;; note: make-method-lambda is not fbound - ) - '#:kmr-mop) - -(export '(#:class-of #:class-name #:class-slots #:find-class - #:standard-class - #:slot-definition-name #:finalize-inheritance - #:standard-direct-slot-definition - #:standard-effective-slot-definition #:validate-superclass - #:direct-slot-definition-class #:compute-effective-slot-definition - #:compute-effective-slot-definition-initargs - #:slot-value-using-class - #:class-prototype #:generic-function-method-class #:intern-eql-specializer - #:make-method-lambda #:generic-function-lambda-list - #:compute-slots)) - - -#+sbcl (eval-when (:compile-toplevel :load-toplevel :execute) + (shadowing-import + #+allegro + '(excl::compute-effective-slot-definition-initargs) + #+lispworks + '(clos::compute-effective-slot-definition-initargs) + #+kmr-sbcl-mop + '(sb-pcl::compute-effective-slot-definition-initargs) + #+kmr-sbcl-pcl + '(sb-pcl:class-of sb-pcl:class-name sb-pcl:class-slots sb-pcl:find-class + sb-pcl::standard-class + sb-pcl:slot-definition-name sb-pcl::finalize-inheritance + sb-pcl::standard-direct-slot-definition + sb-pcl::standard-effective-slot-definition sb-pcl::validate-superclass + sb-pcl::direct-slot-definition-class sb-pcl::compute-effective-slot-definition + sb-pcl::compute-effective-slot-definition-initargs + sb-pcl::slot-value-using-class + sb-pcl:class-prototype sb-pcl:generic-function-method-class sb-pcl:intern-eql-specializer + sb-pcl:make-method-lambda sb-pcl:generic-function-lambda-list + sb-pcl::compute-slots) + #+kmr-cmucl-mop + '(pcl::compute-effective-slot-definition-initargs) + #+kmr-cmucl-pcl + '(pcl:class-of pcl:class-name pcl:class-slots pcl:find-class pcl::standard-class + pcl::slot-definition-name pcl:finalize-inheritance + pcl::standard-direct-slot-definition pcl::standard-effective-slot-definition + pcl::validate-superclass pcl:direct-slot-definition-class + pcl:compute-effective-slot-definition + pcl::compute-effective-slot-definition-initargs + pcl::slot-value-using-class + pcl:class-prototype pcl:generic-function-method-class pcl:intern-eql-specializer + pcl:make-method-lambda pcl:generic-function-lambda-list + pcl::compute-slots) + #+scl + '(clos::compute-effective-slot-definition-initargs + clos::class-prototype + ;; note: make-method-lambda is not fbound + ) + '#:kmr-mop) + + (export '(#:class-of #:class-name #:class-slots #:find-class + #:standard-class + #:slot-definition-name #:finalize-inheritance + #:standard-direct-slot-definition + #:standard-effective-slot-definition #:validate-superclass + #:direct-slot-definition-class #:compute-effective-slot-definition + #:compute-effective-slot-definition-initargs + #:slot-value-using-class + #:class-prototype #:generic-function-method-class #:intern-eql-specializer + #:make-method-lambda #:generic-function-lambda-list + #:compute-slots)) + + #+sbcl (if (find-package 'sb-mop) (setq cl:*features* (delete :kmr-sbcl-mop cl:*features*)) - (setq cl:*features* (delete :kmr-sbcl-pcl cl:*features*)))) - -#+cmu -(eval-when (:compile-toplevel :load-toplevel :execute) + (setq cl:*features* (delete :kmr-sbcl-pcl cl:*features*))) + + #+cmu (if (find-package 'mop) (setq cl:*features* (delete :kmr-cmucl-mop cl:*features*)) - (setq cl:*features* (delete :kmr-cmucl-pcl cl:*features*)))) - -(eval-when (:compile-toplevel :load-toplevel :execute) + (setq cl:*features* (delete :kmr-cmucl-pcl cl:*features*))) + (when (>= (length (generic-function-lambda-list (ensure-generic-function 'compute-effective-slot-definition))) 3) - (pushnew :kmr-normal-cesd cl:*features*))) - -(eval-when (:compile-toplevel :load-toplevel :execute) + (pushnew :kmr-normal-cesd cl:*features*)) + (when (>= (length (generic-function-lambda-list - (ensure-generic-function - 'direct-slot-definition-class))) + (ensure-generic-function + 'direct-slot-definition-class))) 3) - (pushnew :kmr-normal-dsdc cl:*features*))) + (pushnew :kmr-normal-dsdc cl:*features*)) + ) ;; eval-when -- 2.34.1