@ -320,6 +320,84 @@ namespace eval punk {
proc splitstrposn_nonzero {s p} { proc splitstrposn_nonzero {s p} {
scan $s %${p}s%s scan $s %${p}s%s
} }
proc _split_patterns {varspecs} {
set varlist [list]
set var_terminals [list "@" "/" "#"]
#except when prefixed directly by pin classifier ^
set protect_terminals [list "^"] ;# e.g sequence ^#
#also - an atom usually doesn't need the / as a terminal - because it can't match a missing element unless it's empty string
#ie the one usecase is '/n to match either empty string or missing item at position n. For this one usecase - we miss the capability to atom match paths/urls .. '/usr/local/et'
set in_brackets 0
set in_atom 0
#set varspecs [string trimleft $varspecs ,]
set token ""
#if {[string first "," $varspecs] <0} {
# return $varspecs
#}
set first_term -1
set token_index 0 ;#index of terminal char within each token
set prevc ""
set char_index 0
foreach c [split $varspecs ""] {
if {$in_atom} {
append token $c
#set nextc [lindex $chars $char_index+1]
if {$c eq "'"} {
set in_atom 0
}
} elseif {$in_brackets} {
append token $c
if {$c eq ")"} {
set in_brackets 0
}
} else {
if {$c eq ","} {
#lappend varlist [splitstrposn $token $first_term]
set var $token
set spec ""
if {$first_term > 0} {
lassign [scan $token %${first_term}s%s] var spec
} else {
if {$first_term == 0} {
set var ""
set spec $token
}
}
lappend varlist [list $var $spec]
set token ""
set token_index -1 ;#reduce by 1 because , not included in next token
set first_term -1
} else {
append token $c
if {$first_term == -1 && (($c in $var_terminals) && ($prevc ni $protect_terminals))} {
set first_term $token_index
} elseif {$c eq "'"} {
set in_atom 1
} elseif {$c eq "("} {
set in_brackets 1
}
}
}
set prevc $c
incr token_index
incr char_index
}
if {[string length $token]} {
#lappend varlist [splitstrposn $token $first_term]
set var $token
set spec ""
if {$first_term > 0} {
lassign [scan $token %${first_term}s%s] var spec
} else {
if {$first_term == 0} {
set var ""
set spec $token
}
}
lappend varlist [list $var $spec]
}
return $varlist
}
proc _split_var_key_at_unbracketed_comma {varspecs} { proc _split_var_key_at_unbracketed_comma {varspecs} {
set varlist [list] set varlist [list]
set var_terminals [list "@" "/" "#"] set var_terminals [list "@" "/" "#"]
@ -827,7 +905,9 @@ namespace eval punk {
#but also for list and dict subelement access #but also for list and dict subelement access
#/ normally indicates some sort of hierarchical separation - (e.g in filesytems) #/ normally indicates some sort of hierarchical separation - (e.g in filesytems)
#so / will indicate subelements e.g @0/1 for lindex $list 0 1 #so / will indicate subelements e.g @0/1 for lindex $list 0 1
set valsource_key_list [_split_var_key_at_unbracketed_comma $multivar] #set valsource_key_list [_split_var_key_at_unbracketed_comma $multivar]
set valsource_key_list [_split_patterns $multivar]
#first classify into var_returntype of either "pipeline" or "segment" #first classify into var_returntype of either "pipeline" or "segment"
#segment returntype is indicated by leading % #segment returntype is indicated by leading %
@ -1288,6 +1368,9 @@ namespace eval punk {
if {$isatom} { if {$isatom} {
#puts stdout "==>isatom $lhsspec" #puts stdout "==>isatom $lhsspec"
set lhs [string range $lhsspec 1 end] set lhs [string range $lhsspec 1 end]
if {[string index $lhs end] eq "'"} {
set lhs [string range $lhs 0 end-1]
}
if {$act eq "?set"} { if {$act eq "?set"} {
lset var_actions $i 1 matchatom-set lset var_actions $i 1 matchatom-set
if {$lhs eq $val} { if {$lhs eq $val} {
