grammar Tcl {
rule TOP {
<statement>+
}
token statement {
<function> || \n
}
token function {
^^\h*
[<block-string> | <variable> | <quoted-string> | <nested-function> | <token-string>]
[\h+[<block-string> | <variable> | <quoted-string> | <nested-function> | <token-string>]]*
\h*$$
}
token variable {
(['$' [\w+ || '{' .+? '}']]
|
[['$' || '@'] [\w+ || '{' .+? '}'] '(' .+? ')'])
}
token quoted-string {
["'" .+? "'"] || ['"' .+? '"']
}
token token-string {
([<nested-function> | <variable> | <-[\s\[\]\{\}]>]+)
}
token nested-function {
<!before \\>'['
[<block-string> | <variable> | <quoted-string> | <nested-function> | <token-string>]
[\h+[<block-string> | <variable> | <quoted-string> | <nested-function> | <token-string>]]*
<!before \\>']'
}
token block-string {
<!before \\>'{' [<.block-string> || \n || .]+? <!before \\>'}'
}
}
sub parse-tcl(Tcl $node-list) {
#`[my @_nodes = gather for $node-list<statement>».<function> -> $node {
take $node.chunks.pairs if $node.chunks.Str !~~ any [/^'~'\s*$/, /^$/]
};
my @nodes;]
for $node-list<statement> -> $s {
if $s.Str !~~ /^^\s*$$/ {
say $s
}
}
#`[
for @_nodes -> $_node {
push @nodes: [];
for ($_node.list».value).grep(*.key ne "~") -> $node {
push (@nodes.tail): [
$node.key,
$node.value
]
}
}]
#say @nodes.perl
}
my $code = Tcl.parse: '
set a 1
set b 2
set c [expr $a + $b]
puts $a
puts $b
puts [expr $c - [expr $a * $b]]
set l1 [list 1 2 3]
if {$a eq 1} {
puts "a is 1"
}
if {$b eq 1} {
puts "b is 1"
} elsif {$bg eq 2} {
puts "b is 2"
} else {
puts idk
}
foreach i $li {
puts $l
puts { banana }
}
for {set i 1} {$i < [llength $l1]} {incr $i} {
puts [lindex $l1 $i]
}
switch -- $c {
1 {
puts "c is 1"
}
2 {
puts "c is 2"
}
3 {
puts "c is 3"
}
default {
puts idk
}
}
'.trim;
#`[
for $code<statement> {
say gather for .<function>.chunks -> $i {
take $i.kv if $i.kv.Str !~~ any [/^'~ '$/, /^$/]
}
}]
parse-tcl $code
