From 36e271674c79426f753aa1df78137e736e44f34d Mon Sep 17 00:00:00 2001 From: Julian Noble Date: Tue, 16 May 2023 02:53:40 +1000 Subject: [PATCH] pipeswitch/pipecase implementation + adhoc testscript tests/pipeswitch.tcl --- scriptlib/tests/pipeswitch.tcl | 76 +++++++++ src/modules/punk-0.1.tm | 282 ++++++++++++++++++++++----------- 2 files changed, 265 insertions(+), 93 deletions(-) create mode 100644 scriptlib/tests/pipeswitch.tcl diff --git a/scriptlib/tests/pipeswitch.tcl b/scriptlib/tests/pipeswitch.tcl new file mode 100644 index 0000000..9a004bb --- /dev/null +++ b/scriptlib/tests/pipeswitch.tcl @@ -0,0 +1,76 @@ +package require punk + +proc test1 {} { + alsoresult,data@@DATA.=\ + result@1/1,returnvalue,status@0.= pipeswitch { + puts stderr "pre pipecase code always runs" + + pipecase ,'p1v0@0.= val {p1v0x b c} |> { + puts stdout "pipecase1 $data" + set data + } + + # in between + puts stderr "code after unmatched but before matched will run" + + pipecase input,'p2v1@1.= val {x p2v1 z} |> { + puts stdout "pipecase2 $data" + return [list source pipecase2 data $data] + } |> { + string toupper $data + } + + pipecase ,'p3v3@2.= val {d e p3v3x} |> { + puts stdout "pipecase3 $data" + set data + } + + puts stderr "no matches" + return nomatch + } + puts stdout "returnvalue of pipeswitch return is: $returnvalue" + puts stdout "value of pipeswitch result is: $result" + puts stdout "status of pipeswitch is: $status" + puts stdout "alsoresult:$alsoresult" + puts stdout "dict destructuring, DATA key = $data" +} +test1 +test1 + +puts stderr "proc test follows" +proc match_args {args} { + procresult,'ok@0.= pipeswitch { + pipecase p1,'a@0.= val $args |> string toupper |> { + + return [list source pipecase1 data $data] + } + + pipecase p2,'x@0,'y@1.=val $args |> { + return [list source pipecase2 data $data] + } + + pipecase p3,'x@0.=val $args |> { + return [list source pipecase3 data [list transformed {*}$data]] + } + + pipecase .=val $args |> { + puts "catchall pipe4" + return $data + } + } +} +puts "match_args a b c : [match_args a b c]" +puts "match_args x y z : [match_args x y z]" +puts "match_args x Y z : [match_args x Y z]" +puts "match_args other blah : [match_args other blah]" + + + + + + + + + + + diff --git a/src/modules/punk-0.1.tm b/src/modules/punk-0.1.tm index 3e6803f..5ffd02f 100644 --- a/src/modules/punk-0.1.tm +++ b/src/modules/punk-0.1.tm @@ -256,13 +256,13 @@ namespace eval punk { } - #called from know_assign/know_dot_assign for lhs of assignment - uplevel 2 to caller's level - #called from know_assign/know_dot_assign for rhs pipelined vars - uplevel 1 to write vars only in 'apply' scope + #called from match_assign/know_dot_assign for lhs of assignment - uplevel 2 to caller's level + #called from match_assign/know_dot_assign for rhs pipelined vars - uplevel 1 to write vars only in 'apply' scope #return a dict with keys result, setvars, unsetvars #TODO - implement cross-binding (as opposed to overwrite/reassignment) when a var appears multiple times in a pattern/multivar #e.g x@0,x@1 will only match if value at positions 0 & 1 is the same (a form of auto-pinning?) #e.g x,x@0 will only match a single element list - proc _multi_assign_result {multivar data args} { + proc _multi_bind_result {multivar data args} { #'ismatch' must always be first element of dict - as we dispatch on ismatch 0 or ismatch 1 set returndict [dict create ismatch 0 result "" setvars {} unsetvars {}] if {![string length $multivar]} { @@ -565,6 +565,9 @@ namespace eval punk { #for punk assignment syntax. punk allows a subset of possible tcl variable names on LHS of match/assignment. set isatom 1 } + + # - should set expected_values in each branch where match_state is not set to 1 + # - setting expected_values when match_state is set to 0 is ok except for performance if {$isatom} { #puts stdout "==>isatom $nm" if {$act in [list "?matchatom-set" "?set"]} { @@ -572,29 +575,34 @@ namespace eval punk { if {$nm eq $val} { lset match_state $i 1 } - } - if {$act eq "?unset"} { - #doesn't make sense for an atom ? + lset expected_values $i [list $nm match $nm] + } elseif {$act eq "?unset"} { + #doesn't make sense for an atom ? - should fail match + lset expected_values $i [list $nm match $nm] + } else { + lset expected_values $i [list $nm unkown $nm] } } elseif {$ispin} { #puts stdout "==>ispin $nm" if {$act in [list "?set" "?matchvar-set"]} { lset var_actions $i 1 matchvar-set #attempt to read - if {![catch {uplevel $lvlup [list set $nm]} result]} { - lset match_state $i [expr {$result eq $val}] - lset expected_values $i [list $nm set $val] - + if {![catch {uplevel $lvlup [list set $nm]} existingval]} { + lset match_state $i [expr {$existingval eq $val}] + lset expected_values $i [list $nm match $existingval] } else { #puts stdout "var ^$nm result:$result vs val:$val" - lset match_state $i 0 - lset expected_values $i [list $nm unknown ?] + #failure is *probably* because var is unset - but could be a read-only var due to read-trace or it could be nonexistant namespace + lset expected_values $i [list $nm failread ""] } } if {$act in [list "?unset" "?matchvar-unset"]} { lset var_actions $i 1 matchvar-unset if {![uplevel $lvlup [list info exists $nm ]]} { - lset match_state $i 1 + 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]]] } } @@ -611,12 +619,14 @@ namespace eval punk { #-------------------------------------------------------------------------- #Variable assignments (set/unset) should only occur down here, and only if we have a match #-------------------------------------------------------------------------- - debug.punk.pipe.var "MATCH_STATE: $match_state" 4 - debug.punk.pipe.var "VARACTIONS2: $var_actions" 5 - set match_count_needed [llength $var_actions] + set match_count [expr [join $match_state +]] ;#expr must be unbraced here + + debug.punk.pipe.var {MATCH_STATE: $match_state count_needed: $match_count_needed vs match_count: $match_count} 4 + debug.punk.pipe.var {VARACTIONS2: $var_actions} 5 + debug.punk.pipe.var {EXPECTED : $expected_values} 4 + #set match_count [>f . foldl 0 [>f . sum .] $match_state] ;#ok method.. but slow compared to expr with join - set match_count [expr [join $match_state +]] #catch {unset v} if {$match_count == $match_count_needed} { #do assignments @@ -643,10 +653,12 @@ namespace eval punk { incr i } } else { + #todo - some way to restrict mismatch info to simple "mismatch" and avoid overhead of verbose message + #e.g for within pipeswitch block where mismatches are expected and the reasons are unimportant set vidx 0 set mismatches [lmap m $match_state v $var_names {expr {$m != 1} ? {[list mismatch $v]} : {[list match $v]}}] set mismatches_display [lmap m $match_state v $var_names {expr {$m != 1} ? {$v} : {[string repeat " " [string length $v]]}}] - set msg "Match error: No match of right hand side for vars in $multivar\n" + set msg "Unmatched: No match of right hand side for vars in $multivar\n" append msg "vars/atoms: $var_names\n" append msg "mismatches: [join $mismatches_display { } ]\n" set i 0 @@ -661,35 +673,52 @@ namespace eval punk { set e $nm } elseif {$varclass == 2} { set type "pinned var" - set e "?" + set e [lindex $expected_values $i 2] } else { set type "var" set e "*" ;# non-atoms and non-pins should always match.. todo - review attempt to set as var instead of array? } - append msg " $type: '$nm' expected: '$e' got '$val'\n" + set lhs_tag "" + if {[lindex $expected_values $i 1] ne "match"} { + set lhs_tag "-[lindex $expected_values $i 1]" + } + append msg " $type: '$nm' LHS$lhs_tag: '$e' vs RHS: '$val'\n" } incr i } - error $msg + #error $msg + dict unset returndict result + dict set returndict mismatch $msg + return $returndict } if {![llength $varspeclist]} { dict set returndict result $data } else { - punk::assert {$i == [llength $varspeclist]} + #punk::assert {$i == [llength $varspeclist]} dict set returndict result $returnval } return $returndict } + + proc _handle_bind_result {d} { + set match_caller [info level 2] + debug.punk.pipe {_handle_bind_result match_caller: $match_caller} 0 + if {![dict exists $d result]} { + uplevel 1 [list 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=\{]*)\.=(.*)} - #know_assign is tailcalled from unknown - uplevel 1 gets to caller level - proc know_assign {multivar e1 fulltail} { - debug.punk.pipe {know_assign '$multivar' '$e1' '$fulltail'} 4 + #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 #can match an integer on lhs with a value # #if {[string is integer -strict $multivar]} { @@ -701,7 +730,7 @@ namespace eval punk { #attempting to allow x=y to begin a pipeline e.g x=y |> string tolower #will stop us from easily assigning an entire pipeline string to x using the 'equals-runon' syntax x=.=something etc |> blah #The tradeoff - if {1} { + if {[llength $fulltail]} { #avoid use of regexp match on each element - or we will unnecessarily force string reps on lists #set firstlast [lmap v $fulltail {lreplace [split $v {}] 1 end-1}] #set firstpipe_posn [lsearch $firstlast {| >}] @@ -719,6 +748,11 @@ namespace eval punk { } #puts stderr "tail len: [llength $fulltail]" #puts stderr "tail-end: [lindex $fulltail end]" + } else { + set firstpipe_posn -1 + set tail [list] + set nextassignment [list] + set nexttail [list] } @@ -728,11 +762,12 @@ namespace eval punk { #space after = if {[llength $tail] == 1} { set val [lindex $tail 0] - set d [_multi_assign_result $multivar $val] - set r [dict get $d result] + set d [_multi_bind_result $multivar $val] + set r [_handle_bind_result $d] set returnval $r } elseif {[llength $tail] == 0} { - _multi_assign_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. #uplevel 1 [list unset $multivar] set returnval "" } else { @@ -752,8 +787,8 @@ namespace eval punk { #ie x=4+1 assigns "4+1" as a string #whereas x=4 + 1 assigns 5 #set commaparts [split $var ,] - set d [_multi_assign_result $multivar $e1] - set r [dict get $d result] + set d [_multi_bind_result $multivar $e1] + set r [_handle_bind_result $d] set returnval $r } else { set is_listbuilder 1 @@ -761,14 +796,20 @@ namespace eval punk { debug.punk.pipe "assigning fulltail [llength $fulltail]" 6 #e1 is not a list - may even be a single char such as double quote. #set result [concat $e1 $fulltail] ;#concat produces a string rep - and strips escaped whitespace e.g \t or\n from e1 and trailing args. - set result [list] - lappend result $e1 - foreach a $fulltail { - lappend result $a - } + + #set result [list] + #lappend result $e1 + #foreach a $fulltail { + # lappend result $a + #} + + #set result [list] + #lappend result $e1 {*}$fulltail + + set result [list $e1 {*}$fulltail] - set d [_multi_assign_result $multivar $result] - set r [dict get $d result] + set d [_multi_bind_result $multivar $result] + set r [_handle_bind_result $d] set returnval $r } @@ -777,9 +818,10 @@ namespace eval punk { if {![llength $nexttail] || $is_listbuilder} { return $returnval } else { - set exectail [concat [list val $returnval] $firstpipe $nexttail] - #uplevel 1 [list punk::know_exec "" "" {*}$exectail] - tailcall punk::know_exec "" "" {*}$exectail + #set exectail [concat [list val $returnval] $firstpipe $nexttail] + set exectail [list val $returnval $firstpipe {*}$nexttail] + #uplevel 1 [list punk::match_exec "" "" {*}$exectail] + tailcall punk::match_exec "" "" {*}$exectail } @@ -911,9 +953,9 @@ namespace eval punk { return 0 } - proc know_exec {initial_returnvarspec e1 args} { + proc match_exec {initial_returnvarspec e1 args} { set fulltail $args - debug.punk.pipe {call know_exec: '$initial_returnvarspec' '$e1' '$fulltail'} 4 + debug.punk.pipe {call match_exec: '$initial_returnvarspec' '$e1' '$fulltail'} 4 debug.punk.pipe.rep {[rep_listname fulltail]} 6 @@ -931,8 +973,8 @@ namespace eval punk { set results [uplevel 1 [list pipematch {*}$nexttail]] debug.punk.pipe {>>> pipematch results: $results} 1 - set d [_multi_assign_result $initial_returnvarspec $results] - set r [dict get $d result] + set d [_multi_bind_result $initial_returnvarspec $results] + set r [_handle_bind_result $d] return $r } @@ -941,11 +983,11 @@ namespace eval punk { 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 - set results [uplevel 1 [list ::punk::know_exec $nextreturnvarspec $nextrhs {*}$nexttail]] + set results [uplevel 1 [list ::punk::match_exec $nextreturnvarspec $nextrhs {*}$nexttail]] debug.punk.pipe {>>> results: $results} 1 - set d [_multi_assign_result $initial_returnvarspec $results] - set r [dict get $d result] + set d [_multi_bind_result $initial_returnvarspec $results] + set r [_handle_bind_result $d] return $r } @@ -953,11 +995,11 @@ 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 - set results [uplevel 1 [list ::punk::know_assign $nextreturnvarspec $nextrhs $nexttail]] + set results [uplevel 1 [list ::punk::match_assign $nextreturnvarspec $nextrhs $nexttail]] debug.punk.pipe {>>> results: $results} 1 - set d [_multi_assign_result $initial_returnvarspec $results] - set r [dict get $d result] + set d [_multi_bind_result $initial_returnvarspec $results] + set r [_handle_bind_result $d] return $r } @@ -1004,12 +1046,12 @@ namespace eval punk { set argslist [list] set argpipespec "" ;#argumentspec e.g a,b,c from prevr:$prevr setvars: $pipedvars" } @@ -1177,26 +1220,22 @@ namespace eval punk { } } foreach {k v} $pipedvars { - #add additionally specified vars and allow overriding of %args% and %data% + #add additionally specified vars and allow overriding of %args% and %data% by not setting them here if {$k in [list "datalist" "data"]} { - #already done + #already potentially overridden continue } #dict set dict_tagval %$k% [list $v] dict set dict_tagval %$k% $v } - debug.punk.pipe.var {dict_tagval: $dict_tagval} 4 - - - #check it's still a valid list? if {!$segment_has_tags} { - debug.punk.pipe.var {[a+ cyan]SEGMENT has no tags[a+]} 7 + #debug.punk.pipe.var {[a+ cyan]SEGMENT has no tags[a+]} 7 #add previous_result as data only if no tags present (data is just list-wrapped previous_result vs args = forward-result treated as already being a list) #set segment_members_filled [concat $segment_members [dict get $dict_tagval %data%]] ;# data flows through by default - not args - because some strings are not valid lists set segment_members_filled $segment_members @@ -1205,6 +1244,7 @@ namespace eval punk { } } else { + debug.punk.pipe.var {dict_tagval: $dict_tagval} 4 set segment_members_filled [list] set idxmem 0 foreach mem $segment_members { @@ -1249,7 +1289,7 @@ namespace eval punk { if {(![llength $segment_members_script_index]) && $segment_op eq ".="} { - #set subresult [uplevel 1 [list ::punk::know_exec $returnvarspec $rhs $segment_members_filled]] + #set subresult [uplevel 1 [list ::punk::match_exec $returnvarspec $rhs $segment_members_filled]] if {[string index $rhs 0] eq "\{"} { if {[llength $segment_members_filled] == 1} { if {[string index $rhs end] eq "\}"} { @@ -1274,8 +1314,8 @@ namespace eval punk { if {![catch {uplevel 1 [list expr $e]} evaluated]} { set forward_result $evaluated - set d [_multi_assign_result $returnvarspec $forward_result] - set r [dict get $d result] + set d [_multi_bind_result $returnvarspec $forward_result] + set r [_handle_bind_result $d] #return $r set segment_result $r } else { @@ -1285,12 +1325,13 @@ namespace eval punk { append msg "expression error: $evaluated" error $msg } - } elseif {([string is double -strict $rhs] || [_is_math_func_prefix $rhs])} { + } elseif {($rhs ne "") && ([string is double -strict $rhs] || [_is_math_func_prefix $rhs])} { + #check of rhs ne "" is important to not waste time with _is_math_func_prefix debug.punk.pipe {evaluating $rhs {*}[lrange $segment_members_filled 1 end] as expression\n due to number or math func immediately following .=} 4 if {![catch {uplevel 1 [list expr $rhs {*}[lrange $segment_members_filled 1 end]]} evaluated]} { set forward_result $evaluated - set d [_multi_assign_result $returnvarspec $forward_result] - set r [dict get $d result] + set d [_multi_bind_result $returnvarspec $forward_result] + set r [_handle_bind_result $d] #return $r set segment_result $r } else { @@ -1310,8 +1351,7 @@ namespace eval punk { #set cmdlist [concat $rhs [lrange $segment_members_filled 1 end]] ;#ok if rhs empty set firstword [lindex $cmdlist 0] - debug.punk.pipe {>>firstword: $firstword returnvarspec:$returnvarspec} 4 - debug.punk.pipe {>>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 #set c1 [string index $firstword 0] #if {$c1 in [list \" "("]} { @@ -1320,11 +1360,11 @@ namespace eval punk { #} #puts stderr ">>cmdlist: $cmdlist" set forward_result [uplevel 1 $cmdlist] - debug.punk.pipe {forward_result: $forward_result} 4 + 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_assign_result $returnvarspec $forward_result] - set r [dict get $d result] + set d [_multi_bind_result $returnvarspec $forward_result] + set r [_handle_bind_result $d] set segment_result $r #puts stderr ">>forward_result: $forward_result segment_result $r" } @@ -1333,7 +1373,7 @@ namespace eval punk { } elseif {$segment_op eq "="} { - set segment_result [uplevel 1 [list ::punk::know_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 set forward_result $segment_result @@ -1384,16 +1424,16 @@ namespace eval punk { set evaluation [apply [list [concat $segmentargnames argsdata] $script ::] {*}$segmentargvals $argsdatalist] } set forward_result $evaluation - set d [_multi_assign_result $returnvarspec $forward_result] - set r [dict get $d result] + set d [_multi_bind_result $returnvarspec $forward_result] + 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_assign_result $returnvarspec $forward_result] - set r [dict get $d result] + set d [_multi_bind_result $returnvarspec $forward_result] + set r [_handle_bind_result $d] set segment_result $r } #the subresult doesn't need to go backwards - as the final assignment can emit the result into a variable @@ -1581,15 +1621,15 @@ namespace eval punk { } set tail [lrange $args 1 end] - #must be tailcall so know_assign runs at same level as the unknown proc - tailcall ::punk::know_assign $varspecs $rhs $tail + #must be tailcall so match_assign runs at same level as the unknown proc + tailcall ::punk::match_assign $varspecs $rhs $tail } #.= must come after = here to ensure it comes before = in the 'unknown' proc #set punk::re_dot_assign {([^=]*)\.=(.*)} know {[regexp $punk::re_dot_assign [lindex $args 0 0] _ varspecs rhs]} { set tail [expr {([lindex $args 0] eq [lindex $args 0 0]) ? [lrange $args 1 end] : [concat [lrange [lindex $args 0] 1 end] [lrange $args 1 end] ] }] - tailcall ::punk::know_exec $varspecs $rhs {*}$tail - #return [uplevel 1 [list ::punk::know_exec $varspecs $rhs {*}$tail]] + tailcall ::punk::match_exec $varspecs $rhs {*}$tail + #return [uplevel 1 [list ::punk::match_exec $varspecs $rhs {*}$tail]] } #ensure == is after = in know sequence know {[regexp {(.*)==(.*)} [lindex $args 0] _ val1 val2]} { @@ -1632,19 +1672,20 @@ namespace eval punk { configure_unknown #if client redefines 'unknown' after package require punk, they must call punk::configure_unknown afterwards. proc pipematch {args} { + 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::know_exec "" "" {*}$arglist] + set cmdlist [list ::punk::match_exec "" "" {*}$arglist] } elseif {$assign eq "="} { - set cmdlist [list ::punk::know_assign "" "" $arglist] + set cmdlist [list ::punk::match_assign "" "" $arglist] } elseif {[regexp $re_dot_assign $assign _ returnvarspecs rhs]} { - set cmdlist [list ::punk::know_exec $returnvarspecs $rhs {*}$arglist] + set cmdlist [list ::punk::match_exec $returnvarspecs $rhs {*}$arglist] } elseif {[regexp $re_assign $assign _ returnvarspecs rhs]} { - set cmdlist [list ::punk::know_assign $returnvarspecs $rhs $arglist] + set cmdlist [list ::punk::match_assign $returnvarspecs $rhs $arglist] } else { set cmdlist $args #return [dict create error [dict create reason [dict create pipematch bad_first_word value $assign pipeline [list pipematch $assign {*}$args]]]] @@ -1655,11 +1696,60 @@ namespace eval punk { debug.punk.pipe {pipematch error $result} 4 return [dict create error [dict create reason $result]] } else { - debug.punk.pipe {pipematch result } + debug.punk.pipe {pipematch result $result } 4 return [dict create ok [dict create result $result]] } + } + + proc pipecase {args} { + 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] + } else { + set cmdlist $args + #return [dict create error [dict create reason [dict create pipematch bad_first_word value $assign pipeline [list pipematch $assign {*}$args]]]] + } + + if {[catch {uplevel 1 $cmdlist} result]} { + return [dict create error [dict create reason $result]] + } else { + tailcall return [dict create ok [dict create result $result]] + } + + } + proc create_pipeswitch_interp {} { + interp create interp_pipeswitch + interp eval interp_pipeswitch { + namespace eval ::punk {} + set ::punk::i_am_slave_interp 1 + } + interp eval interp_pipeswitch { + package require shellfilter + package require punk + foreach d [debug names] { + debug off $d + } + } + } + #we will re-use this interp to evaluate pipeswitch code blocks + if {![info exists ::punk::i_am_slave_interp]} { + create_pipeswitch_interp + } + proc pipeswitch {pipescript} { + uplevel $pipescript } proc ansi+ {args} { variable ansi_disabled @@ -2080,7 +2170,7 @@ namespace eval punk { return $linelist } - # important for know_exec & know_assign + # important for match_exec & match_assign # lineval verbatim|trimmed proc linelist {text {lineval verbatim}} { if {$lineval ni [list verbatim trimmed]} {error "linelist 2nd argument valid values are 'verbatim' or 'trimmed'"} @@ -2224,9 +2314,13 @@ namespace eval punk { } #current interp aliases except those created by pattern package '::p::*' proc aliases {{glob *}} { - set interesting [lmap a [interp aliases ""] {expr {![string match ::p::* $a] ? $a : [continue]}}] - set interesting [lmap a $interesting {expr {![string match *twapi::* $a] ? $a : [continue]}}] - set interesting [lmap a $interesting {expr {![string match *vfs::* $a] ? $a : [continue]}}] + #todo - way to configure and query what aliases are hidden + set interesting [lmap a [interp aliases ""] {expr {![string match ::* $a] ? $a : [continue]}}] + #set interesting [lmap a [interp aliases ""] {expr {![string match ::p::* $a] ? $a : [continue]}}] + set interesting [lmap a $interesting {expr {![string match *twapi::* $a] ? $a : [continue]}}] + set interesting [lmap a $interesting {expr {![string match debug.* $a] ? $a : [continue]}}] + #set interesting [lmap a $interesting {expr {![string match *vfs::* $a] ? $a : [continue]}}] + set matched [lsearch -all -inline $interesting $glob] } proc alias {{aliasorglob ""} args} { @@ -2299,16 +2393,18 @@ namespace eval punk { interp alias {} linedict {} punk::linedict interp alias {} dictline {} punk::dictline + interp alias {} pipeswitch {} punk::pipeswitch + interp alias {} pipecase {} punk::pipecase interp alias {} pipematch {} punk::pipematch proc = {value} { return $value } proc .= {args} { - uplevel 1 [list ::punk::know_exec "" "" {*}$args] + uplevel 1 [list ::punk::match_exec "" "" {*}$args] } - #interp alias {} = {} punk::know_assign "" - #interp alias {} .= {} punk::know_exec "" + #interp alias {} = {} punk::match_assign "" + #interp alias {} .= {} punk::match_exec "" interp alias {} foldl {} struct::list::Lfold #foldl helpers