diff options
author | Matthias Benkard <code@mail.matthias.benkard.de> | 2008-03-03 17:06:49 +0100 |
---|---|---|
committer | Matthias Benkard <code@mail.matthias.benkard.de> | 2008-03-03 17:06:49 +0100 |
commit | 644d70511f705264dd181626f3b306c87da0ac32 (patch) | |
tree | 2336b17c196dfa2ee1037303b6d8768d51a3c52f /Lisp | |
parent | e141e5ddee4a2e9d6c8d9872b702f5923581f0b3 (diff) |
Make INTERN-POINTER-WRAPPER work with the new keyword type specifiers.
darcs-hash:0e08a15a056adda2ad9872d9785d95a048ee2ac4
Diffstat (limited to 'Lisp')
-rw-r--r-- | Lisp/memory-management.lisp | 14 |
1 files changed, 7 insertions, 7 deletions
diff --git a/Lisp/memory-management.lisp b/Lisp/memory-management.lisp index d603092..890e96f 100644 --- a/Lisp/memory-management.lisp +++ b/Lisp/memory-management.lisp @@ -31,7 +31,7 @@ ;; be called at load-time (see the MAKE-LOAD-FORM methods in ;; data-types.lisp). (make-instance 'id :pointer (objcl-get-nil)))) - (when (not (eq 'selector class)) + (when (not (member class '(selector :selector))) (cond ((%objcl-object-is-meta-class pointer) (return-from intern-pointer-wrapper (find-objc-meta-class-by-name (%objcl-class-name pointer)))) @@ -42,9 +42,9 @@ (return-from intern-pointer-wrapper (apply #'intern-lisp-managed-foreign-instance initargs))))) (let* ((hash-table (ecase class - ((id) *id-objects*) - ((exception) *exception-objects*) - ((selector) *selector-objects*))) + ((id :id) *id-objects*) + ((exception :exception) *exception-objects*) + ((selector :selector) *selector-objects*))) (address (cffi:pointer-address pointer)) (object (weak-gethash address hash-table nil))) (if object @@ -74,7 +74,7 @@ ;; ;; By the way, is using the return value of SETF considered bad style? (let* ((constructor (case class - ((exception) #'make-condition) + ((exception :exception) #'make-condition) (otherwise #'make-instance))) (*in-make-pointer-wrapper-p* t) (new-wrapper (apply constructor @@ -87,7 +87,7 @@ ;; case of POINTER pointing to a class, ;; because it is handled right at the ;; beginning of the function. - (if (eq class 'id) + (if (member class '(id :id)) (primitive-invoke pointer "class" 'id) @@ -100,7 +100,7 @@ ;; management for them would not be healthy. Considering these ;; facts, doing memory management only for id instances seems the ;; right thing to do. - (when (eq class 'id) + (when (member class '(id :id)) ;; We call the `retain' method on every object that we receive ;; from a method call or otherwise except non-convenience ;; constructor methods (i.e. those whose name starts with `alloc' |