You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
 
 
 
 
 
 

93 lines
2.9 KiB

package require punk
#https://www.youtube.com/watch?v=26jVysJHB-s
#based on Monads in Python: Why and How?
#some function timer
proc xxxpipet {subcommand} {
return [list % val $subcommand |sub> {
if {![info exists input]} {
set input ""
} else {
set input
}
} |input> {clock micros} |start> {{*}$sub {*}$input} |res> {expr [clock micros] - $start} |t> {list $res $t} <input| ]
}
proc pipet {subcommand} {
return [list % list $subcommand |sub/0,input/1> \
{clock micros} |start> {{*}$sub {*}$input} |res> {expr [clock micros] - $start} |t> {list $res $t} <input| ]
}
pipeset fast % {expr {$x + 1}} <x|
pipeset slow % {after 100} |> {expr {$x + 1}} <x|
pipeset slow2 % {after 150} |> {expr {$x + 2}} <x|
#naive chaining of time-wrapped commands.
#Requires unpacking/matching at each stage of pipeline and summing at end.
% .= val 2 |> .= {{*}[pipet $::fast] $data} |d@0,t@1> {{*}[pipet $::slow] $d} |d@,t2@> {{*}[pipet $::slow2] $d} |d@,t3@> {list $d [expr {$t + $t2 + $t3}]}
#method 2 - abstract away the extraction and summation in a bind function
# x2, t = bind(bind(fast(1), slow), slow2)
# % bind=% {list $vt $f} |v@0/0,t@0/1> {{*}$f $v} |r2@,t2@> {list $r2 [expr {$t + $t2}]} <vt@,f@|
pipeset bind % {list $vt $f} |v@0/0,t@0/1> {{*}$f $v} |r2@,t2@> {list $r2 [expr {$t + $t2}]} <vt@,f@|
# requires nested binds .. a bit messy
{*}$bind [{*}$bind [{*}[pipet $::fast] 1] [pipet $::slow]] [pipet $::slow2]
#we can neaten it up with tcl aliases, but we still don't have a straightforward pipeline so it will get messier with more operations.
alias t_fast {*}[pipet $fast]
alias t_slow {*}[pipet $slow]
alias t_slow2 {*}[pipet $slow2]
alias bind {*}$bind
bind [bind [t_fast 1] t_slow] t_slow2
#now with oo approach
catch {timedvalue destroy}
oo::class create timedvalue {
variable o_value
variable o_time
constructor {value {time 0}} {
set o_value $value
set o_time $time
}
method value {} {return $o_value}
method time {} {return $o_time}
method bind {f} {
set timed_value [{*}$f $o_value]
set new_value [$timed_value value]
set new_time [expr {$o_time + [$timed_value time]}]
return [timedvalue new $new_value $new_time]
}
}
#we need a new timing wrapper that returns an object
proc pipet2 {subcommand} {
return [list % list $subcommand |sub/0,input/1> \
{clock micros} |start> {{*}$sub {*}$input} |res> {expr [clock micros] - $start} |t> {timedvalue new $res $t} <input| ]
}
alias o_fast {*}[pipet2 $fast]
alias o_slow {*}[pipet2 $slow]
alias o_slow2 {*}[pipet2 $slow2]
tvresult.= \
.= o_fast 1 \
|o> {$o bind o_slow} \
|o> {$o bind o_slow2}
puts "tvresult value: [$tvresult value]"
puts "tvresult time: [$tvresult time]"
#timedvalue class is a monad