X-Git-Url: http://git.kpe.io/?p=hyperobject.git;a=blobdiff_plain;f=package.lisp;h=392caa6493e4ac28b8bdd67e03e0068e3ad36897;hp=2cff019cefab96be7d7448b22c3a45e1a696c7a1;hb=HEAD;hpb=abbf89f03cec17db594badafbaee4f5e1400ba94 diff --git a/package.lisp b/package.lisp index 2cff019..a2c4bcd 100644 --- a/package.lisp +++ b/package.lisp @@ -1,108 +1,134 @@ -;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*- -;;;; ************************************************************************* -;;;; FILE IDENTIFICATION -;;;; -;;;; Name: package.lisp -;;;; Purpose: Package definition for hyperobject package -;;;; Programmer: Kevin M. Rosenberg -;;;; Date Started: Apr 2000 -;;;; -;;;; $Id: package.lisp,v 1.49 2003/06/06 21:59:29 kevin Exp $ -;;;; -;;;; This file is Copyright (c) 2000-2003 by Kevin M. Rosenberg -;;;; ************************************************************************* - -(in-package #:cl-user) - -#+sbcl -(eval-when (:compile-toplevel :load-toplevel :execute) - (if (find-package 'sb-mop) - (pushnew :kmr-sbcl-mop cl:*features*) - (pushnew :kmr-sbcl-pcl cl:*features*))) - -#+cmu -(eval-when (:compile-toplevel :load-toplevel :execute) - (if (eq (symbol-package 'pcl:find-class) - (find-package 'common-lisp)) - (pushnew :kmr-cmucl-mop cl:*features*) - (pushnew :kmr-cmucl-pcl cl:*features*))) - - -(defpackage #:hyperobject - (:nicknames #:ho) - (:use #:common-lisp #:kmrcl - #+kmr-sbcl-mop #:sb-mop - #+kmr-cmucl-mop #:mop - #+allegro #:mop - #+lispworks #:clos - #+scl #:clos) - (:export - #:package - #:hyperobject - #:hyperobject-class - #:hyperobject-class-user-name - #:load-all-subobjects - #:view - #:fmt-comma-integer - #:processed-queued-definitions - #:all-subobjects - #:subobjects - )) - -(defpackage #:hyperobject-user - (:nicknames #:ho-user) - (:use #:hyperobject #:cl #:cl-user)) - - -(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::class-precedence-list) - #+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::class-precedence-list) - #+scl - '(clos::compute-effective-slot-definition-initargs - clos::class-prototype - ;; note: make-method-lambda is not fbound - ) - - :hyperobject)) - -#+sbcl -(eval-when (:compile-toplevel :load-toplevel :execute) - (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) - (if (find-package 'mop) - (setq cl:*features* (delete :kmr-cmucl-mop cl:*features*)) - (setq cl:*features* (delete :kmr-cmucl-pcl cl:*features*)))) +;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*- +;;;; ************************************************************************* +;;;; FILE IDENTIFICATION +;;;; +;;;; Name: package.lisp +;;;; Purpose: Package definition for hyperobject package +;;;; Programmer: Kevin M. Rosenberg +;;;; Date Started: Apr 2000 +;;;; +;;;; This file is Copyright (c) 2000-2003 by Kevin M. Rosenberg +;;;; ************************************************************************* + +(in-package #:cl-user) + +#+cmu +(eval-when (:compile-toplevel :load-toplevel :execute) + (if (eq (symbol-package 'pcl:find-class) + (find-package 'common-lisp)) + (pushnew :kmr-cmucl-mop cl:*features*) + (pushnew :kmr-cmucl-pcl cl:*features*))) + +(eval-when (:compile-toplevel :load-toplevel :execute) + (when (find-package '#:hyperobject-tests) + (delete-package '#:hyperobject-tests)) + (when (find-package '#:hyperobject-user) + (delete-package '#:hyperobject-user)) + (when (find-package '#:hyperobject) + (delete-package '#:hyperobject))) + +(defpackage #:hyperobject + (:nicknames #:ho) + (:use #:common-lisp #:kmrcl + #+kmr-cmucl-mop #:mop + #+allegro #:mop + #+lispworks #:clos + #+scl #:clos + #+openmcl #:openmcl-mop) + (:export + #:package + #:hyperobject + #:hyperobject-class + #:hyperobject-class-user-name + #:load-all-subobjects + #:view + #:view-subobjects + #:fmt-comma-integer + #:processed-queued-definitions + #:all-subobjects + #:subobjects + #:cdata + )) + +(defpackage #:hyperobject-user + (:nicknames #:ho-user) + (:use #:hyperobject #:cl #:cl-user)) + +(eval-when (:compile-toplevel :load-toplevel :execute) + #+sbcl + (dolist (name '("CLASS-OF" + "CLASS-NAME" + "CLASS-SLOTS" + "FIND-CLASS" + "STANDARD-CLASS" + "SLOT-DEFINITION-NAME" + "FINALIZE-INHERITANCE" + "STANDARD-DIRECT-SLOT-DEFINITION" + "CLASS-PRECEDENCE-LIST" + "STANDARD-EFFECTIVE-SLOT-DEFINITION" + "VALIDATE-SUPERCLASS" "DIRECT-SLOT-DEFINITION-CLASS" + "EFFECTIVE-SLOT-DEFINITION-CLASS" + "COMPUTE-EFFECTIVE-SLOT-DEFINITION" + "CLASS-DIRECT-SLOTS" + "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")) + (let ((sym (find-symbol name "SB-MOP"))) + (if sym + (progn (shadowing-import sym :hyperobject)) + (progn + (setq sym (find-symbol name "SB-PCL")) + (if sym + (shadowing-import sym :hyperobject) + (warn "Can't find function ~A in packages SB-MOP or SB-PCL" name)))))) + #-sbcl + (shadowing-import + #+allegro + '(excl::compute-effective-slot-definition-initargs) + #+lispworks + '(clos::compute-effective-slot-definition-initargs) + #+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:slot-definition-type + pcl::class-precedence-list) + #+clisp + '(clos:class-name clos:class-slots clos:find-class clos::standard-class + clos::slot-definition-name clos:finalize-inheritance + clos::standard-direct-slot-definition clos::standard-effective-slot-definition + clos::validate-superclass clos:direct-slot-definition-class + clos:effective-slot-definition-class + clos:slot-definition-type + clos:compute-effective-slot-definition + clos::compute-effective-slot-definition-initargs + clos::slot-value-using-class + clos:class-prototype clos:generic-function-method-class clos:intern-eql-specializer + clos:generic-function-lambda-list + clos::class-precedence-list) + #+scl + '(clos::compute-effective-slot-definition-initargs + clos::class-prototype + clos:slot-definition-type + ;; note: make-method-lambda is not fbound + ) + :hyperobject)) + +#+cmu +(eval-when (:compile-toplevel :load-toplevel :execute) + (if (find-package 'mop) + (setq cl:*features* (delete :kmr-cmucl-mop cl:*features*)) + (setq cl:*features* (delete :kmr-cmucl-pcl cl:*features*))))