Commit a0129e97 authored by Pascal Costanza's avatar Pascal Costanza
Browse files

Removed support for OpenMCL, and simplified CCL conditionalization.

Ignore-this: 60bbee31f73515510139d1c3f4a11afc

darcs-hash:bdca37a43bd610eae149e9982300d145e201998d
parent 48f63329
......@@ -4,15 +4,10 @@
(:use #:common-lisp)
(:nicknames #:c2mop)
#-(or clozure-common-lisp openmcl)
(:shadow #:defclass #:standard-class #:typep #:subtypep)
#-(or clozure-common-lisp openmcl)
(:export #:defclass #:standard-class #:typep #:subtypep)
#+(or clozure-common-lisp openmcl)
(:shadow #:defgeneric #:ensure-generic-function #:standard-generic-function)
#+(or clozure-common-lisp openmcl)
(:export #:defgeneric #:ensure-generic-function #:standard-generic-function)
#-ccl
(:shadow #:standard-class #:typep #:subtypep)
#-ccl
(:export #:typep #:subtypep)
#+ccl
(:shadow
......@@ -52,10 +47,10 @@
#:class-precedence-list
#:class-prototype
#:class-slots
#-(or clozure-common-lisp openmcl mcl) #:compute-applicable-methods-using-classes
#-(or ccl mcl) #:compute-applicable-methods-using-classes
#:compute-class-precedence-list
#:compute-default-initargs
#-(or clozure-common-lisp openmcl) #:compute-discriminating-function
#-ccl #:compute-discriminating-function
#:compute-effective-method
#:compute-effective-slot-definition
#:compute-slots
......@@ -78,7 +73,7 @@
#:generic-function-methods
#:generic-function-name
#:intern-eql-specializer
#-(or clozure-common-lisp openmcl mcl) #:make-method-lambda
#-(or ccl mcl) #:make-method-lambda
#:map-dependents
#-ccl #:method-function
#:method-generic-function
......@@ -88,7 +83,7 @@
#:remove-dependent
#:remove-direct-method
#:remove-direct-subclass
#+(or clozure-common-lisp openmcl) #:set-funcallable-instance-function
#+ccl #:set-funcallable-instance-function
#:slot-boundp-using-class
#:slot-definition-allocation
#:slot-definition-initargs
......@@ -197,7 +192,7 @@
#:remove-dependent
#:remove-direct-method
#:remove-direct-subclass
#+(or clozure-common-lisp openmcl) #:set-funcallable-instance-function
#+ccl #:set-funcallable-instance-function
#:slot-boundp-using-class
#:slot-definition-allocation
#:slot-definition-initargs
......@@ -213,8 +208,8 @@
#:specializer-direct-generic-functions
#:specializer-direct-methods
#:standard-instance-access
#-(or clozure-common-lisp openmcl) #:subtypep
#-(or clozure-common-lisp openmcl) #:typep
#-ccl #:subtypep
#-ccl #:typep
#:update-dependent
#:validate-superclass
#:writer-method-class))
......@@ -2,7 +2,7 @@
;; Some internal utility functions.
#-(or clozure-common-lisp openmcl)
#-ccl
(define-modify-macro nconcf (&rest lists) nconc)
;; Some utility functions.
......@@ -41,7 +41,7 @@
finally (return nil))))
#-(or clozure-common-lisp openmcl)
#-ccl
(progn
;; We need a new standard-class for various things.
......@@ -131,7 +131,7 @@
(:method ((type1 class) (type2 class))
(member type2 (class-precedence-list type1)))))
#+(or clozure-common-lisp openmcl)
#+ccl
(progn
(cl:defgeneric method-function (method)
(:method ((method method))
......@@ -697,10 +697,10 @@
finally (return (nconc args rest)))
,@(cddr lambda-expression))))
;; The following ensures that slot definitions have a documentation in Clozure CL and OpenMCL.
;; The following ensures that slot definitions have a documentation in Clozure CL.
#+(or clozure-common-lisp openmcl)
(defmethod initialize-instance :after ((slot slot-definition) &key documentation)
#+ccl
(cl:defmethod initialize-instance :after ((slot slot-definition) &key documentation)
(setf (documentation slot 't) documentation))
;; The following can be used in direct-slot-definition-class to get the correct initargs
......@@ -720,27 +720,26 @@
:readers :writers))
(defun fix-slot-initargs (initargs)
#+(or clozure-common-lisp openmcl) initargs
#-(or clozure-common-lisp openmcl)
(let* ((counts (loop with counts
for (key nil) on initargs by #'cddr
do (incf (getf counts key 0))
finally (return counts)))
(keys-to-fix (loop for (key value) on counts by #'cddr
if (> value 1) collect key)))
(if keys-to-fix
(let ((multiple-standard-keys
(intersection keys-to-fix *standard-slot-keys*)))
(if multiple-standard-keys
(error "Too many occurences of ~S in slot initargs ~S."
multiple-standard-keys initargs)
(loop with fixed-keys
for (key value) on initargs by #'cddr
if (member key keys-to-fix)
do (nconcf (getf fixed-keys key) (list value))
else nconc (list key value) into fixed-initargs
finally (return (nconc fixed-initargs fixed-keys)))))
initargs)))
#+ccl initargs
#-ccl (let* ((counts (loop with counts
for (key nil) on initargs by #'cddr
do (incf (getf counts key 0))
finally (return counts)))
(keys-to-fix (loop for (key value) on counts by #'cddr
if (> value 1) collect key)))
(if keys-to-fix
(let ((multiple-standard-keys
(intersection keys-to-fix *standard-slot-keys*)))
(if multiple-standard-keys
(error "Too many occurences of ~S in slot initargs ~S."
multiple-standard-keys initargs)
(loop with fixed-keys
for (key value) on initargs by #'cddr
if (member key keys-to-fix)
do (nconcf (getf fixed-keys key) (list value))
else nconc (list key value) into fixed-initargs
finally (return (nconc fixed-initargs fixed-keys)))))
initargs)))
(eval-when (:compile-toplevel :load-toplevel :execute)
(pushnew :closer-mop *features*))
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment