Web site. This is an extension which allows you to create a handle to an incr Tcl object. The handle represents a reference counted object and when the last reference is released the incr Tcl object is destroyed.In the following example, the command::counted::command $account [list delete object $account]returns a handle to a command object which delegates its operations to the incr Tcl object specified by $account. The second argument to the ::counted::command command specifies the script to execute when the last reference to the object is released. In this case, it deletes the $account incr Tcl object.I added the ::counted::type command so I can show the object survives when the handle's internal representation shimmers to a string. ::counted::type returns the name of the internal representation type of its argument.
package require counted
package require Itcl
namespace import itcl::*
class Account {
public variable balance 0
destructor {
puts Account::destructor
}
public method deposit amount {
set balance [expr $balance + $amount]
}
public method withdraw amount {
set balance [expr {$balance - $amount}]
}
}
proc createAccount {} {
set account [Account #auto]
# Create a reference counted object that delegates operations to an Itcl
# object. When the last reference is released, destroy the Itcl object.
return [::counted::command $account [list delete object $account]]
}
set account1 [createAccount]
# The internal representation type is "cmdName".
puts "Internal representation type is [::counted::type $account1]"
puts "balance is [$account1 cget -balance]"
$account1 deposit 30
puts "balance is [$account1 cget -balance]"
# This command changes the internal representation type to "string".
puts "$account1 length is [string length $account1]"
puts "Internal representation type is [::counted::type $account1]"
# This command restores the internal representation type to "cmdName".
$account1 withdraw 20
puts "Internal representation type is [::counted::type $account1]"
puts "balance is [$account1 cget -balance]"
# Add another reference.
set account2 $account1
puts "balance is [$account2 cget -balance]"
# Release original reference.
unset account1
puts "balance is [$account2 cget -balance]"
# Release the last reference.
unset account2Here's another example that implements Lambda in Tcl. Like Feather LambdaObj, the command object is automatically destroyed when the last reference is released.
package require counted
namespace eval lambda {variable unique 0}
proc lambda {arguments body} {
set procName ::lambda::cmd[incr ::lambda::unique]
proc $procName $arguments $body
return [::counted::command $procName [list rename $procName {}]]
}
proc test {} {
set add [lambda {a b} {puts "$a + $b = [expr {$a + $b}]"}]
puts [info procs ::lambda::*]
$add 1 2
}
test
puts [info procs ::lambda::*]The output of this script is::lambda::cmd1 1 + 2 = 3
Similarly for Custom curry and Feather CurryObj:
package require counted
namespace eval curry {variable unique 0}
proc curry {cmd args} {
set newCmd ::curry::cmd[incr ::curry::unique]
eval [list interp alias {} $newCmd {} $cmd] $args
return [::counted::command $newCmd [list interp alias {} $newCmd {}]]
}
proc add {a b} {
puts "$a + $b = [expr {$a + $b}]"
}
proc test {} {
set add2 [curry add 2]
puts [info commands ::curry::*]
$add2 6
}
test
puts [info commands ::curry::*]The output of this script is::curry::cmd1 2 + 6 = 8
Arjen Markus: You will find yet another approach in Garbage collection
