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
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 |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|