tcl grammar

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