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]"