Version 0 of Aspect Support Class for TclOO

Updated 2007-11-12 10:02:14 by dkf

The Aspect class is a metaclass that acts as a generator for aspects. Use it just like you would oo::class, except that there is now a new aspect definition command.

oo::class create Aspect {
    superclass oo::class

    constructor {{script ""}} {
	variable AspectNameGen 1
	interp alias {} ::oo::define::aspect {} \
		{*}[namespace code {my DefineAspect}]
	set cls [next $script]
	interp alias {} ::oo::define::aspect {}
    }
    method DefineAspect args {
	set opts [dict merge {
	    -name {}
	    -condition 1 -before {} -after {}
	    -variable ASPECT__result -trap ASPECT__options
	} $args]
	set script {
	    if {[lindex [self target] 0] eq "::oo::object"} {
		return [next {*}$args]
	    }
	}
	append script [list if [dict get $opts -condition] then] " "
	set inScript \n[dict get $opts -before]\n
	append inScript [list catch {next {*}$args} \
		[dict get $opts -variable] [dict get $opts -trap]] \n
	append inScript [dict get $opts -after]\n
	append inScript {return -options [set } [list [dict get $opts -trap]]\
		{] [set } [list [dict get $opts -variable]] {]}
	append script [list $inScript else {return [next {*}$args]}]
	set name [dict get $opts -name]
	if {$name eq ""} {
	    variable AspectNameGen
	    set name Aspect__[self]__[incr AspectNameGen]
	}
	oo::define [self] method $name args $script
	oo::define [self] filter $name
	return $name
    }
    method attach {args} {
	foreach obj $args {
	    oo::define $obj mixin [self]
	}
    }
}

A demonstration of how to use it. First we'll create a simple caching aspect:

Aspect create cache {
    aspect -before {
	my variable ValueCache
	set key [self target],$args
	if {[info exist ValueCache($key)]} {
	    return $ValueCache($key)
	}
    } -variable result -after {
	set ValueCache($key) $result
    }
    method flushCache {} {
	my variable ValueCache
	unset ValueCache
	# Skip the caching
	return -level 2 ""
    }
}

Then we'll demo it in service:

oo::object create demo
oo::define demo {
    method compute {a b c} {
        after 3000 ;# Simulate deep thought
        return [expr {$a + $b * $c}]
    }
    method compute2 {a b c} {
        after 3000 ;# Simulate deep thought
        return [expr {$a * $b + $c}]
    }
}

cache attach demo

puts [demo compute  1 2 3]      → prints "7" after delay
puts [demo compute2 4 5 6]      → prints "26" after delay
puts [demo compute  1 2 3]      → prints "7" instantly
puts [demo compute2 4 5 6]      → prints "26" instantly
puts [demo compute  4 5 6]      → prints "34" after delay
puts [demo compute  4 5 6]      → prints "34" instantly
puts [demo compute  1 2 3]      → prints "7" instantly
demo flushCache
puts [demo compute  1 2 3]      → prints "7" after delay

[Category OO]