HolgerJ 2015-06-25 - I was wondering whether objects can go out of scope and get deleted like they do in C++ (whenever the block ends) or in Java (when the reference count allows the garbage collection to remove it). At #EuroTcl2015 in Cologne we discussed possibilities, although objects in TclOO are commands and therefore are not tied to the block (or proc) where they have been created. I wrote about it on the page object with scope
Richard Suchenwirth 2007-10-20 - Now that I have TclOO both at work and home, and another weekend comes up, it's obvious that I wanted to play with it, just for finger practice. Barking dogs have been demonstrated elsewhere, but I decided to start with another classic example, a bank account.
#!/usr/bin/env tclsh85
package require TclOO
namespace import oo::*
catch {Account destroy} ;# in case of repeated sourcing
class create Account {
constructor {{ownerName undisclosed}} {
my variable total overdrawLimit owner
set total 0
set overdrawLimit 10
set owner $ownerName
}
method deposit amount {
my variable total
set total [expr {$total + $amount}]
}
method withdraw amount {
my variable {*}[info object vars [self]] ;# "auto-import" all variables
if {($amount - $total) > $overdrawLimit} {
error "Can't overdraw - total: $total, limit: $overdrawLimit"
}
set total [expr {$total - $amount}]
}
method transfer {amount targetAccount} {
my variable total
my withdraw $amount
$targetAccount deposit $amount
set total
}
destructor {
my variable total
if {$total} {puts "remaining $total will be given to charity"}
}
}Due to the simple hierarchy of TclOO (every class is an instance of oo::class, which is an subclass of oo::object - while at the same time oo::object is an instance of oo::class), it is not very hard to add development helper methods that each object inherits. For instance, this dumps an object's class and instance variables into a dict-able list:
define oo::object method dump {{pat *}} {
set res [list class [info object class [self]]]
foreach i [info object vars [self] $pat] {
my variable $i
lappend res $i [set $i]
}
set res
}see also Serializing TclOO objects
#-- "Test suite"
foreach cmd [split {
set a [Account new "John Doe"]
$a deposit 200
$a deposit 20
$a withdraw 150
$a withdraw 100
$a dump
set b [Account new]
$a transfer 65 $b
$a dump
$b dump
$a transfer 1000000 $b
$b destroy
} \n] {
catch $cmd res
puts "$cmd -> $res"
}which prints
set a [Account new "John Doe"] -> ::oo::Obj36
$a deposit 200 -> 200
$a deposit 20 -> 220
$a withdraw 150 -> 70
$a withdraw 100 -> Can't overdraw - total: 70, limit: 10
$a dump -> class ::Account total 70 overdrawLimit 10 owner {John Doe}
set b [Account new] -> ::oo::Obj37
$a transfer 65 $b -> 5
$a dump -> class ::Account total 5 overdrawLimit 10 owner {John Doe}
$b dump -> class ::Account total 65 overdrawLimit 10 owner undisclosed
$a transfer 1000000 $b -> Can't overdraw - total: 5, limit: 10
remaining 65 will be given to charity
$b destroy ->Interactive testing is, as usual with Tcl, a good way to learn. In the following case, it shows that variables are not exactly protected from hack attacks:
% set $a\::total 1000000
1000000
% $a dump
class ::Account total 1000000 overdrawLimit 10 owner {John Doe}So better not deploy a real banking software based on this code :^) On the lighter side, introspection works as we all know and love, for easy "online help":
% class help unknown method "help": must be create, destroy or dump % Account help unknown method "help": must be create, destroy, dump or new % $a help unknown method "help": must be deposit, destroy, dump, transfer or withdraw
Another issue: member variables must be explicitly imported into methods (similar to namespace rules). If you prefer the C++ style (all member variables implicitly known), one hackish solution was demonstrated in the withdraw method above, and here's some sugar-coating if you want it more often:
proc all_my_variables {} {
uplevel 1 {my variable {*}[info object vars [self]]}
}so the method can then look like
method withdraw amount {
all_my_variables
if {($amount - $total) > $overdrawLimit} {
error "Can't overdraw - total: $total, limit: $overdrawLimit"
}
set total [expr {$total - $amount}]
}To distinguish members and others, one might then use the C++ convention that member names end in "_".
To summarize my first impressions, TclOO can be used well as an OO system in itself. I haven't even used all features as documented in TIP #257. So when I'll need some OO in the future, I can probably just use this, and do without incr Tcl or XOTcl ... :^)
The most part of the above example was also included in http://en.wikibooks.org/wiki/Tcl_Programming/Introduction#TclOO - everyone is welcome to make it better!
DKF: Well, you can go one better:
oo::class create class {
superclass oo::class
constructor {args} {
my variable vars
set vars {}
next {*}$args
}
method global {variable {initValue {}}} {
my variable vars
lappend vars $variable $initValue
}
method constructor {args body} {
my variable vars
set body0 {}
foreach {var val} $vars {append body0 [list variable $var $val] \;}
oo::define [self] constructor $args $body0$body
}
method method {name args body} {
my variable vars
set body0 {}
foreach {var val} $vars {append body0 [list variable $var] \;}
oo::define [self] method $name $args $body0$body
}
method destructor body {
my variable vars
set body0 {}
foreach {var val} $vars {append body0 [list variable $var] \;}
oo::define [self] destructor $body0$body
}
}
class create Account
Account global total 0
Account global overdrawLimit 10
Account global owner
Account constructor {{ownerName undisclosed}} {
set owner $ownerName
}
Account method deposit amount {
set total [expr {$total + $amount}]
}
Account method withdraw amount {
if {($amount - $total) > $overdrawLimit} {
error "Can't overdraw - total: $total, limit: $overdrawLimit"
}
set total [expr {$total - $amount}]
}
Account method transfer {amount targetAccount} {
my withdraw $amount
$targetAccount deposit $amount
return $total
}
Account destructor {
if {$total} {puts "remaining $total will be given to charity"}
}DKF: And then there's another step beyond...
oo::class create globalizedClass {
superclass oo::class
constructor {args} {
my variable vars
set vars {}
foreach m {global constructor method destructor} {
interp alias {} [self namespace]::$m {} [self] $m
}
my eval {*}$args
}
method global {variable {initValue {}}} {
my variable vars
lappend vars $variable $initValue
}
method constructor {args body} {
my variable vars
set body0 variable
foreach {var val} $vars {lappend body0 $var $val}
oo::define [self] constructor $args $body0\;$body
}
method method {name args body} {
my variable vars
set body0 {my variable}
foreach {var val} $vars {lappend body0 $var}
oo::define [self] method $name $args $body0\;$body
}
method destructor body {
my variable vars
set body0 {my variable}
foreach {var val} $vars {lappend body0 $var}
oo::define [self] destructor $body0\;$body
}
}
globalizedClass create Account {
global total 0
global overdrawLimit 10
global owner
constructor {{ownerName undisclosed}} {
set owner $ownerName
}
method deposit amount {
set total [expr {$total + $amount}]
}
method withdraw amount {
if {($amount - $total) > $overdrawLimit} {
error "Can't overdraw - total: $total, limit: $overdrawLimit"
}
set total [expr {$total - $amount}]
}
method transfer {amount targetAccount} {
my withdraw $amount
$targetAccount deposit $amount
return $total
}
destructor {
if {$total} {puts "remaining $total will be given to charity"}
}
}It's because it can support this sort of thing that I like to think of TclOO as being a kit for building OO systems.
SL: Another interesting customizing on the meta-class oo::class inspired by Putting Metaclasses to Work [Ira R. Forman, Scott H. Danforth]:
Each newly created oo::object should contain a timestamp, holding the creation-time of each instance.
One implementation is called instance method:
oo::class create ctimestamped {
method create {args} {
next {*}$args
oo::define [lindex $args 0] constructor {args} {
my variable timestamp
set timestamp [clock seconds]
next {*}$args
}
oo::define [lindex $args 0] method getCreationTime {} {
my variable timestamp
return $timestamp
}
}
}
oo::define oo::class mixin ctimestamped
...
set a [Account new]
$a getCreationTimeThe timestamp is located in the class instance as well as the retrieving function.
Another implementation is called class method:
oo::class create ctimestamped {
method create {args} {
next {*}$args
oo::define [lindex $args 0] constructor {args} {
my variable timestamp
set timestamp [clock seconds]
next {*}$args
}
}
method getCreationTime object {
set ${object}::timestamp
}
}
oo::define oo::class mixin ctimestamped
...
set a [Account new]
Account getCreationTime $aThe timestamp is located in the class instance, but the retrieving function is located in the meta-class oo::class.
[tb] 2008-09-24 - How about cascading message posts?
set aLine [[[MyString appendString AnotherString] append "\n"] printString]
isn't quite comfortable, isn't it?
DKF: I can't say that I'm too keen on that sort of usage either, but then again I'd just point out that that's using a perfectly Tcl-ish system in a non-Tcl-ish way. As such, "not a real problem". (I'd instead have the append method take a variable number of arguments and return the resulting string. Which *is* Tcl-ish…)
tb: Ahh... - yes, I see. It'd be nice to have, but it wouldn't be Tcl-ish enough to integrate well. TclTk isn't Smalltalk :)
Lars H: While I don't see much point in this construction either, I'd like to remark that the TIP#314 [L1 ] mechanism supports it. After
namespace eval String {
# The namespace ensemble is a "class". Its "objects" are command prefixes
# starting with the command My, which is the dispatch ensemble.
namespace export {[a-z]*}
namespace ensemble create -parameters str\
-command [namespace current]::My
# Object constructor:
proc Create {str} {
list [namespace which My] $str
}
# Public methods:
proc serialize {str} {return $str}
proc append {str str2} {
Create "$str$str2"
}
proc appendString {str strObj} {
Create "$str[{*}$strObj serialize]"
}
# Public alias for object constructor:
interp alias {} [namespace current] {} [namespace current]::Create
}you can do
set MyString [String "foo "]
set AnotherString [String "bar."]
set aLine [{*}[{*}[{*}$MyString appendString $AnotherString] append "\n"] serialize]which I think is effectively what was asked for (though I might be mistaken about printString being a serialize operation).
GPS: That looks bizarre with all the {*} syntax. I can do it this way:
proc String s {
set obj [objstructure]
$obj ::add-keys string $s
$obj ::add-method append [list String-append $obj]
$obj ::add-method printString [list String-printString $obj]
return $obj
}
proc String-append {obj append} {
set s [$obj string]
append s $append
$obj string $s
return $obj
}
proc String-printString {obj chan} {
puts $chan [$obj string]
return $obj
}
set aLineString [[[String "Hello World"] append "! Give me a cookie!"] printString stdout]
#prints to stdout: "Hello World! Give me a cookie!"
#if you want to cleanup do: rename $aLineString {} or add a destroy method that does that.
#Reference counting could be done too, with release and retain messages.tb - :) - My question was more about a more convenient syntax for cascading message posts. If you have a series of messages to be sent to the same object, then why always construct a full message post? Given, that every method that doesn't return a certain value, instead returns self, one could wright:
SomeObject doSomething appendTo [AnotherObject copesWith anArgument] print
RS Umm.. usual OO models as I know them treat one method call as a unit. Your proposed calling style is certainly doable, but would involve some parsing of the arguments to decide which are method names, and which are arguments to methods. I'm not sure whether it's worth that when you can just code (as usual):
$obj doSomething $obj appendTo [$obj2 copeswith $arg] $obj print
which looks still better readable to me... :^)
DKF: Here's an example (created to solve the Rosetta Code problem on active objects[L2 ]) that shows an integrator class (using the trapezium method). Note the use of clock microseconds as part of the integration step and coroutine/yield to make the outer controller.
package require Tcl 8.6
oo::class create integrator {
variable e sum delay tBase t0 k0 aid
constructor {{interval 1}} {
set delay $interval
set tBase [clock microseconds]
set t0 0
set e { 0.0 }
set k0 0.0
set sum 0.0
set aid [after $delay [namespace code {my Step}]]
}
destructor {
after cancel $aid
}
method input expression {
set e $expression
}
method output {} {
return $sum
}
method Eval t {
expr $e
}
method Step {} {
set aid [after $delay [namespace code {my Step}]]
set t [expr {([clock microseconds] - $tBase) / 1e6}]
set k1 [my Eval $t]
set sum [expr {$sum + ($k1 + $k0) * ($t - $t0) / 2.}]
set t0 $t
set k0 $k1
}
}
set pi 3.14159265
proc pause {time} {yield [after [expr {int($time * 1000)}] [info coroutine]]}
proc task {script} {coroutine task_ apply [list {} "$script;set ::done ok"];vwait done}
task {
integrator create i
i input {sin(2*$::pi * 0.5 * $t)}
pause 2
i input { 0.0 }
pause 0.5
puts [format %.15f [i output]]
}It should be possible to write a cleverer task system so that users just write a bunch of (apparently) linear tasks and then start the task manager. Not quite sure what the best way to write that down is yet.