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

pipeswitch/pipecase implementation + adhoc testscript tests/pipeswitch.tcl

master
Julian Noble 1 year ago
parent
64d73031c7
commit
36e271674c
2 changed files with 265 additions and 93 deletions
Whitespace
Show all changes Ignore whitespace when comparing lines Ignore changes in amount of whitespace Ignore changes in whitespace at EOL
Split View
Diff Options
Show Stats Download Patch File Download Diff File
  1. 76
      scriptlib/tests/pipeswitch.tcl
  2. 278
      src/modules/punk-0.1.tm

76
scriptlib/tests/pipeswitch.tcl
Unescape View File

@ -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]"

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

@ -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
} 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 d [_multi_assign_result $multivar $result]
set r [dict get $d result]
#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_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 <a,b,c|
}
debug.punk.pipe.args {argpipe position: $apipe_posn} 6
debug.punk.pipe.args {argpipespec: $argpipespec argslist: $argslist} 6
if {[llength $argslist]} {
set d [apply {{mv res} {
punk::_multi_assign_result $mv $res -levelup 1
punk::_multi_bind_result $mv $res -levelup 1
}} $argpipespec $argslist]
set r [_handle_bind_result $d]
set setvars [dict get $d setvars]
debug.punk.pipe.args "<| setvars: $setvars" 4
@ -1151,8 +1193,9 @@ namespace eval punk {
#check the varspecs within the input piper even if no %varname% tags present.
# - data and/or args may have been manipulated
set d [apply {{mv res} {
punk::_multi_assign_result $mv $res -levelup 1
punk::_multi_bind_result $mv $res -levelup 1
}} $pipespec($i,in) $prevr]
set r [_handle_bind_result $d]
set pipedvars [dict get $d setvars]
#puts stdout "inpipespec:|$pipespec($i,in)> 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]}}]
#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 *vfs::* $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

Write Preview
Loading…
Cancel
Save