Posted to tcl by aspect at Mon Jul 27 00:38:35 GMT 2015view pretty
# # I'm not sure how useful this is yet, but it's a little hack for reloadable classes with persistent objects # Inspiration from sdw's "Lifecycle of Objects" presentation # # It relies on some TclOO magic sauce: # # * the class of an object can be changed during its lifetime without affecting the rest of the object's state # * when a class is destroyed, its own destructor is run before its instances are destroyed # * subclassing oo::class to make a metaclass is trivial (if a little mind-bending) # # Once these are established, all that remains is how to keep track of the zombies' original class for later # resuscitation. It's tempting to try and store this in the zombie class, but a regular namespace variable # proves simpler. # #pkg -export {lazarus} zombies namespace eval zombies { oo::class create zombie { method unknown {cmd args} { puts "Unknown method call on zombie! [self] [list $cmd] $args" throw [list TCL LOOKUP METHOD $cmd] "Zombie methods cannot be called!" } } variable Horde ;# where zombies are arranged by (former) class proc infect {cls} { variable Horde foreach obj [info class instances $cls] { puts "Burying $cls $obj" oo::objdefine $obj class zombie dict lappend Horde $cls $obj } } proc come_forth {cls} { variable Horde if {[info exists Horde] && [dict exists $Horde $cls]} { foreach obj [dict get $Horde $cls] { puts "Waking zombie $cls $obj" oo::objdefine $obj class $cls } dict unset Horde $cls } } oo::class create lazarus { superclass oo::class ;# Lazarus is a metaclass constructor args { next {*}$args ;# create the class normally ::zombies::come_forth [self object] ;# raise the dead! } destructor { ::zombies::infect [self] } } namespace export lazarus }; namespace import zombies::* proc mkclass {} { lazarus create C { variable V constructor {v} {set V $v} method v {args} {set V {*}$args} } } mkclass C create a "Hello" C create b "World" puts "[a v] [b v]; [a v] [b v Tcl!]" try {a v} on error {e o} {puts "ERROR: $e"} C destroy mkclass puts "[a v] [b v]"