Factorial Using Event Loop

I'm easily amused (especially when amusing myself). See Tail call optimization for other variations.

 proc continue: {args} {
    after idle $args
 }

 proc fac {n result {accum 1}} {
    if {$n > 1} {
        continue: fac [expr {$n-1}] $result [expr {$accum * $n}]
    } else {
        upvar $result res
        set res $accum
    }
 }

 fac 10 ::foo
 vwait ::foo
 puts $::foo

Hey, and there is room for more things to be done while calculating...

 proc do_ntimes {cnt code} {
    uplevel $code
    if {$cnt > 0} {
        continue: do_ntimes [incr cnt -1] $code
    }
 }

 fac 10 ::foo
 do_ntimes 10 {puts "hello world"}
 vwait ::foo
 puts $::foo

-- Todd Coram

RS Interesting: this is using the event queue instead of the recursion stack (which has a fixed depth limit - does the event queue have a similar limit?). Functional programmers will of course abhor procedures which do not return a value, as they are run asynchronously, and so mostly global variables will have to be used. But still - another cool braintwister...

DKF: Functional programmers would be better off using a callback (function fragment!) to print the result value instead.

DKF: Here's another variant:

 proc calculateFactorial {ary target} {
    upvar #0 $ary a
    if {$target < 2} {
       set a($target) 1
       return
    }
    if {[info exist a($target)] && [string is integer $a($target)]} {
       set a($target) $a($target)
       return
    }
    set t1 [expr {$target-1}]
    set t2 [expr {$target-2}]
    if {![info exist a($t1)]} {
       set a($t1) pending
       after 1000 calculateFactorial $ary $t1
    }
    if {![info exist a($t2)]} {
       set a($t2) pending
       after 1000 calculateFactorial $ary $t2
    }
    if {![string is integer $a($t1)] || ![string is integer $a($t2)]} {
       after 1000 calculateFactorial $ary $target
       return
    }
    set a($target) [expr {$a($t1)+$a($t2)}]
 }

Enjoy!

(In response to RS) Erlang programmers use a similiar idiom to the one I used at the top of this page. Erlang is (er mostly) functional (no side-effects), but it utilizes message passing. Factorial could be an Erlang asynchronous "process" and the result is simply sent back to the requestor. This would be easy to do in Tcl (and you kinda get that with what I was doing with the event loop!).

A further refinement (as prescribed by DKF):

 proc fac {n result_cb {accum 1}} {
    if {$n > 1} {
        continue: fac [expr {$n-1}] $result [expr {$accum * $n}]
    } else {
        eval $result_cb $accum
    }
 }

 proc notify_me {result} {
   puts "Factorial result = $result"
 }

 fac 10 notify_me
 vwait ::forever

Now there are no global variables (kill ::forever by using Tk and falling into the event loop ;-)

-- Todd Coram

NEM 5 Feb 2007 offers this cute variant which factors out the callback:

 proc spawn {varName = args} {
     upvar #0 $varName var
     trace add variable var read [list await $varName]
     spawn_ $varName $args
 }
 proc spawn_ {varName cmd} {
     set rc [catch { uplevel #0 $cmd } result]
     switch $rc {
         0       { spawn:result $varName $result }
         4       { after 0 [list spawn_ $varName $result] }
         default { return -code $rc $result }
     }
 }
 proc spawn:result {varName result} {
     upvar #0 $varName var
     trace remove variable var read [list await $varName]
     set var $result
 }
 proc await {varName args} {
     upvar #0 $varName var
     while {![info exists var]} { update }
     #if {![info exists var]} { uplevel #0 [list vwait $varName] }
 }
 proc tailcall args { return -code continue -level 2 $args }

We can then write our factorial function a bit more naturally:

 proc fac {n {accum 1}} {
     if {$n > 1} {
         tailcall fac [expr {$n-1}] [expr {$accum*$n}]
     } else {
         return $accum
     }
 }
 spawn x = fac 100
 spawn y = fac 1000
 pack [label .l -text "x = "] [label .x -textvariable x]
 puts "x = $x\ny = $y"

I'd be interested if anyone can get the vwait form of await to work. On my Mac OS X laptop it hangs for ever and never notices the variables being set. I think this may be a bug in vwait.

Category Mathematics