TOE - Examples

Example Index

Hello, world
Common and dynamic objects
Interfaces
Inheritance
Nested class
Access control
Inversion of control
Mixins
Object ownership and transfer
Garbage prevention
Introspection: my
Introspection: self
Introspection: next

Object recycling and alternate constructors
Dynamic revisions:
: classes; objects; common methods; interfaces; mixins
Programmable policies
Additional runtime: Class interface: api; Tabulations: info

Using the common object

toe::class C {
  common public method hello {} {puts "Hello, world!"}
}
# C
toe::C hello
# Hello, world!

Using a dynamic object

toe::class C {
  public method hello {} {puts "Hello, world!"}
}
# C
set obj [toe::new C]
# ::toe::C#1
$obj hello
# Hello, world!

Using a dynamic object and constructor (not recommended)

toe::class C {
  constructor {args} {puts "Hello, world!"}
}
# C
toe::delete [toe::new C]
# Hello, world

For the parsimonious programmer, the obligatory one-liner

toe delete [toe new [toe class C {constructor {args} {puts -nonewline "Hello"} ; destructor {} {puts ", world"}}]]
# Hello, world

Common and dynamic objects collaborating

Mint a class-specific unique integer, using a common public variable

toe::class C {
  common public variable count 0
  
  public method mint {} {
    my common count
    return [incr count]
  }
}
# C
set obj [toe::new C]
# ::toe::C#1
set id [$obj mint]
# 1

Mint a unique integer, using a common public method

toe::class C {
  common private variable count 0
  common public method mint {} {
    return [incr count]
  }
  
  public method mint {} {
    return [my C mint]
  }
}
# C
set obj [toe::new C]
# ::toe::C#1
set id [$obj mint]
# 1

Mint a class-specific unique integer, using a common public method with a precondition

toe::class C {
  common private variable count 0
  common public method mint {} {
    if { [ catch {lassign [self caller] - obj} ] \
      || ("[self class]" ne "[$obj self class]") } {
      return 0
    }
    return [incr count]
  }
  
  public method mint {} {
    my C mint
  }
}
# C
set obj [toe::new C]
# ::toe::C#1
set id [$obj mint]
# 1

Interfaces

Missing implementation error

toe::interface I {
  public method foo {}
  public method bar {}
}
# I
toe::class C implements I {
  public method foo {} {return "in foo"}
}
# C
set obj [toe::new C]
# ::toe::C#1
$obj foo
# in foo
if { [catch {$obj bar} msg] } {list $msg}
# {in class C, method not implemented: I bar}

Interface constant

toe::interface I {const limit 100}
# I

toe::class C implements I {
  public method foo {} {return "limit = [my I(limit)]"}
}
# C
set obj [toe::new C]
# ::toe::C#1
$obj foo
# limit = 100

Inheritance

Simple inheritance

toe::class B {
  public method foo {} {puts "in B::foo"; bar}
  protected method bar {} {puts "in B::bar"}
}
# B
toe::class D inherits B {}
# D
set obj [toe::new D]
# ::toe::D#1
$obj foo
# in B::foo
# in B::bar
$obj bar
# unrecognized object method or subcommand: "D#1 bar"

Local method precedence -- not "virtual"

toe::class B {
  public method foo {} {puts "in B::foo"; bar}
  protected method bar {} {puts "in B::bar"}
}
# B
toe::class D inherits B {
  public method bar {} {puts "in D::bar"}
}
# D
set obj [toe::new D]
# ::toe::D#1
$obj foo
# in B::foo
# in B::bar

Local method precedence and method override

toe::class B {
  public method foo {} {puts "in B::foo"; bar}
  public method bar {} {puts "in B::bar"}
}
# B
toe::class D inherits B {
  public method bar {} {puts "in D::bar"}
}
# D
set obj [toe::new D]
# ::toe::D#1
$obj foo
# in B::foo
# in B::bar
$obj bar
# in D::bar

"virtual" method (override without local precedence)

toe::interface I {protected method bar {}}
# I
toe::class B abstracts I {
  public method foo {} {puts "in B::foo"; bar}
  protected method bar {} {puts "in B::bar"}
}
# B
toe::class D inherits B implements I {
  protected method bar {} {puts "in D::bar"}
}
# D
set obj [toe::new D]
# ::toe::D#1
$obj foo
# in B::foo
# in D::bar

Inheritance with generalization

toe::class Stack {
  protected variable stack {}
public:
  method push {item} {set stack [linsert $stack 0 "$item"];return}
  method pop {} {set stack [lassign $stack item];return $item}
  method size {} {return [llength $stack]}
}
# Stack
toe::class Deque inherits Stack {
public:
  method poke {item} {lappend stack "$item";return}
  method pull {} {K [lindex $stack end] [set stack [lrange $stack 0 end-1]]}
  private method K {x y} {set x}
}
# Deque
set obj [toe::new Deque]
# ::toe::Deque#1
$obj push 1
$obj poke N
$obj size
# 2
$obj pop
# 1
$obj pull
# N
$obj size
# 0

Inheritance with specialization, using abstraction (recommended)

toe::interface IDeque {
  method push item
  method pop
  method poke item
  method pull
}
# IDeque

toe::class AbstractDeque abstracts IDeque {}
# AbstractDeque

toe::class Stack inherits AbstractDeque implements IDeque {
  protected variable stack {}
  public:
    method push {item} {set stack [linsert $stack 0 "$item"];return}
    method pop {} {set stack [lassign $stack item];return $item}
    method size {} {return [llength $stack]}
}
# Stack

toe::class Queue inherits AbstractDeque implements IDeque {
  protected variable stack {}
  public:
    method push {item} {set stack [linsert $stack 0 "$item"];return}
    method pull {} {K [lindex $stack end] [set stack [lrange $stack 0 end-1]]}
    method size {} {return [llength $stack]}
    private method K {x y} {set x}
}
# Queue

set obj1 [toe::new Stack]
# ::toe::Stack#1
$obj1 push 10
$obj1 size
# 1
$obj1 pop
# 10
$obj1 pull
# in class Stack, method not available: IDeque pull

set obj2 [toe::new Queue]
# ::toe::Queue#1
$obj2 push 20
$obj2 size
# 1
$obj2 pull
# 20
$obj2 pop
# in class Queue, method not available: IDeque pop

Nested class

Mint a class-specific unique integer, using a nested class with a common public variable

toe::class C {
  class Mint {
    common:
      public variable count 0
      public method mint {} {incr count}
  }

  public method mint {} {
    return [my Mint mint]
  }
}
# C
set obj [toe::new C]
# ::toe::C#1
$obj mint
# 1

Access control

toe::class C {
  public variable x 1
  protected variable y 2
  private variable z 3

  public method publ {} {puts "I'm public"}
  protected method prot {} {puts "I'm protected"}
  private method priv {} {puts "I'm private"}
}
# C
set obj [toe::new C]
# ::toe::C#1
$obj variable x
# 1
$obj variable y
# variable not found: y
$obj variable z
# variable not found: z
$obj publ
# I'm public
$obj prot
# unrecognized object method or subcommand: "C#1 prot"
$obj priv
# unrecognized object method or subcommand: "C#1 priv"

Inversion of Control

toe::interface ITestDriver {method run {}}
# ITestDriver

toe::interface ITest {
  method setup {args}    ;# prepare to start a test; return the test name
  method test {args}     ;# conduct the test
  method cleanup {args}  ;# clean up after finishing the test
}
# ITest

toe::class Tester implements ITestDriver abstracts ITest {
  method run {} {
    set name "[setup]"
    set pass [expr {[test] != 0 ? {PASS}:{FAIL}}]
    cleanup
    return "$pass $name"
  }
}
# Tester

toe::class MyTest inherits Tester implements ITest {
  private variable x
  method setup {args} {
    set x [expr {rand()}]
    return [self class]
  }
  method test {args} {
    return [expr {($x>=0.0) && ($x<=1.0)}]
  }
  method cleanup {args} {}
}
# MyTest

set testcase [toe::new MyTest]
# ::toe::MyTest#1
$testcase run
# PASS MyTest

Mixins

Add a method and a filter

toe::mixin M {
  method foo {} {puts "in [self class] [self method]"}

  filter doit {
    puts "entering [self class] [self method] with n=$n"
  } {
    puts "leaving [self class] [self method] with n=$n"
  }
}
# M

toe::class C mixes M {
  private variable n 8
  public method doit {} {
    incr n
    puts "doing stuff here"
  }
}
# C

set obj [toe::new C]
# ::toe::C#1
$obj doit
# entering C doit with n=8
# doing stuff here
# leaving C doit with n=9
$obj foo
# in C foo

Filter all methods

toe::mixin M {
  filter * {
    puts "entering [self class] [self method]"
  } {
    puts "leaving [self class] [self method]"
  }
}
# M
toe::class C mixes M {
  public method foo {} {
    puts "bar"
  }
}
# C

set obj [toe::new C]
# entering C constructor
# leaving C constructor
# ::toe::C#1

$obj foo
# entering C foo
# bar
# leaving C foo

toe::delete $obj
# entering C destructor
# leaving C destructor

Filter non-public methods

toe::mixin M {
  filter prot {
    puts "$n entering protected: [self class] [self method]"
  } {
    puts "$n leaving protected: [self class] [self method]\n"
  }
  filter priv {
    puts "$n entering private: [self class] [self method]"
  } {
    puts "$n leaving private: [self class] [self method]\n"
  }
}
# M
toe::class C mixes M {
  private variable n 5
  public method doit {} {
    prot
    priv
  }
  protected method prot {} {
    incr n
    puts "doing protected stuff"
  }
  protected method priv {} {
    incr n
    puts "doing private stuff"
  }
}
# C

set obj [toe::new C]
# ::toe::C#1
$obj doit
# 5 entering protected: C prot
# doing protected stuff
# 6 leaving protected: C prot

# 6 entering private: C priv
# doing private stuff
# 7 leaving private: C priv

Add non-public methods

toe::mixin M {
  protected method prot {} { puts "in protected method" }
  private method priv {}   { puts "in private method" }
}
# M
toe::class C mixes M {
  public method doit {} {
    prot
    priv
  }
}
# C

set obj [toe::new C]
# ::toe::C#1
$obj doit

catch {$obj prot} msg; set msg
# unrecognized object method or subcommand: "toe::C#1 prot"
catch {$obj priv} msg; set msg
# unrecognized object method or subcommand: "toe::C#1 priv"

Object ownership and transfer

toe::class Property {
  method owner {} {self owner}
}
# Property

toe::class Owner {
  private variable obj

  constructor {args} {set obj [toe::new Property]}

  method whatIown {} {return $obj}

  method adopt {adoptee other} {
    set obj [toe adopt $adoptee $other]
    return
  }
}
# Owner

set a [toe::new Owner]
# ::toe::Owner#1
set b [toe::new Owner]
# ::toe::Owner#2
set obj [$a whatIown]
# ::toe::Property#1
puts "current owner: [$obj owner]"
# current owner: ::toe::Owner#1
$b adopt $obj $a
puts "current owner: [$obj owner]"
# current owner: ::toe::Owner#2
$b self owns
# ::toe::Property#1 ::toe::Property#2

Garbage prevention

toe::class Property {
  constructor {args} {puts "  [self object] is created"}
  destructor {}      {puts "  [self object] is deleted"}
  method owner {} {return [self owner]}
}
# Property

toe::class Owner {
  private variable obj

  constructor {args} {puts "  [self object] is created" ; set obj [toe::new Property]}
  destructor {}      {puts "  [self object] is deleted"}
  method foo {} {
    puts "  enter Owner::foo"
    set temp [toe::new -local Property]
    puts "  leave Owner::foo"
  }
}
# Owner

set obj [toe::new Owner]
#   ::toe::Owner#1 is created
#   ::toe::Property#1 is created
# ::toe::Owner#1
$obj foo
#   enter Owner::foo
#   ::toe::Property#2 is created
#   leave Owner::foo
#   ::toe::Property#2 is deleted
toe::delete $obj
#   ::toe::Property#1 is deleted
#   ::toe::Owner#1 is deleted

Introspection: my

toe::interface I {const quota 100}
# I

toe::class C implements I {
  private:
    common variable count 0
    variable n
  
  constructor {args} {
    my common count
    set n [incr count]
  }

  public:
    method demo {} {
      foreach name {demo_common demo_method demo_nested} {
        puts "$name : [$name]"
      }
    }

    method demo_common {} {return [my C getCount]}
    method demo_method {} {my demo_const}
    method demo_nested {} {return [my N foo]}

    common method getCount {} {return $count}

    method demo_const {} {
      my common count
      set residual [expr {[my I(quota)]-$count}]
      set s "I am instance: $n"
      append s "; you can instantiate $residual more."
      return $s
    }
  
    class N {
      common method foo {} {return "in nested common method foo"}
    }  
}
# C

set obj1 [toe::new C]
# ::toe::C#1
$obj1 demo
# demo_common : 1
# demo_method : I am instance: 1; you can instantiate 99 more.
# demo_nested : in nested common method foo
set obj2 [toe::new C]
# ::toe::C#2
$obj2 demo
# demo_common : 2
# demo_method : I am instance: 2; you can instantiate 98 more.
# demo_nested : in nested common method foo

Introspection: self

toe::interface I {}
# I
toe::mixin M {}
# M
toe::class R {}
# R
toe::class B inherits R {}
# B

toe::class C inherits B implements I mixes M {
  method demo {} {
    foreach key {class method namespace object common super owner methods interfaces mixins} {
      puts "$key\t\t[self $key]"
    }
    set root [self super]
    while {"[set super [$root self super]]" ne ""} { set root $super }
    puts "root\t\t$root"
  }
}
# C

toe::class O {
  common variable obj
  common method demo {} {
    set obj [toe::new C]
    $obj demo
    toe::delete $obj
  }
}
# O

toe::O demo
# class        C
# method       demo
# namespace    ::toe::C::1
# object       ::C#1
# common       ::toe::C
# super        ::B#1
# owner        ::toe::O
# methods      constructor demo destructor
# interfaces   I
# mixins       M
# root         ::R#1

Introspection: next

toe::class B {
  protected method foo {} {puts "in B::foo"; bar}
  protected method bar {} {puts "in B::bar"}
}
# B

toe::class D inherits B {
  public method foo {} {puts "in D::foo"; bar; next}
  protected method bar {} {puts "in D::bar"}
}
# D

set obj [toe::new D]
# ::toe::D#1
$obj foo
# in D::foo
# in D::bar
# in B::foo
# in B::bar

Object recycling and alternate constructors, using a mixin

reset preserves initial values for variables

toe::mixin MReconstructable {
  public:
  method -novars reset {args} {toe reset [self object] {*}$args}
  method -novars copy {args} {toe copy [self object] 0 {*}$args}
  method -novars copyAdopting {args} {toe copy [self object] 1 {*}$args}
  method -novars clone {args} {toe clone [self object] {*}$args}
}

set start [clock milliseconds];list

toe::class C mixes MReconstructable {
  public variable X [clock milliseconds]
  public variable Y

  constructor {args} {}
  public method getX {} {return $X}
}
# C

set obj [toe::new C]
# ::toe::C#1
expr {[$obj getX]-$start}
# <some low integer>
after 10
$obj reset
expr {[$obj getX]-$start}
# <the same low integer>

reset invokes constructors

set start [clock milliseconds];list

toe::class C mixes MReconstructable {
  public variable X
  public variable Y
  constructor {args} {set X [clock milliseconds]}
  public method getX {} {return $X}
}
# C

set obj [toe::new C]
# ::toe::C#1
expr {[$obj getX]-$start}
# <some low integer>
after 10
$obj reset
expr {[$obj getX]-$start}
# <a different integer, greater by at least 10>

"reset" is faster than a cycle of delete and new

toe::class C mixes MReconstructable {
  public variable X
  public variable Y
  constructor {args} {set X [clock milliseconds]}
  public method getX {} {return $X}
}
# C

set obj [toe::new C]
# ::toe::C#1
$obj reset
lassign [time {$obj reset} 1000] resetTime ; set resetTime
# 51.166
toe::delete $obj
lassign [time {toe::delete [toe::new C]} 1000] newdeleteTime ; set newdeleteTime
# 231.757
format {"reset" can be %4.1f times faster than a delete/new cycle} [expr {$newdeleteTime/$resetTime}]
# "reset" can be  5.7 times faster than a delete/new cycle

"copy" replicates an instance, but leaves any ownership as is

toe::mixin MReconstructable {
  public:
  method -novars reset {args} {toe reset [self object] {*}$args}
  method -novars copy {args} {toe copy [self object] 0 {*}$args}
  method -novars copyadopting {args} {toe copy [self object] 1 {*}$args}
  method -novars clone {args} {toe clone [self object] {*}$args}
}

toe::class A {}
# A
toe::class C mixes MReconstructable {}
# C

set a [toe::new A]
# ::toe::A#1
set c1 [toe::new C]
# ::toe::C#1
toe adopt $a {} $c1
# ::toe::A#1
$c1 self owns
# ::toe::A#1
set c2 [$c1 copy]
$c1 self owns
# ::toe::A#1
$c2 self owns

"copyadopting" replicates an instance and transfers any ownership to the new instance

toe::class A {}
# A
toe::class C mixes MReconstructable {}
# C

set a [toe::new A]
# ::toe::A#1
set c1 [toe::new C]
# ::toe::C#1
toe adopt $a {} $c1
# ::toe::A#1
$c1 self owns
# ::toe::A#1
set c2 [$c1 copyadopting]
$c1 self owns
$c2 self owns
# ::toe::A#1

"clone (deep copy)" copies all owned objects, recursively, maintaining ownership relationships in the cloned object

toe::class A {}
# A
toe::class C mixes MReconstructable {}
# C

set a [toe::new A]
# ::toe::A#1
set c1 [toe::new C]
# ::toe::C#1
toe adopt $a {} $c1
# ::toe::A#1
$c1 self owns
# ::toe::A#1
set c2 [$c1 clone]
$c1 self owns
# ::toe::A#1
$c2 self owns
# ::toe::A#2

Dynamic revisions: classes

revise class method

toe::class C {method foo {} {puts " in foo"}}

set obj1 [toe::new C]
# ::toe::C#1

toe revise class C method foo {} {puts " in REVISED foo"}

set obj2 [toe::new C]
# ::toe::C#2
$obj1 foo
#  in foo
$obj2 foo
#  in REVISED foo

revise inherited class

toe::class A {method foo {} {puts "foo in class A"}}
toe::class B {method foo {} {puts "foo in class B"}}
toe::class C inherits A {method foo {} {next}}

set obj1 [toe new C]
# ::toe::C#1
$obj1 foo
# foo in class A

toe revise class C inherits B
set obj2 [toe new C]
# ::toe::C#2
$obj2 self super
$obj2 foo
# foo in class B

revise implements interface

toe::interface I {const x X}
toe::interface J {const y Y}
toe::class C implements I {
  method foo {} {
    set err1 [catch {my I(x)} msg1] ; puts "I(x) $err1  $msg1"
    set err2 [catch {my J(y)} msg2] ; puts "J(y) $err2  $msg2"
  }
}

set obj1 [toe new C]
# ::toe::C#1
$obj1 foo
# I(x) 0  X
# J(y) 1  unrecognized object method or subcommand: "J(y)"

toe revise class C implements J
set obj2 [toe new C]
# ::toe::C#2
$obj2 foo
# I(x) 1  unrecognized object method or subcommand: "I(x)"
# J(y) 0  Y

revise mixes mixin

toe::mixin P {method foo {} {puts "from mixin P"}}
toe::mixin Q {method foo {} {puts "from mixin Q"}}
toe::class C mixes P {}

set obj1 [toe new C]
# ::toe::C#1
$obj1 foo
# from mixin P

toe revise class C mixes Q

set obj2 [toe new C]
# ::toe::C#2
$obj2 foo
# from mixin Q

revise abstracts interface

Dynamic revisions: object methods

toe class C {method foo {} {puts " in foo"}}

set obj [toe new C]
# ::C#1
$obj foo
#  in foo

toe revise object $obj method foo {} {puts " in REVISED foo"}

$obj foo
#  in REVISED foo

Dynamic revisions: class common methods

toe class C {common method foo {} {puts " in common foo"}}
toe::C foo
#  in common foo

toe revise class C common method foo {} {puts " in REVISED common foo"}

toe::C foo
#  in REVISED common foo

Dynamic revisions: interfaces

toe::interface I {const x 123}
toe::class C implements I {method foo {} {puts "x = [my I(x)]"}}

set obj1 [toe new C]
# ::toe::C#1

toe revise interface I constant x 456
toe class D implements I {method foo {} {puts "x = [my I(x)]"}}
set obj2 [toe::new D]
# ::toe::D#1
$obj1 foo
# x = 123
$obj2 foo
# x = 456

Dynamic revisions: mixins

revised mixin method

toe::mixin P {common method bar {} {puts " from mixin P"}}
toe::class C mixes P {common method foo {} {puts "in C foo"}}

toe revise mixin P common method bar {} {puts " from REVISED mixin P"}

toe::class D mixes P {common method foo {} {puts "in D foo"}}

toe::C foo
# in C foo
toe::D foo
# in D foo
toe::C bar
#  from mixin P
toe::D bar
#  from REVISED mixin P

revised mixin filter

toe::mixin P {common filter foo {puts " prepend from mixin P"} {puts " append from mixin P"}}
toe::class C mixes P {common method foo {} {puts "in C foo"}}

toe revise mixin P common filter foo {puts " prepend from REVISED mixin P"} {puts " append from REVISED mixin P"}

toe::class D mixes P {common method foo {} {puts "in D foo"}}

toe::C foo
#  prepend from mixin P
# in C foo
#  append from mixin P
toe::D foo
#  prepend from REVISED mixin P
# in D foo
#  append from REVISED mixin P

Programmable policies

array set policy [toe policy]
parray policy
# policy(debug)            = 0
# policy(novars)           = 0
# policy(preventGarbage)   = 1
# policy(replaceClass)     = 1
# policy(replaceInterface) = 1
# policy(replaceMixin)     = 1
# policy(revise)           = 1
# policy(scoped)           = 1
# policy(seize)            = 0
# policy(strict)           = 0

toe policy novars
# 0
toe policy strict 1 revise 0
# strict 1 revise 0

api - a formatted listing of the programmer's interface for a class

toe::class B {
  protected method foo {x} {puts "[self object] [self method]"}
  public method bar {y} {puts "[self object] [self method]"}
}
# B

toe::mixin M {
 public method log {} {}
}
# M

toe::class D inherits B mixes M {
  common method add {x} {}
  public method init {} {}
  protected method bas {z} {}
  private method basImpl {} {}
}
# D

toe api B
# class B
#          public method bar y
#          protected method foo x

toe api D
# class D
#   inherits B
#   common public method add x
#          public method bar y	(in: class B)
#          protected method bas z
#          protected method foo x	(in: class B)
#          public method init {}
#          public method log {}

info

toe info classes ?pattern?

toe::class AA {} ; toe::class AB {} ; toe::class CCC {} ; toe::class AD {}
# AD
toe info classes A*
# AA AB AD

toe info interfaces ?pattern?

toe::interface IA {} ; toe::interface IB {} ; toe::interface JJJ {} ; toe::interface ID {}
# ID
toe info interfaces I*
# IA IB ID

toe info mixins ?pattern?

(a reader's exercise....)

toe info ancestors ?pattern? (classes)

toe::class A {} ; toe::class B inherits A {} ; toe::class C inherits B {} ; toe::class Z inherits C {}
# Z
toe info ancestors Z
# Z C B A

toe info ancestors ?pattern? (objects)

toe::class A {} ; toe::class B inherits A {} ; toe::class C inherits B {} ; toe::class Z inherits C {}
# Z
set obj [toe::new Z]
# ::Z#1
toe info ancestors $obj
# ::toe::Z#1 {::toe::C#1 ::toe::B#1 ::toe::A#1}

toe info objects ?pattern?

toe class A {} ; toe class B {}
# B
foreach x {- - -} {
  lappend alist [toe new A]
  lappend blist [toe new B]
}
toe info objects
# A {::toe::A#1 ::toe::A#2 ::toe::A#3} B {::toe::B#1 ::toe::B#2 ::toe::B#3}

toe info inherited ?pattern?

toe::class A {} ; toe::class B {}
# B
toe::class C1 inherits A {} ; toe::class C2 inherits B {} ; toe::class C3 inherits B {}
# C3
toe info inherited
# A C1 B {C2 C3}

toe info implemented ?pattern?

toe::interface I {} ; toe::interface J {}
# J
toe::class C1 implements I {} ; toe::class C2 implements I {} ; toe::class C3 implements {I J} {}
# C3
toe info implemented
# I {C1 C2 C3} J C3

toe info abstracted ?pattern?

(a reader's exercise....)

toe info mixed ?pattern?

(a reader's exercise....)