Parse Parenthesis

The problem often comes up "I have a string with parentheses, I want to perform (some operation) on it, how do I do it?" A lot of time is spent playing with regexps, which can't really ever work. I decided to try to write a canonical parser for parenthesised expressions. I hope others will suggest better models, and that in the end we will have an implementation worthy of going into tcllib. CMcC 26Jun2012

There's also a Parse Quote equivalent.

# parpar - parse parenthesised strings
#
# returns a paired list containing parenthesis depth of string and string
# example: [parpar "zero(one)((two))"] -> "0 zero 1 one 2 two"

proc parpar {str {l (} {r )}} {
    set depth 0
    set result {}
    set skip 0
    foreach c [split $str ""] {
        if {$c eq "\\"} {
            append run $c
            incr skip
        } elseif {$skip} {
            append run $c
            set skip 0
            continue
        }

        if {$c eq $l} {
            # OPEN
            if {[info exists run]} {
                lappend result $depth $run
                unset run
            }
            incr depth
        } elseif {$c eq $r} {
            # CLOSE
            if {$depth > 0} {
                if {[info exists run]} {
                    lappend result $depth $run
                    unset run
                }
            } else {
                error "parpar unbalanced '$l$r' in '$str'"
            }
            incr depth -1
        } else {
            append run $c
        }
    }
    if {$depth > 0} {
        error "parpar dangling '$l' in '$str'"
    }
    if {[info exists run]} {
        lappend result $depth $run
    }
    return $result
}

if {[info exists argv0] && $argv0 eq [info script]} {
    package require tcltest
    namespace import ::tcltest::*
    verbose {pass fail error}
    set count 0
    foreach {str result} {
        () ""
        (()) ""
        (moop) "1 moop"
        ((moop)) "2 moop"
        "zero(one)((two))" "0 zero 1 one 2 two"
        "pebbles (fred wilma) bambam (barney betty)" "0 {pebbles } 1 {fred wilma} 0 { bambam } 1 {barney betty}"
        "zero (one (two (three (four (five)))))" "0 {zero } 1 {one } 2 {two } 3 {three } 4 {four } 5 five"
        {\(skip\)} "0 \\(skip\\)"
    } {
        test parpar-[incr count] {} -body {
            parpar $str
        } -result $result
    }

    foreach {str} {
        "(((()"
        ")))"
    } {
        test parpar-[incr count] {} -body {
            parpar $str
        } -match glob -result * -returnCodes 1
    }
}