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
93 lines
2.9 KiB
1 year ago
|
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
|
||
|
|
||
|
|
||
|
|
||
|
|
||
|
|
||
|
|
||
|
|
||
|
|
||
|
|