jn
/
punkshell
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity
Browse Source

New funcl modules to handle o combinator and code generation for functional pipelines

master
Julian Noble 2 years ago
parent
740715060b
commit
1f6ca1c81d
2 changed files with 445 additions and 77 deletions
Whitespace
Show all changes Ignore whitespace when comparing lines Ignore changes in amount of whitespace Ignore changes in whitespace at EOL
Unified View
Diff Options
Show Stats Download Patch File Download Diff File
  1. 320
      src/modules/funcl-0.1.tm
  2. 198
      src/modules/punk-0.1.tm

320
src/modules/funcl-0.1.tm
Unescape View File

@ -0,0 +1,320 @@
package provide funcl [namespace eval funcl {
variable version
set version 0.1
}]
#funcl = function list (nested call structure)
#
#a basic functional composition o combinator
#o(f,g)(x) == f(g(x))
namespace eval funcl {
#from punk
proc arg_is_script_shaped {arg} {
if {[string first " " $arg] >= 0} {
return 1
} elseif {[string first \n $arg] >= 0} {
return 1
} elseif {[string first ";" $arg] >= 0} {
return 1
} elseif {[string first \t $arg] >= 0} {
return 1
} else {
return 0
}
}
proc o args {
set closing [string repeat {]} [expr [llength $args]-1]]
set body "[join $args { [}] \$data $closing"
return $body
}
proc o_ args {
set body ""
set tails [lrepeat [llength $args] ""]
puts stdout "tails: $tails"
set end [lindex $args end]
if {[llength $end] == 1 && [arg_is_script_shaped $end]} {
set endfunc [string map [list <end> $end] {uplevel 1 [list if 1 <end> ]}]
} else {
set endfunc $end
}
if {[llength $args] == 1} {
return $endfunc
}
set wrap { [}
append wrap $endfunc
append wrap { ]}
set i 0
foreach cmdlist [lrange $args 0 end-1] {
set is_script 0
if {([llength $cmdlist] == 1) && [arg_is_script_shaped [lindex $cmdlist 0]]} {
set is_script 1
set script [lindex $cmdlist 0]
}
set t ""
if {$i > 0} {
append body { [}
}
set posn [lsearch $cmdlist _]
if {$posn <= 0} {
append body $cmdlist
if {$i == [expr {[llength $args] -2}]} {
#append body " \$data"
append body " $wrap"
}
if {$i > 0} {
set t {]}
}
} else {
append body [lrange $cmdlist 0 $posn-1]
if {$i == [expr {[llength $args] -2}]} {
#append body " \$data"
append body " $wrap"
}
set t [lrange $cmdlist $posn+1 end]
if {$i > 0} {
append t { ]}
}
}
lset tails $i $t
incr i
}
append body [join [lreverse $tails] " "]
puts stdout "tails: $tails"
return $body
}
#review - consider _call -- if count > 1 then they must all be callable cmdlists(?)
# what does it mean to have additional _fn wrapper with no other elements? (no actual function)
#e.g _fn 2 5 6 somefunc {_fn 1 3 {_call 1 3 xxx}} {_fn 1 4 command {_fn ...}}
# what type indicates running subtrees in parallel vs sequentially?
# any reason to have _call count other than 1? Presumably the parent node indicates the parallelism/sequentialism etc.
#
#
# accept or return a funcl (or funcltree if multiple funcls in one commandlist)
# also accept/return a call - return empty list if passed a call
proc next_funcl {funcl_or_tree} {
if {[lindex $funcl_or_tree 0] eq "_call"} {
return [list]
}
if {[lindex $funcl_or_tree 0] in [list "_fn" "_call"]} {
set funcl $funcl_or_tree
} else {
error "funcltree not implemented"
}
set count [lindex $funcl 1]
if {$count == 0} {
#null funcl.. what is it? metadata/placeholder?
return $funcl
}
set indices [lrange $funcl 2 [expr {1 + $count}]]
set i 0
foreach idx $indices {
if {$i > 0} {
#todo - return a funcltree
error "multi funcl not implemented"
}
set next [lindex $funcl $idx]
incr i
}
return $next
}
#convert a funcl to a tcl script
proc funcl_script {funcl} {
if {![llength $funcl]} {
return ""
}
set body ""
set tails [list]
set type [lindex $funcl 0]
if {$type ni [list "_fn" "_call"]} {
#todo - handle funcltree
error "type $type not implemented"
}
#only count of 1 with index 3 supported(?)
if {$type eq "_call"} {
#leaf
set cmdlist [lindex $funcl 3]
return $cmdlist
}
#we will use next_funcl to walk the nodes.. todo support treefuncl response from next_funcl which could branch multiple times.
#by continually passing back the resulting treefuncl/funcl to next_funcl we can process in correct order (?)
# we would still need to maintain state to stitch it back together once returned from a subtree..
# ie multiple tail parts
set count [lindex $funcl 1]
if {$count == 1} {
set idx [lindex $funcl 2]
if {$idx == 3} {
set cmdlist_pre [list]
} else {
set cmdlist_pre [lrange $funcl 3 $idx-1]
}
append body $cmdlist_pre
set t [lrange $funcl $idx+1 end]
lappend tails $t
} else {
#??
error "funcl_script branching not yet supported"
}
set get_next 1
set i 1
while {$get_next} {
set funcl [next_funcl $funcl]
if {![llength $funcl]} {
set get_next 0
}
lassign $funcl type count idx ;#todo support count > 1
if {$type eq "_call"} {
set get_next 0
}
set t ""
if {$type eq "_call"} {
append body { [}
append body [lindex $funcl $idx]
append body { ]}
} else {
append body { [}
if {$idx == 3} {
set cmdlist_pre [list]
} else {
set cmdlist_pre [lrange $funcl 3 $idx-1]
}
append body $cmdlist_pre
set t [lrange $funcl $idx+1 end]
lappend tails $t
lappend tails { ]}
}
incr i
}
append body [join [lreverse $tails] " "]
#puts stdout "tails: $tails"
return $body
}
interp alias "" o_of "" funcl::o_of_n 1
#o_of_n
#tcl list rep o combinator
#
# can take lists of ordinary commandlists, scripts and funcls
# _fn 1 x where 1 indicates number of subfuncls and where x indicates next funcl position (_fn list or _arg)
# _fn 0 indicates next item is an unwrapped commandlist (terminal command)
#
#o_of is equivalent to o_of_n 1 (1 argument o combinator)
#last n args are passed to the prior function
#e.g for n=1 f a b = f(a(b))
#e.g for n=2, e f a b = e(f(a b))
proc o_of_n {n args} {
if {$n != 1} {
error "o_of_n only implemented for 1 sub-funcl"
}
set comp [list] ;#composition list
set end [lindex $args end]
if {[lindex $end 0] in [list "_fn" "_call"]} {
#is_funcl
set endfunc [lindex $args end]
} else {
if {[llength $end] == 1 && [arg_is_script_shaped $end]} {
#set endfunc [string map [list <end> $end] {uplevel 1 [list if 1 <end> ]}]
set endfunc [list _call 1 3 [list uplevel 1 [list if 1 [lindex $end 0]]]]
} else {
set endfunc [list _call 1 3 [list {*}$end]]
}
}
if {[llength $args] == 1} {
return $endfunc
}
set comp $endfunc
set revlist [lreverse [lrange $args 0 end-1]]
foreach cmdlist $revlist {
if {([llength $cmdlist] == 1) && [arg_is_script_shaped [lindex $cmdlist 0]]} {
set is_script 1
set script [lindex $cmdlist 0]
set arglist [list data]
set comp [list _fn 1 6 call_script $script $arglist $comp]
} else {
set posn1 [expr {[llength $cmdlist] + 2 + $n}]
set comp [list _fn $n $posn1 {*}$cmdlist $comp]
}
}
return $comp
}
proc call_script {script argnames args} {
uplevel 3 [list if 1 [list apply [list $argnames $script] {*}$args]]
}
proc funcl_script_test {scr} {
do_funcl_script_test $scr
}
proc do_funcl_script_test {scr} {
#set j "in do_funcl_script_test"
#set data "xxx"
#puts '$scr'
if 1 $scr
}
#standard o_ with no script-handling
proc o_plain args {
set body ""
set i 0
set tails [lrepeat [llength $args] ""]
#puts stdout "tails: $tails"
foreach cmdlist $args {
set t ""
if {$i > 0} {
append body { [}
}
set posn [lsearch $cmdlist _]
if {$posn <= 0} {
append body $cmdlist
if {$i == [expr {[llength $args] -1}]} {
append body " \$data"
}
if {$i > 0} {
set t {]}
}
} else {
append body [lrange $cmdlist 0 $posn-1]
if {$i == [expr {[llength $args] -1}]} {
append body " \$data"
}
set t [lrange $cmdlist $posn+1 end]
if {$i > 0} {
append t { ]}
}
}
lset tails $i $t
incr i
}
append body [join [lreverse $tails] " "]
#puts stdout "tails: $tails"
return $body
}
#timings suggest no faster to split out the first item from the cmdlist loop
}

198
src/modules/punk-0.1.tm
Unescape View File

@ -1,4 +1,5 @@
package provide punk [namespace eval punk { package provide punk [namespace eval punk {
#FUNCTL
variable version variable version
set version 0.1 set version 0.1
}] }]
@ -77,6 +78,8 @@ namespace eval punk::config {
} }
namespace eval punk { namespace eval punk {
package require pattern
package require funcl
package require control package require control
control::control assert enabled 1 control::control assert enabled 1
namespace import ::control::assert namespace import ::control::assert
@ -112,16 +115,18 @@ namespace eval punk {
variable ansi_disabled 0 variable ansi_disabled 0
#variable re_headvar1 {([a-zA-Z:@.(),]+?)(?![^(]*\))(,.*)*$} #variable re_headvar1 {([a-zA-Z:@.(),]+?)(?![^(]*\))(,.*)*$}
proc ::punk::K {x y} { return $x}
proc ::punk::var {varname {= {}} args} { proc ::punk::var {varname {= {}} args} {
upvar $varname the_var
if {${=} == "="} { if {${=} == "="} {
if {[llength $args] > 1} { if {[llength $args] > 1} {
uplevel 1 [list set $varname [uplevel 1 $args]] set the_var [uplevel 1 $args]
} else { } else {
uplevel 1 [list set $varname [lindex $args 0]] set the_var [lindex $args 0]
} }
} else { } else {
uplevel 1 [list set $varname] set the_var
} }
} }
@ -588,7 +593,9 @@ namespace eval punk {
if {$act in [list "?set" "?matchvar-set"]} { if {$act in [list "?set" "?matchvar-set"]} {
lset var_actions $i 1 matchvar-set lset var_actions $i 1 matchvar-set
#attempt to read #attempt to read
if {![catch {uplevel $lvlup [list set $nm]} existingval]} { upvar $lvlup $nm the_var
#if {![catch {uplevel $lvlup [list set $nm]} existingval]} {}
if {![catch {set the_var} existingval]} {
lset match_state $i [expr {$existingval eq $val}] lset match_state $i [expr {$existingval eq $val}]
lset expected_values $i [list $nm match $existingval] lset expected_values $i [list $nm match $existingval]
} else { } else {
@ -599,11 +606,12 @@ namespace eval punk {
} }
if {$act in [list "?unset" "?matchvar-unset"]} { if {$act in [list "?unset" "?matchvar-unset"]} {
lset var_actions $i 1 matchvar-unset lset var_actions $i 1 matchvar-unset
if {![uplevel $lvlup [list info exists $nm ]]} { upvar $lvlup $nm the_var
if {![info exists the_var]} {
lset match_state $i 1 lset match_state $i 1
} else { } else {
#attempt to unset a pinned var that has a value - non-match. ^x= will only match an unset variable x #attempt to unset a pinned var that has a value - non-match. ^x= will only match an unset variable x
lset expected_values $i [list $nm attempt-to-unset-pinned-var-with-value [uplevel $lvlup [list set $nm]]] lset expected_values $i [list $nm attempt-to-unset-pinned-var-with-value [set the_var]]
} }
} }
@ -642,12 +650,16 @@ namespace eval punk {
if {(!$isatom) && (!$ispin)} { if {(!$isatom) && (!$ispin)} {
if {[lindex $var_actions $i 1] eq "set"} { if {[lindex $var_actions $i 1] eq "set"} {
if {[string length $nm]} { if {[string length $nm]} {
uplevel $lvlup [list set $nm $val] upvar $lvlup $nm the_var
set the_var $val
#uplevel $lvlup [list set $nm $val]
} }
} }
if {[lindex $var_actions $i 1] eq "unset"} { if {[lindex $var_actions $i 1] eq "unset"} {
if {[string length $nm]} { if {[string length $nm]} {
catch {uplevel $lvlup [list unset $nm]} upvar $lvlup $nm the_var
catch {unset the_var}
#catch {uplevel $lvlup [list unset $nm]}
} }
} }
} }
@ -707,18 +719,19 @@ namespace eval punk {
proc _handle_bind_result {d} { proc _handle_bind_result {d} {
set match_caller [info level 2] #set match_caller [info level 2]
#debug.punk.pipe {_handle_bind_result match_caller: $match_caller} 9 #debug.punk.pipe {_handle_bind_result match_caller: $match_caller} 9
if {![dict exists $d result]} { if {![dict exists $d result]} {
uplevel 1 [list error [dict get $d mismatch]] #uplevel 1 [list error [dict get $d mismatch]]
error [dict get $d mismatch]
} else { } else {
return [dict get $d result] return [dict get $d result]
} }
} }
#same as used in unknown func for initial launch #same as used in unknown func for initial launch
#variable re_assign {^([^\r\n=\{]*)=(.*)} #variable re_assign {^([^\r\n=\{]*)=(.*)}
variable re_assign {^[\{]{0,1}([^\r\n=]*)=(.*)} variable re_assign {^[\{]{0,1}([^ \t\r\n=]*)=(.*)}
variable re_dot_assign {^([^\r\n=\{]*)\.=(.*)} variable re_dot_assign {^([^ \t\r\n=\{]*)\.=(.*)}
#match_assign is tailcalled from unknown - uplevel 1 gets to caller level #match_assign is tailcalled from unknown - uplevel 1 gets to caller level
proc match_assign {multivar e1 fulltail} { proc match_assign {multivar e1 fulltail} {
debug.punk.pipe {match_assign '$multivar' '$e1' '$fulltail'} 4 debug.punk.pipe {match_assign '$multivar' '$e1' '$fulltail'} 4
@ -771,7 +784,6 @@ namespace eval punk {
} elseif {[llength $tail] == 0} { } elseif {[llength $tail] == 0} {
set d [_multi_bind_result $multivar "" -unset 1] ;#final arg 1 to unset variables set d [_multi_bind_result $multivar "" -unset 1] ;#final arg 1 to unset variables
set r [_handle_bind_result $d] ;# we can get a mismatch on unsetting a pinned var - so we need _handle_bind_result to give a chance to raise an error etc. set r [_handle_bind_result $d] ;# we can get a mismatch on unsetting a pinned var - so we need _handle_bind_result to give a chance to raise an error etc.
#uplevel 1 [list unset $multivar]
set returnval "" set returnval ""
} else { } else {
#keyword pipesyntax at beginning of error message #keyword pipesyntax at beginning of error message
@ -945,25 +957,27 @@ namespace eval punk {
proc arg_is_script_shaped {arg} { proc arg_is_script_shaped {arg} {
if {[string first " " $arg] >= 0} { if {[string first " " $arg] >= 0} {
return 1 return 1
} } elseif {[string first \n $arg] >= 0} {
if {[string first \n $arg] >= 0} {
return 1 return 1
} } elseif {[string first ";" $arg] >= 0} {
if {[string first ";" $arg] >= 0} {
return 1 return 1
} } elseif {[string first \t $arg] >= 0} {
if {[string first \t $arg] >= 0} {
return 1 return 1
} else {
return 0
} }
return 0
} }
proc match_exec {initial_returnvarspec e1 args} { proc match_exec {initial_returnvarspec e1 args} {
set fulltail $args set fulltail $args
unset args
debug.punk.pipe {call match_exec: '$initial_returnvarspec' '$e1' '$fulltail'} 9 debug.punk.pipe {call match_exec: '$initial_returnvarspec' '$e1' '$fulltail'} 9
debug.punk.pipe.rep {[rep_listname fulltail]} 6 debug.punk.pipe.rep {[rep_listname fulltail]} 6
#temp
set ::_pipescript ""
#--------------------------------------------------------------------- #---------------------------------------------------------------------
# test if we have an initial x.=y.= or x.= y.= # test if we have an initial x.=y.= or x.= y.=
@ -974,6 +988,7 @@ namespace eval punk {
set next1 $e1 set next1 $e1
set nexttail $fulltail set nexttail $fulltail
} }
if {$next1 eq "pipematch"} { if {$next1 eq "pipematch"} {
set results [uplevel 1 [list pipematch {*}$nexttail]] set results [uplevel 1 [list pipematch {*}$nexttail]]
debug.punk.pipe {>>> pipematch results: $results} 1 debug.punk.pipe {>>> pipematch results: $results} 1
@ -982,12 +997,17 @@ namespace eval punk {
set r [_handle_bind_result $d] set r [_handle_bind_result $d]
return $r return $r
} elseif {$next1 eq "pipecase"} {
set msg "pipesyntax\n"
append msg "pipecase cannot return a value directly.\n"
append msg "Call pipecase from within a script block such as pipeswitch or apply."
error $msg
} }
if {![arg_is_script_shaped $next1]} { if {([string first = $next1] >= 0) && (![arg_is_script_shaped $next1]) } {
if {[regexp $punk::re_dot_assign $next1 _ nextreturnvarspec nextrhs]} { if {[regexp $punk::re_dot_assign $next1 _ nextreturnvarspec nextrhs]} {
#non pipelined call to self - return result #non pipelined call to self - return result
debug.punk.pipe {nextreturnvarspec: $nextreturnvarspec nextrhs:$nextrhs tail:$nexttail} 0 debug.punk.pipe {nextreturnvarspec: $nextreturnvarspec nextrhs:$nextrhs tail:$nexttail} 4
set results [uplevel 1 [list ::punk::match_exec $nextreturnvarspec $nextrhs {*}$nexttail]] set results [uplevel 1 [list ::punk::match_exec $nextreturnvarspec $nextrhs {*}$nexttail]]
debug.punk.pipe {>>> results: $results} 1 debug.punk.pipe {>>> results: $results} 1
@ -999,7 +1019,7 @@ namespace eval punk {
if {[regexp $punk::re_assign $next1 _ nextreturnvarspec nextrhs]} { if {[regexp $punk::re_assign $next1 _ nextreturnvarspec nextrhs]} {
#non pipelined call to plain = assignment - return result #non pipelined call to plain = assignment - return result
debug.punk.pipe {nextreturnvarspec: $nextreturnvarspec nextrhs:$nextrhs tail:$nexttail} 0 debug.punk.pipe {nextreturnvarspec: $nextreturnvarspec nextrhs:$nextrhs tail:$nexttail} 4
set results [uplevel 1 [list ::punk::match_assign $nextreturnvarspec $nextrhs $nexttail]] set results [uplevel 1 [list ::punk::match_assign $nextreturnvarspec $nextrhs $nexttail]]
debug.punk.pipe {>>> results: $results} 1 debug.punk.pipe {>>> results: $results} 1
@ -1101,7 +1121,8 @@ namespace eval punk {
if {$firstpipe_posn >=0} { if {$firstpipe_posn >=0} {
set outpipespec [string range [lindex $tailremaining $firstpipe_posn] 1 end-1] set outpipespec [string range [lindex $tailremaining $firstpipe_posn] 1 end-1]
set segment_members [lrange $tailremaining 0 $firstpipe_posn-1] set segment_members [lrange $tailremaining 0 $firstpipe_posn-1]
set tailremaining [lrange $tailremaining $firstpipe_posn+1 end] #set tailremaining [lrange $tailremaining $firstpipe_posn+1 end]
set tailremaining [lreplace $tailremaining 0 $firstpipe_posn] ;#generally too short for any K combinator benefit? what about lists with scripts? is it dependent on list length or also element content size?
} else { } else {
set segment_members $tailremaining set segment_members $tailremaining
set tailremaining [list] set tailremaining [list]
@ -1163,7 +1184,6 @@ namespace eval punk {
} }
#set firstwordparts [regexp -inline -all {\S+} $segment_first_word]
@ -1315,11 +1335,11 @@ namespace eval punk {
append e $seg_remainder append e $seg_remainder
} }
puts stderr ">evaluating $e as expression\n due to brace \"\{\" immediately following .=" debug.punk.pipe {>evaluating $e as expression\n due to brace \"\{\" immediately following .=} 4
if {![catch {uplevel 1 [list expr $e]} evaluated]} { if {![catch {uplevel 1 [list expr $e]} evaluated]} {
set forward_result $evaluated #set forward_result $evaluated
set d [_multi_bind_result $returnvarspec $forward_result] set d [_multi_bind_result $returnvarspec [punk::K $evaluated [unset evaluated]]]
set r [_handle_bind_result $d] set r [_handle_bind_result $d]
#return $r #return $r
set segment_result $r set segment_result $r
@ -1350,27 +1370,24 @@ namespace eval punk {
} }
} else { } else {
#no scriptiness detected #no scriptiness detected
set cmdlist [list] #set cmdlist [list]
if {[llength $rhs]} { if {[llength $rhs]} {
lappend cmdlist $rhs #lappend cmdlist $rhs
set cmdlist [list $rhs]
} else {
set cmdlist [list]
} }
lappend cmdlist {*}[lrange $segment_members_filled 1 end] lappend cmdlist {*}[lrange $segment_members_filled 1 end]
#set cmdlist [concat $rhs [lrange $segment_members_filled 1 end]] ;#ok if rhs empty #set cmdlist [concat $rhs [lrange $segment_members_filled 1 end]] ;#ok if rhs empty
set firstword [lindex $cmdlist 0] #debug.punk.pipe {>>firstword: [lindex $cmdlist 0] bindingspec:$returnvarspec >>cmdlist([llength $cmdlist]: $cmdlist)} 4
debug.punk.pipe {>>firstword: $firstword bindingspec:$returnvarspec >>cmdlist([llength $cmdlist]: $cmdlist)} 4 #debug.punk.pipe.rep {[a+ yellow bold][rep_listname cmdlist][a+]} 4
debug.punk.pipe.rep {[a+ yellow bold][rep_listname cmdlist][a+]} 4
#set c1 [string index $firstword 0]
#if {$c1 in [list \" "("]} {
# set firstword [string range $firstword 1 end]
# lset cmdlist 0 $firstword
#}
#puts stderr ">>cmdlist: $cmdlist"
set forward_result [uplevel 1 $cmdlist]
debug.punk.pipe {[a+ green bold]forward_result: $forward_result[a+]} 4
debug.punk.pipe.rep {[a+ yellow bold]forward_result REP: [rep $forward_result][a+]} 4
set d [_multi_bind_result $returnvarspec $forward_result] set cmdlist_result [uplevel 1 $cmdlist]
#debug.punk.pipe {[a+ green bold]forward_result: $forward_result[a+]} 4
#debug.punk.pipe.rep {[a+ yellow bold]forward_result REP: [rep $forward_result][a+]} 4
set d [_multi_bind_result $returnvarspec [punk::K $cmdlist_result [unset cmdlist_result]]]
set r [_handle_bind_result $d] set r [_handle_bind_result $d]
set segment_result $r set segment_result $r
#puts stderr ">>forward_result: $forward_result segment_result $r" #puts stderr ">>forward_result: $forward_result segment_result $r"
@ -1382,7 +1399,7 @@ namespace eval punk {
} elseif {$segment_op eq "="} { } elseif {$segment_op eq "="} {
set segment_result [uplevel 1 [list ::punk::match_assign $returnvarspec $rhs [lrange $segment_members_filled 1 end]]] set segment_result [uplevel 1 [list ::punk::match_assign $returnvarspec $rhs [lrange $segment_members_filled 1 end]]]
#review #review
set forward_result $segment_result #set forward_result $segment_result
@ -1420,26 +1437,50 @@ namespace eval punk {
} }
if {!$add_argsdata} { if {!$add_argsdata} {
#puts stderr "APPLY1: args:$segmentargnames" puts stderr "APPLY1: args:$segmentargnames"
#puts stderr " script: $script" #puts stderr " script: $script"
#puts stderr " vals: $segmentargvals" #puts stderr " vals: $segmentargvals"
set evaluation [apply [list $segmentargnames $script ::] {*}$segmentargvals] #set evaluation [apply [list $segmentargnames $script ::] {*}$segmentargvals]
set evaluation [uplevel 1 [list apply [list $segmentargnames $script ::] {*}$segmentargvals]]
} else { } else {
#puts stderr "APPLY2: args:$segmentargnames" puts stderr "APPLY2: args:$segmentargnames"
#puts stderr " script: $script" #puts stderr " script: $script"
#puts stderr " vals: $segmentargvals $argsdatalist" #puts stderr " vals: $segmentargvals $argsdatalist"
set evaluation [apply [list [concat $segmentargnames argsdata] $script ::] {*}$segmentargvals $argsdatalist] #set evaluation [apply [list [concat $segmentargnames argsdata] $script ::] {*}$segmentargvals $argsdatalist]
#pipeline script context should be one below calling context - so upvar v v will work
set evaluation [uplevel 1 [list apply [list [concat $segmentargnames argsdata] $script ::] {*}$segmentargvals $argsdatalist]]
} }
set forward_result $evaluation #set forward_result $evaluation
set d [_multi_bind_result $returnvarspec $forward_result] set d [_multi_bind_result $returnvarspec [punk::K $evaluation [unset evaluation]]]
set r [_handle_bind_result $d] set r [_handle_bind_result $d]
set segment_result $r set segment_result $r
} else { } else {
#tags ? #tags ?
debug.punk.pipe {>>raw commandline: [concat $rhs $segment_members_filled]} 5 #debug.punk.pipe {>>raw commandline: [concat $rhs $segment_members_filled]} 5
set forward_result [uplevel 1 [concat $rhs $segment_members_filled]] if 1 {
set d [_multi_bind_result $returnvarspec $forward_result]
#set s [list uplevel 1 [concat $rhs $segment_members_filled]]
if {![info exists pscript]} {
upvar ::_pipescript pscript
}
if {![info exists pscript]} {
#set pscript $s
set pscript [funcl::o_of_n 1 [list $rhs {*}$segment_members]]
} else {
#set pscript [string map [list <p> $pscript] {uplevel 1 [concat $rhs $segment_members_filled [<p>]]}]
#set snew "set pipe_$i \[uplevel 1 \[list $rhs $segment_members_filled "
#append snew "set pipe_[expr $i -1]"
#append pscript $snew
set pscript [funcl::o_of_n 1 [list $rhs {*}$segment_members] $pscript]
}
}
set cmdline_result [uplevel 1 [concat $rhs $segment_members_filled]]
set d [_multi_bind_result $returnvarspec [punk::K $cmdline_result [unset cmdline_result]]]
set r [_handle_bind_result $d] set r [_handle_bind_result $d]
set segment_result $r set segment_result $r
} }
@ -1550,8 +1591,8 @@ namespace eval punk {
set segment_first_word return set segment_first_word return
} }
set forward_result $segment_result #set forward_result $segment_result
set previous_result $forward_result set previous_result $segment_result
} else { } else {
#debug.punk.pipe {[a+ cyan bold]End of pipe segments ($i)[a+]} 4 #debug.punk.pipe {[a+ cyan bold]End of pipe segments ($i)[a+]} 4
set more_pipe_segments 0 set more_pipe_segments 0
@ -1714,35 +1755,43 @@ namespace eval punk {
error "pipesyntax pipenomatch expects a simple varname as first argument" error "pipesyntax pipenomatch expects a simple varname as first argument"
} }
#debug.punk.pipe {pipematch level [info level] levelinfo [info level 0]} 2 #debug.punk.pipe {pipematch level [info level] levelinfo [info level 0]} 2
variable re_dot_assign
variable re_assign
set assign [lindex $args 0] set assign [lindex $args 0]
set arglist [lrange $args 1 end] set arglist [lrange $args 1 end]
if {$assign eq ".="} { if {[string first = $assign] >= 0} {
set cmdlist [list ::punk::match_exec "" "" {*}$arglist] variable re_dot_assign
} elseif {$assign eq "="} { variable re_assign
set cmdlist [list ::punk::match_assign "" "" $arglist] #what if we get passed a script block containing = ?? e.g {error x=a}
} elseif {[regexp $re_dot_assign $assign _ returnvarspecs rhs]} { if {$assign eq ".="} {
set cmdlist [list ::punk::match_exec $returnvarspecs $rhs {*}$arglist] set cmdlist [list ::punk::match_exec "" "" {*}$arglist]
} elseif {[regexp $re_assign $assign _ returnvarspecs rhs]} { } elseif {$assign eq "="} {
set cmdlist [list ::punk::match_assign $returnvarspecs $rhs $arglist] set cmdlist [list ::punk::match_assign "" "" $arglist]
} elseif {[regexp $re_dot_assign $assign _ returnvarspecs rhs]} {
set cmdlist [list ::punk::match_exec $returnvarspecs $rhs {*}$arglist]
} elseif {[regexp $re_assign $assign _ returnvarspecs rhs]} {
set cmdlist [list ::punk::match_assign $returnvarspecs $rhs $arglist]
} else {
debug.punk.pipe {[a+ yellow bold] Unexpected arg following pipenomatchvar variable [a+]} 0
set cmdlist $args
#return [dict create error [dict create reason [dict create pipematch bad_first_word value $assign pipeline [list pipematch $assign {*}$args]]]]
}
} else { } else {
set cmdlist $args set cmdlist $args
#return [dict create error [dict create reason [dict create pipematch bad_first_word value $assign pipeline [list pipematch $assign {*}$args]]]]
} }
upvar 1 $varname nomatchvar
debug.punk.pipe {[a+ yellow bold]pipematchnomatch [a+]} 1
if {[catch {uplevel 1 $cmdlist} result]} { if {[catch {uplevel 1 $cmdlist} result]} {
debug.punk.pipe {[a+ yellow bold]pipematchnomatch error $result[a+]} 1 debug.punk.pipe {[a+ yellow bold]pipematchnomatch error $result[a+]} 3
set errordict [dict create error [dict create reason $result]] set errordict [dict create error [dict create reason $result]]
uplevel 1 [list set $varname $errordict] #uplevel 1 [list set $varname $errordict]
set nomatchvar $errordict
#re-raise the error for pipeswitch to deal with #re-raise the error for pipeswitch to deal with
uplevel 1 [list error $result] #uplevel 1 [list error $result]
error $result
} else { } else {
debug.punk.pipe {pipematchnomatch result $result } 4 debug.punk.pipe {pipematchnomatch result $result } 4
uplevel 1 [list set $varname ""] set nomatchvar ""
#uplevel 1 [list set $varname ""]
#return raw result only - to pass through to pipeswitch #return raw result only - to pass through to pipeswitch
return $result return $result
#return [dict create ok [dict create result $result]] #return [dict create ok [dict create result $result]]
@ -1781,7 +1830,7 @@ namespace eval punk {
} }
proc pipeswitch {pipescript} { proc pipeswitch {pipescript} {
uplevel $pipescript uplevel 1 [list if 1 $pipescript]
} }
proc ansi+ {args} { proc ansi+ {args} {
variable ansi_disabled variable ansi_disabled
@ -2447,7 +2496,6 @@ namespace eval punk {
proc add_length {total stringval} { proc add_length {total stringval} {
expr {$total + [string length $stringval]} expr {$total + [string length $stringval]}
} }
package require pattern
>pattern .. Create >f >pattern .. Create >f
>f .. Method foldl {total func sequence} { >f .. Method foldl {total func sequence} {
struct::list::Lfold $sequence $total $func struct::list::Lfold $sequence $total $func

Write Preview
Loading…
Cancel
Save