From 1f6ca1c81d94e56ed8346cc37f3de4e82d8e5105 Mon Sep 17 00:00:00 2001 From: Julian Noble Date: Wed, 17 May 2023 15:25:16 +1000 Subject: [PATCH] New funcl modules to handle o combinator and code generation for functional pipelines --- src/modules/funcl-0.1.tm | 320 +++++++++++++++++++++++++++++++++++++++ src/modules/punk-0.1.tm | 202 ++++++++++++++---------- 2 files changed, 445 insertions(+), 77 deletions(-) create mode 100644 src/modules/funcl-0.1.tm diff --git a/src/modules/funcl-0.1.tm b/src/modules/funcl-0.1.tm new file mode 100644 index 00000000..350e65ca --- /dev/null +++ b/src/modules/funcl-0.1.tm @@ -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] {uplevel 1 [list if 1 ]}] + } 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] {uplevel 1 [list if 1 ]}] + 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 +} + + + \ No newline at end of file diff --git a/src/modules/punk-0.1.tm b/src/modules/punk-0.1.tm index 25dca15f..5d722639 100644 --- a/src/modules/punk-0.1.tm +++ b/src/modules/punk-0.1.tm @@ -1,4 +1,5 @@ package provide punk [namespace eval punk { + #FUNCTL variable version set version 0.1 }] @@ -77,6 +78,8 @@ namespace eval punk::config { } namespace eval punk { + package require pattern + package require funcl package require control control::control assert enabled 1 namespace import ::control::assert @@ -111,17 +114,19 @@ namespace eval punk { variable last_run_display [list] variable ansi_disabled 0 #variable re_headvar1 {([a-zA-Z:@.(),]+?)(?![^(]*\))(,.*)*$} - + + proc ::punk::K {x y} { return $x} proc ::punk::var {varname {= {}} args} { + upvar $varname the_var if {${=} == "="} { if {[llength $args] > 1} { - uplevel 1 [list set $varname [uplevel 1 $args]] + set the_var [uplevel 1 $args] } else { - uplevel 1 [list set $varname [lindex $args 0]] + set the_var [lindex $args 0] } } else { - uplevel 1 [list set $varname] + set the_var } } @@ -588,7 +593,9 @@ namespace eval punk { if {$act in [list "?set" "?matchvar-set"]} { lset var_actions $i 1 matchvar-set #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 expected_values $i [list $nm match $existingval] } else { @@ -599,11 +606,12 @@ namespace eval punk { } if {$act in [list "?unset" "?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 } else { #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 {[lindex $var_actions $i 1] eq "set"} { 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 {[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} { - set match_caller [info level 2] + #set match_caller [info level 2] #debug.punk.pipe {_handle_bind_result match_caller: $match_caller} 9 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 { return [dict get $d result] } } #same as used in unknown func for initial launch #variable re_assign {^([^\r\n=\{]*)=(.*)} - variable re_assign {^[\{]{0,1}([^\r\n=]*)=(.*)} - variable re_dot_assign {^([^\r\n=\{]*)\.=(.*)} + variable re_assign {^[\{]{0,1}([^ \t\r\n=]*)=(.*)} + variable re_dot_assign {^([^ \t\r\n=\{]*)\.=(.*)} #match_assign is tailcalled from unknown - uplevel 1 gets to caller level proc match_assign {multivar e1 fulltail} { debug.punk.pipe {match_assign '$multivar' '$e1' '$fulltail'} 4 @@ -771,7 +784,6 @@ namespace eval punk { } elseif {[llength $tail] == 0} { 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. - #uplevel 1 [list unset $multivar] set returnval "" } else { #keyword pipesyntax at beginning of error message @@ -941,29 +953,31 @@ namespace eval punk { return 0 } } - + proc arg_is_script_shaped {arg} { if {[string first " " $arg] >= 0} { return 1 - } - if {[string first \n $arg] >= 0} { + } elseif {[string first \n $arg] >= 0} { return 1 - } - if {[string first ";" $arg] >= 0} { + } elseif {[string first ";" $arg] >= 0} { return 1 - } - if {[string first \t $arg] >= 0} { + } elseif {[string first \t $arg] >= 0} { return 1 + } else { + return 0 } - return 0 } proc match_exec {initial_returnvarspec e1 args} { set fulltail $args + unset args debug.punk.pipe {call match_exec: '$initial_returnvarspec' '$e1' '$fulltail'} 9 debug.punk.pipe.rep {[rep_listname fulltail]} 6 + #temp + set ::_pipescript "" + #--------------------------------------------------------------------- # test if we have an initial x.=y.= or x.= y.= @@ -974,6 +988,7 @@ namespace eval punk { set next1 $e1 set nexttail $fulltail } + if {$next1 eq "pipematch"} { set results [uplevel 1 [list pipematch {*}$nexttail]] debug.punk.pipe {>>> pipematch results: $results} 1 @@ -982,12 +997,17 @@ namespace eval punk { set r [_handle_bind_result $d] 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]} { #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]] debug.punk.pipe {>>> results: $results} 1 @@ -999,7 +1019,7 @@ namespace eval punk { if {[regexp $punk::re_assign $next1 _ nextreturnvarspec nextrhs]} { #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]] debug.punk.pipe {>>> results: $results} 1 @@ -1101,7 +1121,8 @@ namespace eval punk { if {$firstpipe_posn >=0} { set outpipespec [string range [lindex $tailremaining $firstpipe_posn] 1 end-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 { set segment_members $tailremaining 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 } - 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]} { - set forward_result $evaluated - set d [_multi_bind_result $returnvarspec $forward_result] + #set forward_result $evaluated + set d [_multi_bind_result $returnvarspec [punk::K $evaluated [unset evaluated]]] set r [_handle_bind_result $d] #return $r set segment_result $r @@ -1350,27 +1370,24 @@ namespace eval punk { } } else { #no scriptiness detected - set cmdlist [list] + #set cmdlist [list] 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] #set cmdlist [concat $rhs [lrange $segment_members_filled 1 end]] ;#ok if rhs empty - set firstword [lindex $cmdlist 0] - debug.punk.pipe {>>firstword: $firstword bindingspec:$returnvarspec >>cmdlist([llength $cmdlist]: $cmdlist)} 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 + #debug.punk.pipe {>>firstword: [lindex $cmdlist 0] bindingspec:$returnvarspec >>cmdlist([llength $cmdlist]: $cmdlist)} 4 + #debug.punk.pipe.rep {[a+ yellow bold][rep_listname cmdlist][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 segment_result $r #puts stderr ">>forward_result: $forward_result segment_result $r" @@ -1382,7 +1399,7 @@ namespace eval punk { } elseif {$segment_op eq "="} { set segment_result [uplevel 1 [list ::punk::match_assign $returnvarspec $rhs [lrange $segment_members_filled 1 end]]] #review - set forward_result $segment_result + #set forward_result $segment_result @@ -1420,26 +1437,50 @@ namespace eval punk { } if {!$add_argsdata} { - #puts stderr "APPLY1: args:$segmentargnames" + puts stderr "APPLY1: args:$segmentargnames" #puts stderr " script: $script" #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 { - #puts stderr "APPLY2: args:$segmentargnames" + puts stderr "APPLY2: args:$segmentargnames" #puts stderr " script: $script" #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 d [_multi_bind_result $returnvarspec $forward_result] + #set forward_result $evaluation + set d [_multi_bind_result $returnvarspec [punk::K $evaluation [unset evaluation]]] set r [_handle_bind_result $d] set segment_result $r } else { #tags ? - debug.punk.pipe {>>raw commandline: [concat $rhs $segment_members_filled]} 5 - set forward_result [uplevel 1 [concat $rhs $segment_members_filled]] - set d [_multi_bind_result $returnvarspec $forward_result] + #debug.punk.pipe {>>raw commandline: [concat $rhs $segment_members_filled]} 5 + if 1 { + + + + #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

$pscript] {uplevel 1 [concat $rhs $segment_members_filled [

]]}] + #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 segment_result $r } @@ -1550,8 +1591,8 @@ namespace eval punk { set segment_first_word return } - set forward_result $segment_result - set previous_result $forward_result + #set forward_result $segment_result + set previous_result $segment_result } else { #debug.punk.pipe {[a+ cyan bold]End of pipe segments ($i)[a+]} 4 set more_pipe_segments 0 @@ -1714,35 +1755,43 @@ namespace eval punk { error "pipesyntax pipenomatch expects a simple varname as first argument" } #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 arglist [lrange $args 1 end] - if {$assign eq ".="} { - set cmdlist [list ::punk::match_exec "" "" {*}$arglist] - } elseif {$assign eq "="} { - 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] + if {[string first = $assign] >= 0} { + variable re_dot_assign + variable re_assign + #what if we get passed a script block containing = ?? e.g {error x=a} + if {$assign eq ".="} { + set cmdlist [list ::punk::match_exec "" "" {*}$arglist] + } elseif {$assign eq "="} { + 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 { - set cmdlist $args - #return [dict create error [dict create reason [dict create pipematch bad_first_word value $assign pipeline [list pipematch $assign {*}$args]]]] + set cmdlist $args } - - debug.punk.pipe {[a+ yellow bold]pipematchnomatch [a+]} 1 + upvar 1 $varname nomatchvar 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]] - uplevel 1 [list set $varname $errordict] + #uplevel 1 [list set $varname $errordict] + set nomatchvar $errordict #re-raise the error for pipeswitch to deal with - uplevel 1 [list error $result] + #uplevel 1 [list error $result] + error $result } else { 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 $result #return [dict create ok [dict create result $result]] @@ -1781,7 +1830,7 @@ namespace eval punk { } proc pipeswitch {pipescript} { - uplevel $pipescript + uplevel 1 [list if 1 $pipescript] } proc ansi+ {args} { variable ansi_disabled @@ -2447,7 +2496,6 @@ namespace eval punk { proc add_length {total stringval} { expr {$total + [string length $stringval]} } - package require pattern >pattern .. Create >f >f .. Method foldl {total func sequence} { struct::list::Lfold $sequence $total $func