Hi,
I'd like to make my own metaclass is CMUCL:
(defclass my-class (standard-class)
(my-slot))
(defclass my-obj ()
()
(:metaclass my-class))
This works well with ACL (and even Closette under xlispstat) but
I get a lot of problems with CMUCL (e.g.
pcl:inform-type-system-about-class
is not specialized to my-class, standard-class vs. structure-class)
What is STRUCTURE-CLASS? How do you write the code above so it does
the right thing?
Thanks,
Tunc
"H. Tunc Simsek" <······@EECS.Berkeley.Edu> writes:
> I'd like to make my own metaclass is CMUCL:
>
> (defclass my-class (standard-class)
> (my-slot))
>
> (defclass my-obj ()
> ()
> (:metaclass my-class))
>
> This works well with ACL (and even Closette under xlispstat) but
> I get a lot of problems with CMUCL (e.g.
> pcl:inform-type-system-about-class
> is not specialized to my-class, standard-class vs. structure-class)
>
> What is STRUCTURE-CLASS? How do you write the code above so it does
> the right thing?
(defclass my-class (pcl::standard-class)
(my-slot))
;;; This is needed, when you want to allow instances of standard-class
;;; to be usable as super-classes of your new my-class instances, like
;;; you do below...
(defmethod mop:validate-superclass
((class my-class) (super pcl::standard-class))
t)
(defclass my-obj ()
()
(:metaclass my-class))
In CMU CL you have to be aware of the fact that CL:STANDARD-CLASS is
not the same as PCL::STANDARD-CLASS, and that CL:STANDARD-CLASS is an
instance of STRUCTURE-CLASS (for performance optimizations?), which in
effect only performs some wrapper duties _for all class objects_.
This only affects you if you want to write MOP-based code, where you
have to take this into account in two ways:
1) Make sure to use PCL::STANDARD-CLASS instead of CL:STANDARD-CLASS
when defining your own meta-classes, and
2) When you try to get the class-object of an object-instance, you
have to use (pcl::coerce-to-pcl-class (class-of instance)) instead
of only (class-of instance), to get the real meta-object.
I.e. in your example, this looks like this:
* (defclass my-class (pcl::standard-class)
((my-slot)))
#<STANDARD-CLASS MY-CLASS {481EF145}>
* (defmethod mop:validate-superclass ((class my-class) (super pcl::standard-class)) t)
#<Standard-Method PCL:VALIDATE-SUPERCLASS (MY-CLASS
PCL::STANDARD-CLASS) {480DA4A5}>
* (defclass my-obj ()
() (:metaclass my-class))
#<STANDARD-CLASS MY-OBJ {480FA2F5}>
* (make-instance 'my-obj)
#<MY-OBJ {480FD1FD}>
* (class-of *)
#<STANDARD-CLASS MY-OBJ {480FA2F5}>
* (pcl::coerce-to-pcl-class *)
#<My-Class MY-OBJ {480F1045}>
* (class-of **)
#<STRUCTURE-CLASS STANDARD-CLASS {501083D}>
* (class-of **)
#<STANDARD-CLASS MY-CLASS {481EF145}>
Regs, Pierre.
--
Pierre Mai <····@acm.org> PGP and GPG keys at your nearest Keyserver
"One smaller motivation which, in part, stems from altruism is Microsoft-
bashing." [Microsoft memo, see http://www.opensource.org/halloween1.html]
Great, I'll try that. While on the subject I'd also like to ask
whether anyone has used the free-clim with cmucl. I recently
installed cmucl for solaris with all the provided subsystems
then I loaded DEFSYSTEM and then CLINC. Everything seemed to
be fine until I got the message
*root-window* is unbound
Has anybody encountered this problem.
The fact is that I really need the plotting functionality
of xlispstat (e.g. PLOT-LINES) or something similar.
I need this because I run simulations and have no way
to view the results. Can anyone suggest a utility?
Thanks,
Tunc
"Pierre R. Mai" wrote:
>
> "H. Tunc Simsek" <······@EECS.Berkeley.Edu> writes:
>
> > I'd like to make my own metaclass is CMUCL:
> >
> > (defclass my-class (standard-class)
> > (my-slot))
> >
> > (defclass my-obj ()
> > ()
> > (:metaclass my-class))
> >
> > This works well with ACL (and even Closette under xlispstat) but
> > I get a lot of problems with CMUCL (e.g.
> > pcl:inform-type-system-about-class
> > is not specialized to my-class, standard-class vs. structure-class)
> >
> > What is STRUCTURE-CLASS? How do you write the code above so it does
> > the right thing?
>
> (defclass my-class (pcl::standard-class)
> (my-slot))
>
> ;;; This is needed, when you want to allow instances of standard-class
> ;;; to be usable as super-classes of your new my-class instances, like
> ;;; you do below...
> (defmethod mop:validate-superclass
> ((class my-class) (super pcl::standard-class))
> t)
>
> (defclass my-obj ()
> ()
> (:metaclass my-class))
>
> In CMU CL you have to be aware of the fact that CL:STANDARD-CLASS is
> not the same as PCL::STANDARD-CLASS, and that CL:STANDARD-CLASS is an
> instance of STRUCTURE-CLASS (for performance optimizations?), which in
> effect only performs some wrapper duties _for all class objects_.
> This only affects you if you want to write MOP-based code, where you
> have to take this into account in two ways:
>
> 1) Make sure to use PCL::STANDARD-CLASS instead of CL:STANDARD-CLASS
> when defining your own meta-classes, and
> 2) When you try to get the class-object of an object-instance, you
> have to use (pcl::coerce-to-pcl-class (class-of instance)) instead
> of only (class-of instance), to get the real meta-object.
>
> I.e. in your example, this looks like this:
>
> * (defclass my-class (pcl::standard-class)
> ((my-slot)))
>
> #<STANDARD-CLASS MY-CLASS {481EF145}>
> * (defmethod mop:validate-superclass ((class my-class) (super pcl::standard-class)) t)
>
> #<Standard-Method PCL:VALIDATE-SUPERCLASS (MY-CLASS
> PCL::STANDARD-CLASS) {480DA4A5}>
> * (defclass my-obj ()
> () (:metaclass my-class))
>
> #<STANDARD-CLASS MY-OBJ {480FA2F5}>
> * (make-instance 'my-obj)
>
> #<MY-OBJ {480FD1FD}>
> * (class-of *)
>
> #<STANDARD-CLASS MY-OBJ {480FA2F5}>
> * (pcl::coerce-to-pcl-class *)
>
> #<My-Class MY-OBJ {480F1045}>
> * (class-of **)
>
> #<STRUCTURE-CLASS STANDARD-CLASS {501083D}>
> * (class-of **)
>
> #<STANDARD-CLASS MY-CLASS {481EF145}>
>
> Regs, Pierre.
>
> --
> Pierre Mai <····@acm.org> PGP and GPG keys at your nearest Keyserver
> "One smaller motivation which, in part, stems from altruism is Microsoft-
> bashing." [Microsoft memo, see http://www.opensource.org/halloween1.html]
"H. Tunc Simsek" <······@EECS.Berkeley.Edu> writes:
> Great, I'll try that. While on the subject I'd also like to ask
> whether anyone has used the free-clim with cmucl. I recently
> installed cmucl for solaris with all the provided subsystems
> then I loaded DEFSYSTEM and then CLINC. Everything seemed to
> be fine until I got the message
>
> *root-window* is unbound
>
> Has anybody encountered this problem.
AFAIK both CLINC and free-clim are not in a really usable state at the
moment, and probably won't be for some time.
> The fact is that I really need the plotting functionality
> of xlispstat (e.g. PLOT-LINES) or something similar.
> I need this because I run simulations and have no way
> to view the results. Can anyone suggest a utility?
If you just want some way to do a GUI and some low-level drawing, I'd
suggest you use something like CMUCL's CLM (in combination with CLX),
which although somewhat low-level, works quite well. Other
possibilities for CMU CL include:
- GARNET, which isn't CLOS-based, but is a bit more high-level, if
somewhat complex, the CMU CL port can be found under
http://www2.cons.org:8000/ftp-area/cmucl/ports/garnet/
- SLIK might be worth a try, available under
http://www.radonc.washington.edu/medinfo/prism/
ftp://ftp.radonc.washington.edu/dist/slik/
- GINA, XIT, etc., see the ALU Website at http://www.alu.org/ for more
infos on other toolkits.
If OTOH you (just) need graphing capabilities, you might be better off
using some thin wrapper code to a gnuplot process in the background.
I've done this once, and it's quite easy to do, and gives nice results
(which can also easily be printed and/or saved to bitmaps). You can
also use this in combination with a simple GUI using any of the
toolkits above. The code that I wrote then is quick&dirty, incomplete
and not that well thought out, but it allows you to do things like the
following to get an xy-chart...
(let* ((fuell-series (make-instance 'xy-series
:title "Fuellstand"
:style "lines"
:x-sequence zeit-seq
:y-sequence fuell-seq))
(frag-series (make-instance 'xy-series
:title "Fragmentierung"
:style "lines"
:x-sequence zeit-seq
:y-sequence frag-seq))
(chart (make-instance 'xy-chart
:title "Lagerprofil"
:x-axis-title "Simulationstag"
:y-axis-title "Prozent"
:x-range-min 0
:y-range-min 0
:y-range-max 100
:series (list fuell-series frag-series))))
(plot-chart chart nil nil t))
It might also be interesting to do a FFI binding to IBM's OpenDX
data-exploration and -visualization toolkit/app.
Or you might try to port some of the XLispStat stuff to (CMU) CL, or
do some FFI binding to it...
I'm afraid there aren't that many ready-made, maintained graphing
packages for CL around, AFAIK, so some DIY work is needed...
Regs, Pierre.
--
Pierre Mai <····@acm.org> PGP and GPG keys at your nearest Keyserver
"One smaller motivation which, in part, stems from altruism is Microsoft-
bashing." [Microsoft memo, see http://www.opensource.org/halloween1.html]
I have tried to define a COMMON-MOP package that I can use in portable
code, which glosses over the details of different implementations.
CMUCL has been a problem.
Here's the package definition, some comments, and some code that I have
been using. Comments and improvements are welcome.
;;; mop-pkg.lisp ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(in-package :common-lisp-user)
;;; In any system that supports the MOP properly,
;;; common-mop::STANDARD-CLASS, common-mop::BUILT-IN-CLASS,
;;; common-mop::CLASS, common-mop::FIND-CLASS and common-mop::CLASS-OF
;;; are the same as the symbols of the same name in the Common Lisp
;;; package. For some systems (PCL), they are different. We don't
;;; export these CL symbols from here becasue we don't want packages
;;; that :use :common-mop to have to shadow one or the other.
;;; Instead, such other packages will just use the CL symbols.
;;;
;;; However, when creating your own kinds of standard-class, you might
;;; need to explicitly refer to common-mop::standard-class,
;;; common-mop::find-class and/or common-mop::class-of. Note that
;;; when the common-mop and CL symbols are the same (as on most
;;; Lisps), then you don't loose anything by explicitly refering to
;;; the common-mop symbols.
(defpackage :COMMON-MOP
(:use :common-lisp #+allegro clos #+pcl pcl)
;; Fix implementation-specific bugs.
#+allegro-v4.1
(:shadow "ENSURE-CLASS" "SLOT-VALUE-USING-CLASS")
#+cmu
(:shadowing-import-from
:pcl
"BUILT-IN-CLASS" "CLASS-OF" "FIND-CLASS" "CLASS")
#+cmu
(:shadow "CLASS-NAME" "STANDARD-CLASS")
(:export
"ADD-DIRECT-SUBCLASS" "CLASS-DEFAULT-INITARGS"
"CLASS-DIRECT-DEFAULT-INITARGS" "CLASS-DIRECT-SLOTS"
"CLASS-DIRECT-SUBCLASSES" "CLASS-DIRECT-SUPERCLASSES"
"CLASS-FINALIZED-P" "CLASS-PRECEDENCE-LIST" "CLASS-PROTOTYPE"
"CLASS-SLOTS" "COMPUTE-APPLICABLE-METHODS-USING-CLASSES"
"COMPUTE-CLASS-PRECEDENCE-LIST" "COMPUTE-DEFAULT-INITARGS"
"COMPUTE-DISCRIMINATING-FUNCTION" "COMPUTE-EFFECTIVE-METHOD"
"COMPUTE-EFFECTIVE-SLOT-DEFINITION" "COMPUTE-SLOTS"
"DIRECT-SLOT-DEFINITION" "DIRECT-SLOT-DEFINITION-CLASS"
"EFFECTIVE-SLOT-DEFINITION" "EFFECTIVE-SLOT-DEFINITION-CLASS"
"ENSURE-CLASS" "ENSURE-CLASS-USING-CLASS"
"ENSURE-GENERIC-FUNCTION-USING-CLASS" "EQL-SPECIALIZER"
"EQL-SPECIALIZER-OBJECT" "EXTRACT-LAMBDA-LIST"
"EXTRACT-SPECIALIZER-NAMES" "FINALIZE-INHERITANCE"
"FIND-METHOD-COMBINATION" "FORWARD-REFERENCED-CLASS"
"FUNCALLABLE-STANDARD-CLASS" "FUNCALLABLE-STANDARD-INSTANCE-ACCESS"
"GENERIC-FUNCTION-ARGUMENT-PRECEDENCE-ORDER"
"GENERIC-FUNCTION-DECLARATIONS" "GENERIC-FUNCTION-LAMBDA-LIST"
"GENERIC-FUNCTION-METHOD-CLASS"
"GENERIC-FUNCTION-METHOD-COMBINATION" "GENERIC-FUNCTION-METHODS"
"GENERIC-FUNCTION-NAME" "INTERN-EQL-SPECIALIZER"
"MAKE-METHOD-LAMBDA" "MAP-DEPENDENTS" "METAOBJECT"
"METHOD-FUNCTION" "METHOD-GENERIC-FUNCTION" "METHOD-LAMBDA-LIST"
"METHOD-SPECIALIZERS" "ACCESSOR-METHOD-SLOT-DEFINITION"
"READER-METHOD-CLASS" "REMOVE-DEPENDENT" "REMOVE-DIRECT-METHOD"
"REMOVE-DIRECT-SUBCLASS" "SET-FUNCALLABLE-INSTANCE-FUNCTION"
"SLOT-BOUNDP-USING-CLASS" "SLOT-DEFINITION"
"SLOT-DEFINITION-ALLOCATION" "SLOT-DEFINITION-INITARGS"
"SLOT-DEFINITION-INITFORM" "SLOT-DEFINITION-INITFUNCTION"
"SLOT-DEFINITION-LOCATION" "SLOT-DEFINITION-NAME"
"SLOT-DEFINITION-READERS" "SLOT-DEFINITION-WRITERS"
"SLOT-DEFINITION-TYPE" "SLOT-MAKUNBOUND-USING-CLASS"
"SLOT-VALUE-USING-CLASS" "SPECIALIZER"
"SPECIALIZER-DIRECT-GENERIC-FUNCTIONS" "SPECIALIZER-DIRECT-METHODS"
"STANDARD-ACCESSOR-METHOD" "STANDARD-DIRECT-SLOT-DEFINITION"
"STANDARD-EFFECTIVE-SLOT-DEFINITION" "STANDARD-INSTANCE-ACCESS"
"STANDARD-READER-METHOD" "STANDARD-SLOT-DEFINITION"
"STANDARD-WRITER-METHOD" "UPDATE-DEPENDENT" "VALIDATE-SUPERCLASS"
"WRITER-METHOD-CLASS"))
;;; mop-pcl.lisp
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(in-package :common-mop)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; STANDARD-CLASS
;;;
;;; I can't figure out PCL's handling of standard-class. Looking at
;;; CMUCL:
;;;
;;; PCL::STANDARD-CLASS is a cl:standard-class, and one can make
;;; instances of it. It's CPL correctly has pcl:class and
;;; standard-object.
;;;
;;; CL:STANDARD-CLASS is a structure-class, and you can't make
;;; instances of it. It's CPL correctly has cl:class, but not
;;; standard-object.
;;;
;;; It seems like pcl::standard-class is closer to correct. However,
;;; although it supports an :initarg NAME, accessed through
;;; CLASS-NAME, it does not not allow anything other than symbols.
;;; Here we define our own STANDARD-CLASS, inheriting from
;;; pcl::standard-class, but with our own "class-name" slot and
;;; accessor.
(defclass STANDARD-CLASS (pcl::standard-class)
((class-name :initarg :class-name :reader CLASS-NAME)))
(defmethod CLASS-NAME ((class pcl::class)) (pcl:class-name class))
(defmethod CLASS-NAME ((class cl:class)) (cl:class-name class))
(defmethod mangle-non-symbol-name ((name CONS))
(destructuring-bind (key &rest more) name
(let ((cache (or (get key 'mangled-names)
(setf (get key 'mangled-names)
(make-hash-table :test #'equal)))))
(or (gethash more cache)
(setf (gethash more cache)
(loop with result = (symbol-name key)
for element in more
do (setq result
(concatenate
'string result
"+" (package-name
(symbol-package element))
"." (symbol-name element)))
finally (return (intern result (symbol-package key)))))))))
(defun fix-name-initargs (name namep initargs)
(when namep
(setf (getf initargs :class-name) name)
(setf (getf initargs :name) (mangle-non-symbol-name name)))
initargs)
(defmethod INITIALIZE-INSTANCE :AROUND ((class STANDARD-CLASS)
&key (name nil namep)
&rest initargs)
(apply #'call-next-method class
(fix-name-initargs name namep initargs)))
(defmethod REINITIALIZE-INSTANCE :AROUND ((class STANDARD-CLASS)
&key (name nil namep)
&rest initargs)
(apply #'call-next-method class
(fix-name-initargs name namep initargs)))
(defmethod VALIDATE-SUPERCLASS ((class standard-class)
(superclass pcl::standard-class))
t)
;;; mop-excl-4-1.lisp ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(in-package :common-mop)
;;; Allegro slot argument is a symbol, MOP requires a slot-definition
object.
(defmethod SLOT-VALUE-USING-CLASS ((class CLASS) instance (slot
SLOT-DEFINITION))
(clos:slot-value-using-class class instance (slot-definition-name
slot)))
(defmethod (SETF SLOT-VALUE-USING-CLASS) (value
(class CLASS) instance (slot SLOT-DEFINITION))
(setf (slot-value instance (slot-definition-name slot)) value))
;;; Allegro doesn't deal well with existing (bult-in-) classes.
;;; This isn't right, but it fixes things enough for CLIM.
(defun ENSURE-CLASS (name &rest keys)
(let ((class (find-class name nil)))
(if (and class (null keys))
class
(apply #'clos:ensure-class name keys))))
> ;;; mop-excl-4-1.lisp ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
> (in-package :common-mop)
>
> ;;; Allegro slot argument is a symbol, MOP requires a slot-definition
> object.
>
> (defmethod SLOT-VALUE-USING-CLASS ((class CLASS) instance (slot
> SLOT-DEFINITION))
> (clos:slot-value-using-class class instance (slot-definition-name
> slot)))
>
> (defmethod (SETF SLOT-VALUE-USING-CLASS) (value
> (class CLASS) instance (slot SLOT-DEFINITION))
> (setf (slot-value instance (slot-definition-name slot)) value))
>
> ;;; Allegro doesn't deal well with existing (bult-in-) classes.
> ;;; This isn't right, but it fixes things enough for CLIM.
> (defun ENSURE-CLASS (name &rest keys)
> (let ((class (find-class name nil)))
> (if (and class (null keys))
> class
> (apply #'clos:ensure-class name keys))))
In my experience (I've been using Allegro 3.01 & 5.01 for windows & unix
and also cmu 18b for unix)
that in Allegro:
(defmethod slot-value-using-class ((class standard-class)
instance
(slot standard-effective-slot-definition))
is the correct formals for this function and in CMUCL:
(defmethod slot-value-using-class ((class standard-class)
instance
slot-name)
is the way its implemented.
Tunc