Commit 347d934e authored by Pascal Costanza's avatar Pascal Costanza
Browse files

Added a new utility function ensure-finalized.

A pretty common idiom is this:

(unless (class-finalized-p class)
  (finalize-inheritance class))
class

This is captured in the new utility function ensure-finalized.

darcs-hash:7d147f9c086e13bd2b83e670953ac124ec7dcb27
parent a7e766d3
......@@ -115,6 +115,7 @@
#:standard-slot-definition
#:standard-writer-method
#:ensure-finalized
#:ensure-method
#:fix-slot-initargs
#:required-args
......
(in-package :closer-mop)
;; This is a useful utility function.
;; Some utility functions.
(defun required-args (lambda-list &optional (collector #'identity))
(loop for arg in lambda-list
until (member arg lambda-list-keywords)
collect (funcall collector arg)))
(defun ensure-finalized (class &optional (errorp t))
(if (typep class 'class)
(unless (class-finalized-p class)
(finalize-inheritance class))
(when errorp (error "~S is not a class." class)))
class)
;; We need a new standard-class for various things.
(cl:defclass standard-class (cl:standard-class)
......
......@@ -108,6 +108,7 @@
#:standard-slot-definition
#:standard-writer-method
#:ensure-finalized
#:ensure-method
#:fix-slot-initargs
#:required-args
......
(in-package :closer-mop)
;; This is a useful utility function.
;; Some utility functions.
(defun required-args (lambda-list &optional (collector #'identity))
(loop for arg in lambda-list
until (member arg lambda-list-keywords)
collect (funcall collector arg)))
(defun ensure-finalized (class &optional (errorp t))
(if (typep class 'class)
(unless (class-finalized-p class)
(finalize-inheritance class))
(when errorp (error "~S is not a class." class)))
class)
(defun ensure-method (gf lambda-expression
&key (qualifiers ())
(lambda-list (cadr lambda-expression))
......
......@@ -113,6 +113,7 @@
#:standard-slot-definition
#:standard-writer-method
#:ensure-finalized
#:ensure-method
#:fix-slot-initargs
#:required-args
......
(in-package :closer-mop)
;; This is a useful utility function.
;; Some utility functions.
(defun required-args (lambda-list &optional (collector #'identity))
(loop for arg in lambda-list
until (member arg lambda-list-keywords)
collect (funcall collector arg)))
(defun ensure-finalized (class &optional (errorp t))
(if (typep class 'class)
(unless (class-finalized-p class)
(finalize-inheritance class))
(when errorp (error "~S is not a class." class)))
class)
(defun extract-lambda-list (lambda-list)
(loop for (arg . rest) on lambda-list
until (member arg lambda-list-keywords)
......
......@@ -118,6 +118,7 @@
#:standard-slot-definition
#:standard-writer-method
#:ensure-finalized
#:ensure-method
#:fix-slot-initargs
#:required-args
......
(in-package :closer-mop)
;; This is a useful utility function.
;; Some utility functions.
(defun required-args (lambda-list &optional (collector #'identity))
(loop for arg in lambda-list
until (member arg lambda-list-keywords)
collect (funcall collector arg)))
(defun ensure-finalized (class &optional (errorp t))
(if (typep class 'class)
(unless (class-finalized-p class)
(finalize-inheritance class))
(when errorp (error "~S is not a class." class)))
class)
;; We need a new standard-generic-function for various things.
(cl:defclass standard-generic-function (cl:standard-generic-function)
......
......@@ -113,6 +113,7 @@
#:standard-slot-definition
#:standard-writer-method
#:ensure-finalized
#:ensure-method
#:fix-slot-initargs
#:required-args
......
(in-package :closer-mop)
;; This is a useful utility function.
;; Some utility functions.
(defun required-args (lambda-list &optional (collector #'identity))
(loop for arg in lambda-list
until (member arg lambda-list-keywords)
collect (funcall collector arg)))
(defun ensure-finalized (class &optional (errorp t))
(if (typep class 'class)
(unless (class-finalized-p class)
(finalize-inheritance class))
(when errorp (error "~S is not a class." class)))
class)
#-openmcl
(progn
;; We need a new standard-class for various things.
......
......@@ -113,6 +113,7 @@
#:standard-slot-definition
#:standard-writer-method
#:ensure-finalized
#:ensure-method
#:fix-slot-initargs
#:required-args
......
(in-package :closer-mop)
;; This is a useful utility function.
;; Some utility functions.
(defun required-args (lambda-list &optional (collector #'identity))
(loop for arg in lambda-list
until (member arg lambda-list-keywords)
collect (funcall collector arg)))
(defun ensure-finalized (class &optional (errorp t))
(if (typep class 'class)
(unless (class-finalized-p class)
(finalize-inheritance class))
(when errorp (error "~S is not a class." class)))
class)
;; The following is commented out. SBCL now supports compatible standard-class and
;; funcallable-standard-class metaclasses, but this requires that we don't mess with
;; the class hierarchy anymore. So we will try the trick we have already used
......
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