@ -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 match _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 rhs pipelined vars - uplevel 1 to write vars only in 'apply' scope
#return a dict with keys result, setvars, unsetvars #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 #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@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 #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 #'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 {}] set returndict [dict create ismatch 0 result "" setvars {} unsetvars {}]
if {![string length $multivar]} { 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. #for punk assignment syntax. punk allows a subset of possible tcl variable names on LHS of match/assignment.
set isatom 1 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} { if {$isatom} {
#puts stdout "==>isatom $nm" #puts stdout "==>isatom $nm"
if {$act in [list "?matchatom-set" "?set"]} { if {$act in [list "?matchatom-set" "?set"]} {
@ -572,29 +575,34 @@ namespace eval punk {
if {$nm eq $val} { if {$nm eq $val} {
lset match_state $i 1 lset match_state $i 1
} }
} lset expected_values $i [list $nm match $nm]
if {$act eq "?unset"} { } elseif {$act eq "?unset"} {
#doesn't make sense for an atom ? #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} { } elseif {$ispin} {
#puts stdout "==>ispin $nm" #puts stdout "==>ispin $nm"
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]} result]} { if {![catch {uplevel $lvlup [list set $nm]} existingval]} {
lset match_state $i [expr {$result eq $val}] lset match_state $i [expr {$existingval eq $val}]
lset expected_values $i [list $nm set $val] lset expected_values $i [list $nm match $existingval]
} else { } else {
#puts stdout "var ^$nm result:$result vs val:$val" #puts stdout "var ^$nm result:$result vs val:$val"
lset match_state $i 0 #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 unknown ? ] lset expected_values $i [list $nm failread "" ]
} }
} }
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 ]]} { 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 #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_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 [>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} #catch {unset v}
if {$match_count == $match_count_needed} { if {$match_count == $match_count_needed} {
#do assignments #do assignments
@ -643,10 +653,12 @@ namespace eval punk {
incr i incr i
} }
} else { } 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 vidx 0
set mismatches [lmap m $match_state v $var_names {expr {$m != 1} ? {[list mismatch $v]} : {[list match $v]}}] 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 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 "vars/atoms: $var_names\n"
append msg "mismatches: [join $mismatches_display { } ]\n" append msg "mismatches: [join $mismatches_display { } ]\n"
set i 0 set i 0
@ -661,35 +673,52 @@ namespace eval punk {
set e $nm set e $nm
} elseif {$varclass == 2} { } elseif {$varclass == 2} {
set type "pinned var" set type "pinned var"
set e "?" set e [lindex $expected_values $i 2]
} else { } else {
set type "var" set type "var"
set e "*" ;# non-atoms and non-pins should always match.. todo - review attempt to set as var instead of array? 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 incr i
} }
error $msg #error $msg
dict unset returndict result
dict set returndict mismatch $msg
return $returndict
} }
if {![llength $varspeclist]} { if {![llength $varspeclist]} {
dict set returndict result $data dict set returndict result $data
} else { } else {
punk::assert {$i == [llength $varspeclist]} # punk::assert {$i == [llength $varspeclist]}
dict set returndict result $returnval dict set returndict result $returnval
} }
return $returndict 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 #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}([^\r\n=]*)=(.*)}
variable re_dot_assign {^([^\r\n=\{]*)\.=(.*)} variable re_dot_assign {^([^\r\n=\{]*)\.=(.*)}
#know_assign is tailcalled from unknown - uplevel 1 gets to caller level #match _assign is tailcalled from unknown - uplevel 1 gets to caller level
proc know_assign {multivar e1 fulltail} { proc match _assign {multivar e1 fulltail} {
debug.punk.pipe {know_assign '$multivar' '$e1' '$fulltail'} 4 debug.punk.pipe {match _assign '$multivar' '$e1' '$fulltail'} 4
#can match an integer on lhs with a value #can match an integer on lhs with a value
# #
#if {[string is integer -strict $multivar]} { #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 #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 #will stop us from easily assigning an entire pipeline string to x using the 'equals-runon' syntax x=.=something etc |> blah
#The tradeoff #The tradeoff
if {1 } { if {[llength $fulltail] } {
#avoid use of regexp match on each element - or we will unnecessarily force string reps on lists #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 firstlast [lmap v $fulltail {lreplace [split $v {}] 1 end-1}]
#set firstpipe_posn [lsearch $firstlast {| >}] #set firstpipe_posn [lsearch $firstlast {| >}]
@ -719,6 +748,11 @@ namespace eval punk {
} }
#puts stderr "tail len: [llength $fulltail]" #puts stderr "tail len: [llength $fulltail]"
#puts stderr "tail-end: [lindex $fulltail end]" #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 = #space after =
if {[llength $tail] == 1} { if {[llength $tail] == 1} {
set val [lindex $tail 0] set val [lindex $tail 0]
set d [_multi_assign _result $multivar $val] set d [_multi_bind _result $multivar $val]
set r [dict get $d result ] set r [_handle_bind_result $d ]
set returnval $r set returnval $r
} elseif {[llength $tail] == 0} { } 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] #uplevel 1 [list unset $multivar]
set returnval "" set returnval ""
} else { } else {
@ -752,8 +787,8 @@ namespace eval punk {
#ie x=4+1 assigns "4+1" as a string #ie x=4+1 assigns "4+1" as a string
#whereas x=4 + 1 assigns 5 #whereas x=4 + 1 assigns 5
#set commaparts [split $var ,] #set commaparts [split $var ,]
set d [_multi_assign _result $multivar $e1] set d [_multi_bind _result $multivar $e1]
set r [dict get $d result ] set r [_handle_bind_result $d ]
set returnval $r set returnval $r
} else { } else {
set is_listbuilder 1 set is_listbuilder 1
@ -761,14 +796,20 @@ namespace eval punk {
debug.punk.pipe "assigning fulltail [llength $fulltail]" 6 debug.punk.pipe "assigning fulltail [llength $fulltail]" 6
#e1 is not a list - may even be a single char such as double quote. #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 [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 #set result [list]
foreach a $fulltail { #lappend result $e1
lappend result $a #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 d [_multi_bind _result $multivar $result]
set r [dict get $d result] set r [_handle_bind_result $d ]
set returnval $r set returnval $r
} }
@ -777,9 +818,10 @@ namespace eval punk {
if {![llength $nexttail] || $is_listbuilder} { if {![llength $nexttail] || $is_listbuilder} {
return $returnval return $returnval
} else { } else {
set exectail [concat [list val $returnval] $firstpipe $nexttail] #set exectail [concat [list val $returnval] $firstpipe $nexttail]
#uplevel 1 [list punk::know_exec "" "" {*}$exectail] set exectail [list val $returnval $firstpipe {*}$nexttail]
tailcall punk::know_exec "" "" {*}$exectail #uplevel 1 [list punk::match_exec "" "" {*}$exectail]
tailcall punk::match_exec "" "" {*}$exectail
} }
@ -911,9 +953,9 @@ namespace eval punk {
return 0 return 0
} }
proc know _exec {initial_returnvarspec e1 args} { proc match _exec {initial_returnvarspec e1 args} {
set fulltail $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 debug.punk.pipe.rep {[rep_listname fulltail]} 6
@ -931,8 +973,8 @@ namespace eval punk {
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
set d [_multi_assign _result $initial_returnvarspec $results] set d [_multi_bind _result $initial_returnvarspec $results]
set r [dict get $d result ] set r [_handle_bind_result $d ]
return $r return $r
} }
@ -941,11 +983,11 @@ namespace eval punk {
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} 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 debug.punk.pipe {>>> results: $results} 1
set d [_multi_assign _result $initial_returnvarspec $results] set d [_multi_bind _result $initial_returnvarspec $results]
set r [dict get $d result ] set r [_handle_bind_result $d ]
return $r return $r
} }
@ -953,11 +995,11 @@ 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} 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 debug.punk.pipe {>>> results: $results} 1
set d [_multi_assign _result $initial_returnvarspec $results] set d [_multi_bind _result $initial_returnvarspec $results]
set r [dict get $d result ] set r [_handle_bind_result $d ]
return $r return $r
} }
@ -1004,12 +1046,12 @@ namespace eval punk {
set argslist [list] set argslist [list]
set argpipespec "" ;#argumentspec e.g a,b,c from <a,b,c| 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 debug.punk.pipe.args {argpipespec: $argpipespec argslist: $argslist} 6
if {[llength $argslist]} { if {[llength $argslist]} {
set d [apply {{mv res} { set d [apply {{mv res} {
punk::_multi_assign _result $mv $res -levelup 1 punk::_multi_bind _result $mv $res -levelup 1
}} $argpipespec $argslist] }} $argpipespec $argslist]
set r [_handle_bind_result $d]
set setvars [dict get $d setvars] set setvars [dict get $d setvars]
debug.punk.pipe.args "<| setvars: $setvars" 4 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. #check the varspecs within the input piper even if no %varname% tags present.
# - data and/or args may have been manipulated # - data and/or args may have been manipulated
set d [apply {{mv res} { 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] }} $pipespec($i,in) $prevr]
set r [_handle_bind_result $d]
set pipedvars [dict get $d setvars] set pipedvars [dict get $d setvars]
#puts stdout "inpipespec:|$pipespec($i,in)> prevr:$prevr setvars: $pipedvars" #puts stdout "inpipespec:|$pipespec($i,in)> prevr:$prevr setvars: $pipedvars"
} }
@ -1177,26 +1220,22 @@ namespace eval punk {
} }
} }
foreach {k v} $pipedvars { 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"]} { if {$k in [list "datalist" "data"]} {
#already done #already potentially overridden
continue continue
} }
#dict set dict_tagval %$k% [list $v] #dict set dict_tagval %$k% [list $v]
dict set dict_tagval %$k% $v dict set dict_tagval %$k% $v
} }
debug.punk.pipe.var {dict_tagval: $dict_tagval} 4
#check it's still a valid list? #check it's still a valid list?
if {!$segment_has_tags} { 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) #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 [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 set segment_members_filled $segment_members
@ -1205,6 +1244,7 @@ namespace eval punk {
} }
} else { } else {
debug.punk.pipe.var {dict_tagval: $dict_tagval} 4
set segment_members_filled [list] set segment_members_filled [list]
set idxmem 0 set idxmem 0
foreach mem $segment_members { foreach mem $segment_members {
@ -1249,7 +1289,7 @@ namespace eval punk {
if {(![llength $segment_members_script_index]) && $segment_op eq ".="} { 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 {[string index $rhs 0] eq "\{"} {
if {[llength $segment_members_filled] == 1} { if {[llength $segment_members_filled] == 1} {
if {[string index $rhs end] eq "\}"} { if {[string index $rhs end] eq "\}"} {
@ -1274,8 +1314,8 @@ namespace eval punk {
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_assign _result $returnvarspec $forward_result] set d [_multi_bind _result $returnvarspec $forward_result]
set r [dict get $d result ] set r [_handle_bind_result $d ]
#return $r #return $r
set segment_result $r set segment_result $r
} else { } else {
@ -1285,12 +1325,13 @@ namespace eval punk {
append msg "expression error: $evaluated" append msg "expression error: $evaluated"
error $msg 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 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]} { if {![catch {uplevel 1 [list expr $rhs {*}[lrange $segment_members_filled 1 end]]} evaluated]} {
set forward_result $evaluated set forward_result $evaluated
set d [_multi_assign _result $returnvarspec $forward_result] set d [_multi_bind _result $returnvarspec $forward_result]
set r [dict get $d result ] set r [_handle_bind_result $d ]
#return $r #return $r
set segment_result $r set segment_result $r
} else { } else {
@ -1310,8 +1351,7 @@ namespace eval punk {
#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] set firstword [lindex $cmdlist 0]
debug.punk.pipe {>>firstword: $firstword returnvarspec:$returnvarspec} 4 debug.punk.pipe {>>firstword: $firstword bindingspec:$returnvarspec >>cmdlist([llength $cmdlist]: $cmdlist)} 4
debug.punk.pipe {>>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] #set c1 [string index $firstword 0]
#if {$c1 in [list \" "("]} { #if {$c1 in [list \" "("]} {
@ -1320,11 +1360,11 @@ namespace eval punk {
#} #}
#puts stderr ">>cmdlist: $cmdlist" #puts stderr ">>cmdlist: $cmdlist"
set forward_result [uplevel 1 $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 debug.punk.pipe.rep {[a+ yellow bold]forward_result REP: [rep $forward_result][a+]} 4
set d [_multi_assign _result $returnvarspec $forward_result] set d [_multi_bind _result $returnvarspec $forward_result]
set r [dict get $d result ] 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"
} }
@ -1333,7 +1373,7 @@ namespace eval punk {
} elseif {$segment_op eq "="} { } 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 #review
set forward_result $segment_result set forward_result $segment_result
@ -1384,16 +1424,16 @@ namespace eval punk {
set evaluation [apply [list [concat $segmentargnames argsdata] $script ::] {*}$segmentargvals $argsdatalist] set evaluation [apply [list [concat $segmentargnames argsdata] $script ::] {*}$segmentargvals $argsdatalist]
} }
set forward_result $evaluation set forward_result $evaluation
set d [_multi_assign _result $returnvarspec $forward_result] set d [_multi_bind _result $returnvarspec $forward_result]
set r [dict get $d result ] 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]] set forward_result [uplevel 1 [concat $rhs $segment_members_filled]]
set d [_multi_assign _result $returnvarspec $forward_result] set d [_multi_bind _result $returnvarspec $forward_result]
set r [dict get $d result ] set r [_handle_bind_result $d ]
set segment_result $r set segment_result $r
} }
#the subresult doesn't need to go backwards - as the final assignment can emit the result into a variable #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] set tail [lrange $args 1 end]
#must be tailcall so know _assign runs at same level as the unknown proc #must be tailcall so match _assign runs at same level as the unknown proc
tailcall ::punk::know _assign $varspecs $rhs $tail tailcall ::punk::match _assign $varspecs $rhs $tail
} }
#.= must come after = here to ensure it comes before = in the 'unknown' proc #.= must come after = here to ensure it comes before = in the 'unknown' proc
#set punk::re_dot_assign {([^=]*)\.=(.*)} #set punk::re_dot_assign {([^=]*)\.=(.*)}
know {[regexp $punk::re_dot_assign [lindex $args 0 0] _ varspecs rhs]} { 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] ] }] 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 tailcall ::punk::match _exec $varspecs $rhs {*}$tail
#return [uplevel 1 [list ::punk::know _exec $varspecs $rhs {*}$tail]] #return [uplevel 1 [list ::punk::match _exec $varspecs $rhs {*}$tail]]
} }
#ensure == is after = in know sequence #ensure == is after = in know sequence
know {[regexp {(.*)==(.*)} [lindex $args 0] _ val1 val2]} { know {[regexp {(.*)==(.*)} [lindex $args 0] _ val1 val2]} {
@ -1632,19 +1672,20 @@ namespace eval punk {
configure_unknown configure_unknown
#if client redefines 'unknown' after package require punk, they must call punk::configure_unknown afterwards. #if client redefines 'unknown' after package require punk, they must call punk::configure_unknown afterwards.
proc pipematch {args} { proc pipematch {args} {
debug.punk.pipe {pipematch level [info level] levelinfo [info level 0]} 2
variable re_dot_assign variable re_dot_assign
variable re_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 {$assign eq ".="} {
set cmdlist [list ::punk::know _exec "" "" {*}$arglist] set cmdlist [list ::punk::match _exec "" "" {*}$arglist]
} elseif {$assign eq "="} { } 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]} { } 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]} { } 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 { } 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]]]] #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 debug.punk.pipe {pipematch error $result} 4
return [dict create error [dict create reason $result]] return [dict create error [dict create reason $result]]
} else { } else {
debug.punk.pipe {pipematch result } debug.punk.pipe {pipematch result $result } 4
return [dict create ok [dict create result $result]] 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} { proc ansi+ {args} {
variable ansi_disabled variable ansi_disabled
@ -2080,7 +2170,7 @@ namespace eval punk {
return $linelist return $linelist
} }
# important for know_exec & know _assign # important for match_exec & match _assign
# lineval verbatim|trimmed # lineval verbatim|trimmed
proc linelist {text {lineval verbatim}} { proc linelist {text {lineval verbatim}} {
if {$lineval ni [list verbatim trimmed]} {error "linelist 2nd argument valid values are 'verbatim' or 'trimmed'"} 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::*' #current interp aliases except those created by pattern package '::p::*'
proc aliases {{glob *}} { 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 $interesting {expr {![string match *twapi::* $a] ? $a : [continue]}}] set interesting [lmap a [interp aliases ""] {expr {![string match ::* $a] ? $a : [continue]}}]
set interesting [lmap a $interesting {expr {![string match *vfs::* $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] set matched [lsearch -all -inline $interesting $glob]
} }
proc alias {{aliasorglob ""} args} { proc alias {{aliasorglob ""} args} {
@ -2299,16 +2393,18 @@ namespace eval punk {
interp alias {} linedict {} punk::linedict interp alias {} linedict {} punk::linedict
interp alias {} dictline {} punk::dictline interp alias {} dictline {} punk::dictline
interp alias {} pipeswitch {} punk::pipeswitch
interp alias {} pipecase {} punk::pipecase
interp alias {} pipematch {} punk::pipematch interp alias {} pipematch {} punk::pipematch
proc = {value} { proc = {value} {
return $value return $value
} }
proc .= {args} { proc .= {args} {
uplevel 1 [list ::punk::know _exec "" "" {*}$args] uplevel 1 [list ::punk::match _exec "" "" {*}$args]
} }
#interp alias {} = {} punk::know _assign "" #interp alias {} = {} punk::match _assign ""
#interp alias {} .= {} punk::know _exec "" #interp alias {} .= {} punk::match _exec ""
interp alias {} foldl {} struct::list::Lfold interp alias {} foldl {} struct::list::Lfold
#foldl helpers #foldl helpers
