On Sat, 8 Jan 2011 15:48:33 +0100, Pascal Costanza <[email protected]> wrote: > > On 8 Jan 2011, at 14:15, Samium Gromoff wrote: > > > On Fri, 7 Jan 2011 23:42:23 +0100, Pascal Costanza <[email protected]> wrote: > >> There is no real advantage in having shared slots over global special > >> variables. On top of that, the slot access protocols in the CLOS MOP > >> also don't work that well in conjunction with shared slots. So it's > >> better to avoid them. Fortunately, this is the only feature in CLOS that > >> doesn't make any sense, as far as I can tell. > > > > This is sad, indeed, as shared slots could have been used to associate > > information with sub-lattice of the class relationship lattice. I have > > been tempted to do exactly this, multiple times, having, instead, to > > resort to manual storage of this information. > > What exactly would you like to do? There are ways to do such things using the > CLOS MOP...
Ok, real world code, beware. While reading, only pay attention how VCS-TYPE-MIXIN threads through the "slices". (defclass vcs-type-mixin () (# the following slot is absent in real code, I have to emulate it (enabled-p :accessor vcs-type-enabled-p :allocation :class) (vcs-type :reader vcs-type :initarg :vcs-type))) ;;;;; VCS slice (protocol classes) ;;; exhaustive partition of VCS-TYPE-MIXIN (defclass git (vcs-type-mixin) () (:default-initargs :vcs-type 'git)) (defclass nongit-mixin () ()) (defclass hg (vcs-type-mixin nongit-mixin) () (:default-initargs :vcs-type 'hg)) (defclass darcs (vcs-type-mixin nongit-mixin) () (:default-initargs :vcs-type 'darcs)) (defclass cvs (vcs-type-mixin wrinkle-mixin nongit-mixin) () (:default-initargs :vcs-type 'cvs)) (defclass svn (vcs-type-mixin wrinkle-mixin nongit-mixin) () (:default-initargs :vcs-type 'svn)) (defclass tarball (vcs-type-mixin nongit-mixin) () (:default-initargs :vcs-type 'tarball)) ;;;;; product slice (protocol classes) ;;; exhaustive partition of type product of VCS-TYPE, TRANSPORT-MIXIN, CLONE-SEPARATION-MIXIN, and ;;; FETCH-INDIRECTION-MIXIN (defclass git-native (git native direct-fetch clone-is-fetch) () (:default-initargs :schema 'git)) (defclass git-http (git http direct-fetch clone-is-fetch) ()) ;;; ...... 8< ...... (defclass git-combined (git-native git-http combined) ()) ;;; ...... >8 ...... (defclass hg-http (hg http indirect-fetch separate-clone) ()) (defclass darcs-http (darcs http indirect-fetch separate-clone) ()) (defclass cvs-rsync (cvs rsync indirect-fetch clone-is-fetch) ()) (defclass cvs-native (cvs native direct-fetch clone-is-fetch) () (:default-initargs :schema '|:PSERVER|)) (defclass tarball-http (tarball http direct-fetch clone-is-fetch) ((initial-version :accessor initial-tarball-version :initarg :initial-version))) (defclass svn-rsync (svn rsync indirect-fetch clone-is-fetch) ()) ;;; ...... 8< ...... (defclass svn-direct (svn direct-fetch) ()) ;;; ...... >8 ...... (defclass svn-http (svn-direct http #| direct |# clone-is-fetch) ()) (defclass svn-native (svn-direct native #| direct |# clone-is-fetch) () (:default-initargs :schema 'svn)) ;;;;; intermediate slice (protocol classes) ;;; Location * VCS (defclass git-remote (remote git) ()) (defclass darcs-remote (remote darcs) ()) (defclass hg-remote (remote hg) ()) (defclass cvs-remote (remote cvs) ()) (defclass svn-remote (remote svn) ()) (defclass tarball-remote (remote tarball) ()) ;;;;; instantiable classes ;;; almost most specific (due to GATE mixin), exhaustive partition of REMOTE (defclass git-native-remote (git-remote git-native) ()) (defclass git-http-remote (git-remote git-http) ()) (defclass git-combined-remote (git-remote git-combined) ()) (defclass hg-http-remote (hg-remote hg-http) ()) (defclass darcs-http-remote (darcs-remote darcs-http) ()) (defclass cvs-rsync-remote (cvs-remote cvs-rsync) ()) (defclass cvs-native-remote (cvs-remote cvs-native) ()) (defclass svn-rsync-remote (svn-remote svn-rsync) ()) (defclass svn-http-remote (svn-remote svn-http) ()) (defclass svn-native-remote (svn-remote svn-native) ()) (defclass tarball-http-remote (tarball-remote tarball-http) ()) (defun vcs-enabled-p (type) "Problem function." (class-slot type 'enabled-p)) ...I want to be able to use VCS-ENABLED-P on any slice before instantiable classes are instantiated. -- regards, Samium Gromoff -- "Actually I made up the term 'object-oriented', and I can tell you I did not have C++ in mind." - Alan Kay (OOPSLA 1997 Keynote) _______________________________________________ pro mailing list [email protected] http://common-lisp.net/cgi-bin/mailman/listinfo/pro
