On Sat, 8 Jan 2011 15:48:33 +0100, Pascal Costanza pc@p-cos.net wrote:
On 8 Jan 2011, at 14:15, Samium Gromoff wrote:
On Fri, 7 Jan 2011 23:42:23 +0100, Pascal Costanza pc@p-cos.net 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.