1 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
2 ;;;; *************************************************************************
3 ;;;; FILE IDENTIFICATION
5 ;;;; Name: package.lisp
6 ;;;; Purpose: Package definition for hyperobject package
7 ;;;; Programmer: Kevin M. Rosenberg
8 ;;;; Date Started: Apr 2000
10 ;;;; This file is Copyright (c) 2000-2003 by Kevin M. Rosenberg
11 ;;;; *************************************************************************
13 (in-package #:cl-user)
16 (eval-when (:compile-toplevel :load-toplevel :execute)
17 (if (eq (symbol-package 'pcl:find-class)
18 (find-package 'common-lisp))
19 (pushnew :kmr-cmucl-mop cl:*features*)
20 (pushnew :kmr-cmucl-pcl cl:*features*)))
22 (eval-when (:compile-toplevel :load-toplevel :execute)
23 (when (find-package '#:hyperobject-tests)
24 (delete-package '#:hyperobject-tests))
25 (when (find-package '#:hyperobject-user)
26 (delete-package '#:hyperobject-user))
27 (when (find-package '#:hyperobject)
28 (delete-package '#:hyperobject)))
30 (defpackage #:hyperobject
32 (:use #:common-lisp #:kmrcl
37 #+openmcl #:openmcl-mop)
42 #:hyperobject-class-user-name
47 #:processed-queued-definitions
53 (defpackage #:hyperobject-user
54 (:nicknames #:ho-user)
55 (:use #:hyperobject #:cl #:cl-user))
57 (eval-when (:compile-toplevel :load-toplevel :execute)
59 (dolist (name '("CLASS-OF"
64 "SLOT-DEFINITION-NAME"
65 "FINALIZE-INHERITANCE"
66 "STANDARD-DIRECT-SLOT-DEFINITION"
67 "CLASS-PRECEDENCE-LIST"
68 "STANDARD-EFFECTIVE-SLOT-DEFINITION"
69 "VALIDATE-SUPERCLASS" "DIRECT-SLOT-DEFINITION-CLASS"
70 "EFFECTIVE-SLOT-DEFINITION-CLASS"
71 "COMPUTE-EFFECTIVE-SLOT-DEFINITION"
73 "COMPUTE-EFFECTIVE-SLOT-DEFINITION-INITARGS"
74 "SLOT-VALUE-USING-CLASS"
76 "GENERIC-FUNCTION-METHOD-CLASS"
77 "INTERN-EQL-SPECIALIZER"
79 "GENERIC-FUNCTION-LAMBDA-LIST"
81 (let ((sym (find-symbol name "SB-MOP")))
83 (progn (shadowing-import sym :hyperobject))
85 (setq sym (find-symbol name "SB-PCL"))
87 (shadowing-import sym :hyperobject)
88 (warn "Can't find function ~A in packages SB-MOP or SB-PCL" name))))))
92 '(excl::compute-effective-slot-definition-initargs)
94 '(clos::compute-effective-slot-definition-initargs)
96 '(pcl::compute-effective-slot-definition-initargs)
98 '(pcl:class-of pcl:class-name pcl:class-slots pcl:find-class pcl::standard-class
99 pcl::slot-definition-name pcl:finalize-inheritance
100 pcl::standard-direct-slot-definition pcl::standard-effective-slot-definition
101 pcl::validate-superclass pcl:direct-slot-definition-class
102 pcl:compute-effective-slot-definition
103 pcl::compute-effective-slot-definition-initargs
104 pcl::slot-value-using-class
105 pcl:class-prototype pcl:generic-function-method-class pcl:intern-eql-specializer
106 pcl:make-method-lambda pcl:generic-function-lambda-list
107 pcl:slot-definition-type
108 pcl::class-precedence-list)
110 '(clos:class-name clos:class-slots clos:find-class clos::standard-class
111 clos::slot-definition-name clos:finalize-inheritance
112 clos::standard-direct-slot-definition clos::standard-effective-slot-definition
113 clos::validate-superclass clos:direct-slot-definition-class
114 clos:effective-slot-definition-class
115 clos:slot-definition-type
116 clos:compute-effective-slot-definition
117 clos::compute-effective-slot-definition-initargs
118 clos::slot-value-using-class
119 clos:class-prototype clos:generic-function-method-class clos:intern-eql-specializer
120 clos:generic-function-lambda-list
121 clos::class-precedence-list)
123 '(clos::compute-effective-slot-definition-initargs
124 clos::class-prototype
125 clos:slot-definition-type
126 ;; note: make-method-lambda is not fbound
131 (eval-when (:compile-toplevel :load-toplevel :execute)
132 (if (find-package 'mop)
133 (setq cl:*features* (delete :kmr-cmucl-mop cl:*features*))
134 (setq cl:*features* (delete :kmr-cmucl-pcl cl:*features*))))