Commit 0ea363a6 authored by Pascal Costanza's avatar Pascal Costanza
Browse files

Added support for ABCL.

Ignore-this: 5fc582c80296bcf9e9453ea8405bfa8d

darcs-hash:d87a782e65902dd1984e30e767ce533ff9f64390
parent 1a888174
...@@ -21,6 +21,7 @@ ...@@ -21,6 +21,7 @@
#-(or clisp scl) #-(or clisp scl)
(:import-from (:import-from
#+abcl #:ext
#+allegro #:excl #+allegro #:excl
#+clozure #:ccl #+clozure #:ccl
#+cmu #:pcl #+cmu #:pcl
...@@ -32,6 +33,7 @@ ...@@ -32,6 +33,7 @@
#:classp) #:classp)
(:import-from (:import-from
#+abcl #:mop
#+allegro #:mop #+allegro #:mop
#+clisp #:clos #+clisp #:clos
#+clozure #:ccl #+clozure #:ccl
......
...@@ -129,13 +129,13 @@ ...@@ -129,13 +129,13 @@
else append (cdr car) into declarations else append (cdr car) into declarations
finally (return (values documentation declarations (cons car cdr))))) finally (return (values documentation declarations (cons car cdr)))))
#-sbcl (cl:defgeneric make-method-lambda (generic-function method lambda-expression environment)) #-(or abcl sbcl) (cl:defgeneric make-method-lambda (generic-function method lambda-expression environment))
#-ecl #-ecl
(cl:defmethod make-method-lambda ((gf standard-generic-function) (method standard-method) (cl:defmethod make-method-lambda ((gf standard-generic-function) (method standard-method)
lambda-expression environment) lambda-expression environment)
(declare (ignore environment) (optimize (speed 3) (space 0) (compilation-speed 0))) (declare (ignore environment) (optimize (speed 3) (space 0) (compilation-speed 0)))
#+(or clozure lispworks sbcl) #+(or abcl clozure lispworks sbcl)
(when (only-standard-methods gf) (when (only-standard-methods gf)
(return-from make-method-lambda (call-next-method))) (return-from make-method-lambda (call-next-method)))
(let ((args (copy-symbol 'args)) (next-methods (copy-symbol 'next-methods)) (let ((args (copy-symbol 'args)) (next-methods (copy-symbol 'next-methods))
...@@ -424,7 +424,7 @@ ...@@ -424,7 +424,7 @@
(cl:defmethod compute-discriminating-function ((gf standard-generic-function)) (cl:defmethod compute-discriminating-function ((gf standard-generic-function))
(compute-discriminator gf #'call-next-method)) (compute-discriminator gf #'call-next-method))
#-sbcl #-(or abcl sbcl)
(progn (progn
(defun maybe-remove-initial-methods (function-name) (defun maybe-remove-initial-methods (function-name)
(let ((generic-function (ignore-errors (fdefinition function-name)))) (let ((generic-function (ignore-errors (fdefinition function-name))))
...@@ -482,7 +482,7 @@ ...@@ -482,7 +482,7 @@
collect `(defmethod ,name ,@(cdr method-option)))))) collect `(defmethod ,name ,@(cdr method-option))))))
,gf))))))) ,gf)))))))
#+sbcl #+(or abcl sbcl)
(defmacro defgeneric (&whole form name (&rest args) &body options) (defmacro defgeneric (&whole form name (&rest args) &body options)
(unless (every #'consp options) (unless (every #'consp options)
(error "Illegal generic function options in defgeneric form ~S." form)) (error "Illegal generic function options in defgeneric form ~S." form))
...@@ -493,7 +493,7 @@ ...@@ -493,7 +493,7 @@
(eval-when (:load-toplevel :execute) (eval-when (:load-toplevel :execute)
(cl:defgeneric ,name ,args ,@options))))) (cl:defgeneric ,name ,args ,@options)))))
#-sbcl #-(or abcl sbcl)
(progn (progn
(defun create-gf-lambda-list (method-lambda-list) (defun create-gf-lambda-list (method-lambda-list)
(loop with stop-keywords = '#.(remove '&optional lambda-list-keywords) (loop with stop-keywords = '#.(remove '&optional lambda-list-keywords)
...@@ -541,10 +541,10 @@ ...@@ -541,10 +541,10 @@
(:report (lambda (c s) (format s "No generic function present when encountering a defmethod for ~S. Assuming it will be an instance of standard-generic-function." (dwg-name c))))) (:report (lambda (c s) (format s "No generic function present when encountering a defmethod for ~S. Assuming it will be an instance of standard-generic-function." (dwg-name c)))))
(define-symbol-macro warn-on-defmethod-without-generic-function (define-symbol-macro warn-on-defmethod-without-generic-function
#-sbcl t #-(or abcl sbcl) t
#+sbcl nil) #+(or abcl sbcl) nil)
#-sbcl #-(or abcl sbcl)
(defmacro defmethod (&whole form name &body body &environment env) (defmacro defmethod (&whole form name &body body &environment env)
(loop with generic-function = (when (fboundp name) (fdefinition name)) (loop with generic-function = (when (fboundp name) (fdefinition name))
...@@ -587,7 +587,7 @@ ...@@ -587,7 +587,7 @@
',qualifiers (list ,@specializers) ',lambda-list ',qualifiers (list ,@specializers) ',lambda-list
(function ,method-lambda) ',method-options)))))))) (function ,method-lambda) ',method-options))))))))
#+sbcl #+(or abcl sbcl)
(defmacro defmethod (&whole form name &body body &environment env) (defmacro defmethod (&whole form name &body body &environment env)
(declare (ignore body)) (declare (ignore body))
(let ((generic-function (when (fboundp name) (fdefinition name)))) (let ((generic-function (when (fboundp name) (fdefinition name))))
...@@ -615,7 +615,7 @@ ...@@ -615,7 +615,7 @@
#+mcl (eval form))) #+mcl (eval form)))
#+(or clozure ecl lispworks sbcl) #+(or abcl clozure ecl lispworks sbcl)
(defun ensure-method (gf lambda-expression (defun ensure-method (gf lambda-expression
&key (method-class (generic-function-method-class gf)) &key (method-class (generic-function-method-class gf))
(qualifiers ()) (qualifiers ())
......
...@@ -30,6 +30,7 @@ OTHER DEALINGS IN THE SOFTWARE. ...@@ -30,6 +30,7 @@ OTHER DEALINGS IN THE SOFTWARE.
((:file "closer-mop-packages") ((:file "closer-mop-packages")
(:file "closer-mop-shared" :depends-on ("closer-mop-packages")) (:file "closer-mop-shared" :depends-on ("closer-mop-packages"))
(:file (:file
#+abcl "closer-abcl"
#+allegro "closer-allegro" #+allegro "closer-allegro"
#+clisp "closer-clisp" #+clisp "closer-clisp"
#+clozure "closer-clozure" #+clozure "closer-clozure"
......
Markdown is supported
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