MAKE-CONDITION is not specified to have any "exceptional situations":
http://www.lisp.org/HyperSpec/Body/fun_make-condition.html
What should it do when it is supplied a valid type specifier for a
_subtype_ of CONDITION which does not name a known _subclass_ of
CONDITION (in an obvious way)?
e.g., (make-condition '(or simple-error program-error))?
(here returning (make-condition 'simple-error) would work)
or (make-condition '(or simple-error program-error))?
(here we might create a class that inherits from both simple-error and
program-error on the fly and return its instance).
--
Sam Steingold (http://www.podval.org/~sds) running w2k
http://www.openvotingconsortium.org/ http://www.jihadwatch.org/
http://www.mideasttruth.com/ http://www.honestreporting.com http://ffii.org/
The only guy who got all his work done by Friday was Robinson Crusoe.
"Sam Steingold" <···@gnu.org> wrote in message ··················@gnu.org...
> MAKE-CONDITION is not specified to have any "exceptional situations":
> http://www.lisp.org/HyperSpec/Body/fun_make-condition.html
> What should it do when it is supplied a valid type specifier for a
> _subtype_ of CONDITION which does not name a known _subclass_ of
> CONDITION (in an obvious way)?
> e.g., (make-condition '(or simple-error program-error))?
> (here returning (make-condition 'simple-error) would work)
> or (make-condition '(or simple-error program-error))?
> (here we might create a class that inherits from both simple-error and
> program-error on the fly and return its instance).
>
I'd rather have an error. The feeling I get from section 9.1 is
that a subtype of condition was expected to be either predefined
by the implementation or declared with DEFINE-CONDITION, rather
than a 'generic' type-specifier.
--
Geoff
> What should it do when it is supplied a valid type specifier for a
>_subtype_ of CONDITION which does not name a known _subclass_
> of CONDITION (in an obvious way)?
If it helps you somehow, the decision I took for ECL was to traverse
the class tree looking for a condition type that is a subtype of the
specified type. If no class is found, then an error is signaled.
Juanjo
"Juanjo" <····@arrakis.es> writes:
>> What should it do when it is supplied a valid type specifier for a
>>_subtype_ of CONDITION which does not name a known _subclass_
>> of CONDITION (in an obvious way)?
>
> If it helps you somehow, the decision I took for ECL was to traverse
> the class tree looking for a condition type that is a subtype of the
> specified type. If no class is found, then an error is signaled.
Just out of curiosity, does anyone really think that the authors of
the standard actually expected (make-condition '(or foo bar) ...) to
work? If they did, don't you think they'd have specified more clearly
the answer to Sam's question? In other words, isn't it possible that
the listing of the type argument as being a "type specifier" is a
glitch in the standard? Which is not to say that implementors
shouldn't be pedantic and go ahead and implement it as if it isn't a
glitch, if it is. Just wondering.
-Peter
--
Peter Seibel * ·····@gigamonkeys.com
Gigamonkeys Consulting * http://www.gigamonkeys.com/
Practical Common Lisp * http://www.gigamonkeys.com/book/
>In other words, isn't it possible that
>the listing of the type argument as being a "type specifier" is a
>glitch in the standard?
I do not think it is entirely a glitch. This allows you to have a type
synonym, as defined by DEFTYPE, for instance. In any case, it is not
really such a big issue, since as I mentioned before it can be
implemented in three lines of code, as in the TRY-CLASS below.
(defun make-condition (type &rest slot-initializations)
(labels ((try-class (class)
(if (subtypep class type)
class
(some #'try-class (clos::class-direct-subclasses class)))))
(let ((class (or (and (symbolp type) (find-class type nil))
(try-class (find-class 'condition)))))
(unless class
(error 'SIMPLE-TYPE-ERROR
:DATUM type
:EXPECTED-TYPE 'CONDITION
:FORMAT-CONTROL "Not a condition type: ~S"
:FORMAT-ARGUMENTS (list type)))
(apply #'make-instance class slot-initializations))))
"Juanjo" <····@arrakis.es> writes:
> (defun make-condition (type &rest slot-initializations)
> (labels ((try-class (class)
> (if (subtypep class type)
> class
> (some #'try-class (clos::class-direct-subclasses class)))))
> (let ((class (or (and (symbolp type) (find-class type nil))
> (try-class (find-class 'condition)))))
> (unless class
> (error 'SIMPLE-TYPE-ERROR
> :DATUM type
> :EXPECTED-TYPE 'CONDITION
> :FORMAT-CONTROL "Not a condition type: ~S"
> :FORMAT-ARGUMENTS (list type)))
> (apply #'make-instance class slot-initializations))))
This depth-first search does not always find the most appropriate class.
(define-condition a () ())
(define-condition b () ())
(define-condition c () ())
(define-condition d (a b c) ())
(deftype e () 'b)
;; SBCL 0.9.5.50 doesn't add to sb-mop:class-direct-subclasses without this.
(find-class 'd)
(juanjo-make-condition 'e)
;; => #<D {9100911}>
But changing the search to breadth-first would not fix it either.
I suppose one could first run your try-class, and then select the
last suitable class in the class precedence list of the result.
> This depth-first search does not always find the most appropriate class.
> But changing the search to breadth-first would not fix it either.
> I suppose one could first run your try-class, and then select the
> last suitable class in the class precedence list of the result.
What about this:
(defun make-condition (type &rest slot-initializations)
(labels ((try-class (class)
(when (subtypep type class)
(if (subtypep class type)
class
(some #'try-class (clos::class-direct-subclasses class))))))
(let ((class (or (and (symbolp type) (find-class type nil))
(try-class (find-class 'condition)))))
(unless class
(error 'SIMPLE-TYPE-ERROR
:DATUM type
:EXPECTED-TYPE 'CONDITION
:FORMAT-CONTROL "Not a condition type: ~S"
:FORMAT-ARGUMENTS (list type)))
(apply #'make-instance class slot-initializations))))
(define-condition a () ())
(define-condition b () ())
(define-condition c () ())
(define-condition d (a b c) ())
(deftype e () 'b)
(make-condition 'e)
=> #<a B>
This version is better: it handles both DEFTYPE synonyms as well as
more complex types, such as '(OR PROGRAM-TYPE SIMPLE-ERROR). Notice
that I rarely use LOOP in my code at all and thus there might be better
ways to write this function:
(defun make-condition (type &rest slot-initializations)
(labels ((try-class (classes)
;; First try looking for a class on this level which is in the
type
(or (loop for class in classes
when (subtypep class type)
do (return (print class)))
;; Next we move to the following level
(loop for class in (print classes)
for x = (try-class (clos::class-direct-subclasses class))
when x do (return x)))))
(let ((class (or (and (symbolp type) (find-class type nil))
(try-class (list (find-class 'condition))))))
(unless class
(error 'SIMPLE-TYPE-ERROR
:DATUM type
:EXPECTED-TYPE 'CONDITION
:FORMAT-CONTROL "Not a condition type: ~S"
:FORMAT-ARGUMENTS (list type)))
(apply #'make-instance class slot-initializations))))
> * Juanjo <····@neenxvf.rf> [2005-11-18 06:27:12 -0800]:
>
> (let ((class (or (and (symbolp type) (find-class type nil))
> (try-class (list (find-class 'condition))))))
how about this:
(defun find-subclasses-of-type (type class)
"Find all subclasses of CLASS that are subtypes of the given TYPE."
(if (subtypep class type)
(list class)
(delete-duplicates
(loop :for c :in (clos:class-direct-subclasses class)
:nconc (find-subclasses-of-type type c)))))
(defun prune-subclasses (classes)
"Delete classes that are subclasses of other classes."
(do ((tail classes (cdr tail)) this)
((endp tail) (delete nil classes))
(setq this (car tail))
(when (loop :for c :in classes
;; when THIS is a subclass of C, remove THIS
:some (and c (not (eq this c)) (clos::subclassp this c)))
(setf (car tail) nil))))
....
(let ((class (or (and (symbolp type) (find-class type nil))
;; not a specific class - find a maximal subclass of
;; CONDITION that has the given TYPE
(car (prune-subclasses (find-subclasses-of-type
type (find-class 'condition)))))))
....
--
Sam Steingold (http://www.podval.org/~sds) running w2k
http://www.openvotingconsortium.org/ http://www.honestreporting.com
http://www.savegushkatif.org http://www.memri.org/ http://truepeace.org
PI seconds is a nanocentury
Slightly simplified:
(defun find-subclasses-of-type (class type level)
(if (subtypep class type)
(list (cons level class))
(loop with level = (1+ level)
for class in (class-direct-subclasses class)
nconc (find-subclasses-of-type class type level))))
(defun topmost-class (class-list)
(cdr (first (sort class-list #'< :key #'car))))
....
(let ((class (or (and (symbolp type) (find-class type nil))
;; not a specific class - find a maximal subclass of
;; CONDITION that has the given TYPE
(car (topmost-class (find-subclasses-of-type
type (find-class
'condition)))))))
....
Of course I meant
...
(let ((class (or (and (symbolp type) (find-class type nil))
;; not a specific class - find a maximal subclass of
;; CONDITION that has the given TYPE
(car (topmost-class (find-subclasses-of-type
type (find-class 'condition)
0))))))
...
Sorry for the noise.
Juanjo
> * Juanjo <····@neenxvf.rf> [2005-11-18 08:49:53 -0800]:
>
> Slightly simplified:
>
> (defun find-subclasses-of-type (class type level)
> (if (subtypep class type)
> (list (cons level class))
> (loop with level = (1+ level)
> for class in (class-direct-subclasses class)
> nconc (find-subclasses-of-type class type level))))
>
you will have same classes with different levels. yuk.
--
Sam Steingold (http://www.podval.org/~sds) running w2k
http://pmw.org.il/ http://www.mideasttruth.com/ http://www.memri.org/
http://www.savegushkatif.org http://www.iris.org.il
Perl: all stupidities of UNIX in one.
Sam Steingold schrieb:
> > * Juanjo <····@neenxvf.rf> [2005-11-18 08:49:53 -0800]:
> >
> > Slightly simplified:
> >
> > (defun find-subclasses-of-type (class type level)
> > (if (subtypep class type)
> > (list (cons level class))
> > (loop with level = (1+ level)
> > for class in (class-direct-subclasses class)
> > nconc (find-subclasses-of-type class type level))))
> >
>
> you will have same classes with different levels. yuk.
I do not think this is really a problem, is it? In the end the lowest
level is chosen due to the sorting.
Juanjo
even simpler:
> (defun find-subclasses-of-type (type class)
> "Find all subclasses of CLASS that are subtypes of the given TYPE."
> (if (subtypep class type)
> (list class)
> (delete-duplicates
> (loop :for c :in (clos:class-direct-subclasses class)
> :nconc (find-subclasses-of-type type c)))))
(let ((class (or (and (symbolp type) (find-class type nil))
;; not a specific class - find a maximal subclass of
;; CONDITION that has the given TYPE
(car (last (sort (find-subclasses-of-type
type (find-class 'condition))
#'clos::subclassp))))))
--
Sam Steingold (http://www.podval.org/~sds) running w2k
http://www.dhimmi.com/ http://www.mideasttruth.com/ http://ffii.org/
http://www.memri.org/ http://www.savegushkatif.org
He who laughs last did not get the joke.
Kalle Olavi Niemitalo <···@iki.fi> writes:
> ;; SBCL 0.9.5.50 doesn't add to sb-mop:class-direct-subclasses without this.
> (find-class 'd)
That doesn't seem ideal. I've patched this in sbcl-0.9.6.51 so that
the call to find-class should no longer be necessary.
Christophe