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
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@alice.wu-wien.ac.at http://alice.wu-wien.ac.at/mailman/listinfo/xotcl
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.
Dear Michael,
Uwe has already answered the filter-part. To solve the singleton problem, there is much less code necessary. The following example uses a metaclass that provides an instproc "new":
========================================== Class Singleton -superclass Class Singleton instproc new args { expr {[my exists instance] ? [my set instance] : [my set instance [next]]} } ==========================================
A new singleton can be created in a declarative way, and all calls to "new" will return the same instance (you can also raise errors, if you prefer)
========================================== Singleton MyClass puts "1. [MyClass new]" puts "2. [MyClass new]" ==========================================
Certainly the same maechanism can be applied on "create" as well. In the current XOTcl version, you have to duplicate the instproc for "create", in the forthcoming xotcl version registering a single instproc on create will be sufficient (in 1.0.2, the method new calls directly the implementation of create, the next version will go through the dispatcher).
best regards -gn
Hallo!
As singleton objects I often use Objects directly derived from Object
Object MySingleton MySingleton proc doJob {} { puts "This is my job" }
MySingleton doJob
This is not singleton pattern but is same cases you do not need some Java, C++ solution. One disadvantage is that you can not use method inheritance.
By the way. The presented solution from G. Neumann. That is to overwrite "new" method that returns singleton object is the standard way to implements singleton in Smalltalk (the singleton instance is saved in class variable Default). That is XOTcl! "new" is just method not special operator and can be overwritten.
Artur Trzewik
Hi,
I just had the idea for yet another Singleton variant that was not exactly planned for in the XOTcl design, but seems to work fine: an object that has itself as a class (and Class as a superclass so that it stays a class):
% Class A -superclass Class -class A
that means it can define instprocs on it and dispatch them directly:
% A instproc aProc args {puts ****} % A aProc ****
procs do also work:
% A proc bProc args {puts ++++} % A bProc ++++
and you can derive a subclass from the Singleton:
% Class B -superclass A ::B % B b ::b % b aProc ****
and it conforms to the "Singleton definiton" (a class that has just one instance).
--Uwe
On Tuesday 22 April 2003 21:21, Artur Trzewik wrote:
Hallo!
As singleton objects I often use Objects directly derived from Object
Object MySingleton MySingleton proc doJob {} { puts "This is my job" }
MySingleton doJob
This is not singleton pattern but is same cases you do not need some Java, C++ solution. One disadvantage is that you can not use method inheritance.
By the way. The presented solution from G. Neumann. That is to overwrite "new" method that returns singleton object is the standard way to implements singleton in Smalltalk (the singleton instance is saved in class variable Default). That is XOTcl! "new" is just method not special operator and can be overwritten.
Artur Trzewik
Xotcl mailing list - Xotcl@alice.wu-wien.ac.at http://alice.wu-wien.ac.at/mailman/listinfo/xotcl
an add-on to this variant: Gustaf mentioned that you need an overloaded create method here, if you want to enforce the Singleton property:
A instproc create args {error "cannot create Singleton instance"}
--Uwe
On Tuesday 22 April 2003 22:17, Uwe Zdun wrote:
Hi,
I just had the idea for yet another Singleton variant that was not exactly planned for in the XOTcl design, but seems to work fine: an object that has itself as a class (and Class as a superclass so that it stays a class):
% Class A -superclass Class -class A
that means it can define instprocs on it and dispatch them directly:
% A instproc aProc args {puts ****} % A aProc
procs do also work:
% A proc bProc args {puts ++++} % A bProc ++++
and you can derive a subclass from the Singleton:
% Class B -superclass A
::B
% B b
::b
% b aProc
and it conforms to the "Singleton definiton" (a class that has just one instance).
--Uwe
On Tuesday 22 April 2003 21:21, Artur Trzewik wrote:
Hallo!
As singleton objects I often use Objects directly derived from Object
Object MySingleton MySingleton proc doJob {} { puts "This is my job" }
MySingleton doJob
This is not singleton pattern but is same cases you do not need some Java, C++ solution. One disadvantage is that you can not use method inheritance.
By the way. The presented solution from G. Neumann. That is to overwrite "new" method that returns singleton object is the standard way to implements singleton in Smalltalk (the singleton instance is saved in class variable Default). That is XOTcl! "new" is just method not special operator and can be overwritten.
Artur Trzewik
Xotcl mailing list - Xotcl@alice.wu-wien.ac.at http://alice.wu-wien.ac.at/mailman/listinfo/xotcl
-
Artur Trzewik -
Gustaf Neumann -
Michael A. Cleverly -
Uwe Zdun