[Poet-commit] SF.net SVN: poet: [35] trunk

[<mer...@us...>]

Revision: 35
          http://poet.svn.sourceforge.net/poet/?rev=35&view=rev
Author:   mercurio
Date:     2008-02-08 17:56:39 -0800 (Fri, 08 Feb 2008)

Log Message:
-----------
Update to documentation (Object resumeFormula)

Modified Paths:
--------------
    trunk/doc/handmade/tier0autodoc.tcl
    trunk/html/doc/tier1-Object.html
    trunk/lib/images/Thumbs.db
    trunk/lib/tclIndex
    trunk/vim/tcl.vim

Added Paths:
-----------
    trunk/testing/bench.out
    trunk/testing/bench.tcl

Modified: trunk/doc/handmade/tier0autodoc.tcl
===================================================================
--- trunk/doc/handmade/tier0autodoc.tcl	2008-01-17 05:21:33 UTC (rev 34)
+++ trunk/doc/handmade/tier0autodoc.tcl	2008-02-09 01:56:39 UTC (rev 35)
@@ -100,7 +100,7 @@
 used directly, use the methods of the ``Poet`` object instead.}
 newmethod {tier1/tier1-object.tcl} 0 {Object} {resumeFormula} {{?token?}} {A formula doesn't need to
 complete its calculation in one pass.  It can indicate that it is not completed by returning
-with ``return -code $::Poet::Continue token``, where ``token`` is a unique identifier (like a
+using ``error suspend token``, where ``token`` is a unique identifier (like a
 Poet object name).  The formula can later resume working on the final value via ``Object resumeFormula token``
 (it doesn't matter what object the method is invoked on), and then stop working on it again
 via ``Object resumeFormula`` with no token argument (closing that destination node for the time being).

Modified: trunk/html/doc/tier1-Object.html
===================================================================
--- trunk/html/doc/tier1-Object.html	2008-01-17 05:21:33 UTC (rev 34)
+++ trunk/html/doc/tier1-Object.html	2008-02-09 01:56:39 UTC (rev 35)
@@ -984,7 +984,7 @@
 <blockquote>
 A formula doesn't need to
 complete its calculation in one pass.  It can indicate that it is not completed by returning
-with <code>return -code <code><font color=green>$::Poet::Continue</font></code> token</code>, where <code>token</code> is a unique identifier (like a
+using <code>error suspend token</code>, where <code>token</code> is a unique identifier (like a
 Poet object name).  The formula can later resume working on the final value via <code>Object resumeFormula token</code>
 (it doesn't matter what object the method is invoked on), and then stop working on it again
 via <code>Object resumeFormula</code> with no token argument (closing that destination node for the time being).

Modified: trunk/lib/images/Thumbs.db
===================================================================
(Binary files differ)

Modified: trunk/lib/tclIndex
===================================================================
--- trunk/lib/tclIndex	2008-01-17 05:21:33 UTC (rev 34)
+++ trunk/lib/tclIndex	2008-02-09 01:56:39 UTC (rev 35)
@@ -195,10 +195,10 @@
 set auto_index(ObjectNameEntry) [list source [file join $dir tier3 tier3-objectnameentry.tcl]] ;# parent: BW_Entry
 set auto_index(ObjectNameHistory) [list source [file join $dir tier3 tier3-objectnamehistory.tcl]] ;# parent: ObjectNameCombo
 set auto_index(ObjectNameWidget) [list source [file join $dir tier3 tier3-objectnamewidget.tcl]] ;# parent: Mixin
+set auto_index(Poetics) [list source [file join $dir tier3 tier3-poetics.tcl]] ;# parent: Object
 set auto_index(ObjectTableBook) [list source [file join $dir tier3 tier3-objecttablebook.tcl]] ;# parent: BW_NoteBook
 set auto_index(ObjectTreeBook) [list source [file join $dir tier3 tier3-objecttreebook.tcl]] ;# parent: BW_NoteBook
 set auto_index(PocketTable) [list source [file join $dir tier3 tier3-pockettable.tcl]] ;# parent: BW_ScrolledWindow
-set auto_index(Poetics) [list source [file join $dir tier3 tier3-poetics.tcl]] ;# parent: Object
 set auto_index(PoeticsToolbox) [list source [file join $dir tier3 tier3-poeticstoolbox.tcl]] ;# parent: MainFrameTool
 set auto_index(Sage) [list source [file join $dir tier3 tier3-sage.tcl]] ;# parent: Object
 set auto_index(Scroll) [list source [file join $dir tier3 tier3-scroll.tcl]] ;# parent: Object

Added: trunk/testing/bench.out
===================================================================
--- trunk/testing/bench.out	                        (rev 0)
+++ trunk/testing/bench.out	2008-02-09 01:56:39 UTC (rev 35)
@@ -0,0 +1,12 @@
+using itcl...
+318027.7192960139 calls per second of: f bar
+61823.802163833076 calls per second of: delete object [foo f]
+using xotcl...
+349892.58297702606 calls per second of: f bar
+63788.12137603736 calls per second of: [Foo create f] destroy
+using tcloo...
+407931.82643316645 calls per second of: f bar
+43518.562842980675 calls per second of: [foo create f] destroy
+using Poet...
+24016.806000166678 calls per second of: f bar
+7640.417502974032 calls per second of: [Foo construct f] destruct

Added: trunk/testing/bench.tcl
===================================================================
--- trunk/testing/bench.tcl	                        (rev 0)
+++ trunk/testing/bench.tcl	2008-02-09 01:56:39 UTC (rev 35)
@@ -0,0 +1,155 @@
+# From wiki.tcl.tk/18152
+#
+
+package require Tcl 8.5
+
+proc cps {script {iters 100000}} {
+    set s [uplevel 1 [list time $script $iters]]
+    set cps [expr {1/([lindex $s 0]/1e6)}]
+    puts "$cps calls per second of: $script"
+}
+
+puts "using itcl..."
+package require Itcl 3.4
+namespace path itcl
+
+class foo {
+    variable x
+    constructor {} {
+       set x 1
+    }
+    method bar {} {
+       set x [expr {!$x}]
+    }
+}
+
+foo f
+cps {f bar}
+delete object f
+
+cps {delete object [foo f]} 10000
+
+delete class foo
+
+puts "using xotcl..."
+package require XOTcl 1.5.5
+namespace path xotcl
+
+Class create Foo
+Foo parameter x
+Foo instproc init {} {
+    my set x 1
+}
+Foo instproc bar {} {
+    my instvar x
+    set x [expr {!$x}]
+}
+
+Foo create f
+cps {f bar}
+f destroy
+
+cps {[Foo create f] destroy} 10000
+
+Foo destroy
+
+puts "using tcloo..."
+package require TclOO 0.1
+namespace path oo
+
+class create foo {
+    constructor {} {
+       variable x 1
+    }
+    method bar {} {
+       variable x
+       set x [expr {!$x}]
+    }
+}
+
+foo create f
+cps {f bar}
+f destroy
+
+cps {[foo create f] destroy} 10000
+
+foo destroy
+
+puts "using Poet..."
+set env(POET_TIER) 1	;# don't need Tk
+package require Poet
+
+Object construct Foo
+Foo slot x 0
+Foo method init {} {
+    $self slot x 1
+}
+Foo method bar {} {
+    $self slot x [expr {![$self slot x]}]
+}
+
+Foo construct f
+cps {f bar}
+f destruct
+
+cps {[Foo construct f] destruct} 10000
+
+Foo destruct
+
+if 0 { ;# snit skipped
+
+puts "using snit..."
+package require snit 2.1
+
+snit::type foo {
+    variable x
+    constructor {} {
+       set x 1
+    }
+    method foo {} {
+       set x [expr {!$x}]
+    }
+}
+
+foo create f
+cps {f bar}
+f delete
+
+cps {[foo create f] destroy} 10000
+
+foo destroy
+
+} ;# end of snit skipped
+
+if 0 { ;# stooop skipped
+
+puts "using stooop..."
+# Must go last because it plays games with proc which might disturb the
+# performance of other OO systems. Note that stooop has both virtual and
+# non-virtual methods, with very different performance profiles. The virtual
+# ones are much more comparable in capability to other OO systems...
+
+package require stooop 4.4.1
+namespace path stooop
+
+class foo {
+    proc foo {this} {
+       set ($this,x) 1
+    }
+    proc ~foo {this} {}
+    virtual proc bar {this} {
+       set ($this,x) [expr {!$($this,x)}]
+    }
+    proc bar-nv {this} {
+       set ($this,x) [expr {!$($this,x)}]
+    }
+}
+
+set f [new foo]
+cps {$f bar}
+cps {$f bar-nv}
+delete $f
+
+cps {delete [new foo]} 10000
+
+} ;# end of stooop skipped

Modified: trunk/vim/tcl.vim
===================================================================
--- trunk/vim/tcl.vim	2008-01-17 05:21:33 UTC (rev 34)
+++ trunk/vim/tcl.vim	2008-02-09 01:56:39 UTC (rev 35)
@@ -182,7 +182,7 @@
 
 " A bunch of useful keywords
 syn keyword tclStatement	proc global return lindex source catch
-syn keyword tclStatement	llength lappend lreplace lrange lsearch list concat incr
+syn keyword tclStatement	llength lappend lassign lreplace lrange lsearch list concat incr
 syn keyword tclStatement	uplevel upvar set
 syn keyword tclLabel		case default
 syn keyword tclConditional	if then else elseif switch


This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.