[Xotcl] Help with singleton design pattern

[Uwe Zdun]

If you add a simple output message:
  puts *********[self calledproc]
to the singletonCreateFilter you can see that the only methods (other than 
create) that pass the filterguard are those that are called before the 
filterguard is active. Here this is only the method "filterguard" itself. 
This cannot be avoided as you register filter/filterguard directly on the 
instance:

>     $class filterappend singletonCreateFilter
>     $class filterguard singletonCreateFilter \
>             {[self calledproc] == "create"}

actually this is not the best solution because any instance of the mixin 
requires this filter. Better you register it as an instance filter for the 
mixin:

Singleton instfilterappend singletonCreateFilter 
Singleton instfilterguard singletonCreateFilter \
    {[self calledproc] == "create"}

that also avoids that other methods than create are dispatched to the filter, 
as no other method is called on the instance (here: C) between filter and 
filterguard registration. Once the guard is registered only create passes it.

--uwe


On Saturday 19 April 2003 07:40, Michael A. Cleverly wrote:
> As I'm starting to learn XOTcl, I decided to try and implement a singleton
> design pattern as an educational exercise.
>
> Here is what I've come up with see below). I'd appreciate help
> understanding why my filterguard registration does not work as I'd expect
> it to.  (I'd also appreciate feedback on style, or if my comments
> indicate a misunderstanding of what the code actually does, etc.)
>
> Thanks again for all the help.
>
> Michael
>
> #!/bin/sh
> # -*- tcl -*- \
> exec tclsh $0 ${1+"$@"}
>
> package require Tcl 8.4
> package require XOTcl 1.0
> namespace import -force xotcl::*
>
> Class Singleton
> Singleton instproc singletonCreateFilter args {
>     # Despite adding a filterguard (see below) for some reason
>     # the "C foo" below would fail because a singleton instance of
>     # class C exists ("::singletonCreateFilter" ?!??) if we don't also
>     # check to make sure [self calledproc] == create here.
>     #
>     # I don't understand why ...
>     if {[self calledproc] != "create"} {
>         return [next]
>     }
>
>     [self class] instvar singletons
>     set obj   [lindex $args 0]
>     set class [self]
>
>     # if the object name isn't a fully qualified name make it so
>     if {![string match ::* $obj]} {
>         set obj [namespace parent]::$obj
>     }
>
>     # don't throw an error if we're recreating the same object
>     if {[info exists singletons($class)] &&
>         [string equal $singletons($class) $obj] == 0} {
>         error "Can't instantiate \"$obj\" of singleton class\
>             \"$class\"; \"$singletons($class)\" already instantiated"
>     }
>
>     set singletons($class) $obj
>     next
> }
>
> Singleton instproc singletonDestroyFilter args {
>     [self class] instvar singletons
>
>     set class [my info class] ;# equiv of [self] info class
>
>     # if other objects existed before Singleton registerClass
>     # was called, and those objects are deleted, we don't care
>     if {$singletons($class) == [self]} {
>         unset singletons($class)
>     }
>
>     next
> }
>
> Singleton proc registerClass class {
>     my instvar singletons
>     my instvar registered
>
>     # make sure we're dealing with a class
>     if {[my isclass $class] == 0} {
>         error "\"$class\" isn't a class;\
>             hence, can't make it a singleton class."
>
>     }
>
>     # Don't "double register" a class
>     if {[info exists registered] &&
>         [lsearch -exact $registered $class] != -1} then return
>
>
>     # We need to mixin to the object to filter the obj creation
>     # We need to mixin to the class to filter obj destruction
>     $class mixinappend [self]
>     $class instmixinappend [self]
>
>     $class filterappend singletonCreateFilter
>     $class filterguard singletonCreateFilter \
>             {[self calledproc] == "create"}
>
>     $class instfilterappend singletonDestroyFilter
>     $class instfilterguard singletonDestroyFilter \
>         {[self calledproc] == "destroy"}
>
>     lappend registered $class
> }
>
> Singleton proc create args {
>     # doesn't make sense to instantiate objects of the singleton class
>     error "Can't instantiate an object of \"[self]\";\
>         use \"[self] registerClass className\" instead."
> }
>
> Class C
>
> # just a quick sanity check to make sure our filter doesn't
> # keep us from defining instance procs or using them
> C instproc datetime {} {
>     clock format [clock seconds]
> }
>
> Singleton registerClass C
>
> # don't expect/don't want [C foo] to fail
> C foo
> puts [foo datetime]
>
> # We expect/want [C bar] to fail
> C bar
>
> _______________________________________________
> Xotcl mailing list  -  Xotcl at alice.wu-wien.ac.at
> http://alice.wu-wien.ac.at/mailman/listinfo/xotcl

-- 
Uwe Zdun
Department of Information Systems, Vienna University of Economics
Phone: +43 1 313 36 4796, Fax: +43 1 313 36 746
zdun@{xotcl,computer,acm}.org, uwe.zdun at wu-wien.ac.at