Updated 2016-07-10 11:47:24 by dkf

This is the implementation of the method invocation benchmark of Tcl OO Bench in various Tcl OO extensions.

ITcl edit

 package require Itcl

 itcl::class Toggle {
   variable state
   constructor {start_state} {
     set state $start_state
   }
   method value {} {
     return $state
   }
   method activate {} {
     set state [expr {!$state}]
     return $this
   }
 }
 
 itcl::class NthToggle {
   inherit Toggle
   variable count_max
   variable counter
   constructor {start_state max_counter} {
     Toggle::constructor $start_state
   } {
     set count_max $max_counter
     set counter 0
   }
   method activate {} {
     if {[incr counter] >= $count_max} {
       Toggle::activate
       set counter 0
     }
     return $this
   }
 }
 
 proc main {} {
   set n [lindex $::argv 0]
   set val 1
   set toggle [Toggle #auto $val]
   for {set i 0} {$i < $n} {incr i} {
     set val [[$toggle activate] value]
   }
   if {$val} {puts "true"} else {puts "false"}
 
   set val 1
   set ntoggle [NthToggle #auto 1 3]
   for {set i 0} {$i < $n} {incr i} {
     set val [[$ntoggle activate] value]
   }
   if {$val}  {puts "true"} else {puts "false"}
 }

 main

MIT OTcl edit

 Class Toggle 
 Toggle instproc state {v} {
   $self set state $v
 }
 Toggle instproc value {} {
   $self set state
 }
 Toggle instproc activate {} {
   $self state [expr {! [$self set state]}]
   set self
 } 

 
 Class NthToggle -superclass Toggle
 NthToggle instproc max {v} {
   $self set max $v
 }
 NthToggle instproc init args {
   eval $self next $args
   $self set counter 0
 }
 NthToggle instproc activate {} {
   $self instvar counter
   if {[incr counter] >= [$self set max]} {
     $self next
     set counter 0
   }
   set self
 }

 proc main {} {
   set n [lindex $::argv 0]
   set val 1
   set toggle [Toggle n -state $val]

   for {set i 0} {$i < $n} {incr i} {        
     set val [[$toggle activate] value]
   }
   if {$val} {puts "true"} else {puts "false"}

   set val 1
   set ntoggle [NthToggle nn -state 1 -max 3]
   for {set i 0} {$i < $n} {incr i} {
     set val [[$ntoggle activate] value]
   }
   if {$val} {puts "true"} else {puts "false"}
 }

 main

XOTcl edit

 package require XOTcl; namespace import -force xotcl::*

 Class Toggle -parameter state
 Toggle instproc value {} {
   my state
 }
 Toggle instproc activate {} {
   my state [expr {! [my state]}]
   self
 }

 Class NthToggle -superclass Toggle -parameter max
 NthToggle instproc init {} {
   next
   my set counter 0
 }
 NthToggle instproc activate {} {
   if {[my incr counter] >= [my max]} {
     next
     my set counter 0
   }
   self
 }

 proc main {} {
   set n [lindex $::argv 0]
   set val 1
   set toggle [Toggle new -state $val]

   for {set i 0} {$i < $n} {incr i} {        
     set val [[$toggle activate] value]
   }
   if {$val} {puts "true"} else {puts "false"}

   set val 1
   set ntoggle [NthToggle new -state 1 -max 3]
   for {set i 0} {$i < $n} {incr i} {
     set val [[$ntoggle activate] value]
   }
   if {$val} {puts "true"} else {puts "false"}
 }

 main

Category XOTcl Code

stooop edit

 package require stooop
 namespace import stooop::*

 class Toggle {
     proc Toggle {this start_state} {
         set ($this,state) $start_state
     }
     proc ~Toggle {this} {}
     virtual proc value {this} {
         return $($this,state)
     }
     proc activate {this} {
         set ($this,state) [expr {!$($this,state)}]
         return $this
     }
 }
 class NthToggle {
     proc NthToggle {this start_state max_counter} Toggle {$start_state} {
         set ($this,count_max) $max_counter
         set ($this,counter) 0
     }
     proc ~NthToggle {this} {}
     proc activate {this} {
         if {[incr ($this,counter)]>=$($this,count_max)} {
             set Toggle::($this,state) [expr {!$Toggle::($this,state)}]
             set ($this,counter) 0
         }
         return $this
     }
 }

 proc main {n} {
   set val 1
   set toggle [new Toggle $val]
   for {set i 0} {$i<$n} {incr i} {
     set val [Toggle::value [Toggle::activate $toggle]]
   }
   if {$val} {puts true} else {puts false}
   delete $toggle
   set val 1
   set ntoggle [new NthToggle $val 3]
   for {set i 0} {$i<$n} {incr i} {
     set val [Toggle::value [NthToggle::activate $ntoggle]]
   }
   if {$val} {puts true} else {puts false}
   delete $ntoggle
 }
 main [expr {$argc==1?[lindex $argv 0]:1}]