GenArgParser

# dependency, adapted from the wiki
proc pipe {args} {
    set anonvar ~
    set args [lassign $args body]
    foreach cmd $args {
        if {[string first $anonvar $cmd] >= 0} {
            set body [string map [list $anonvar "\[$body\]"] $cmd]
        } else {
            set body "$cmd \[$body\]"
        }
    }
    set body
}

# example:
# puts [pipe {open /etc/passwd r} \
           {read} \
           {string trim} \
           {split ~ \n} \
           {lindex ~ end} \
           {split ~ :} \
           {lindex ~ 4} \
           {puts}]


# generate arg parsing code to go at the start of a proc
# supports TIP#288 with some extensions, see BNF below
    proc ArgParser {argspec} {
        set name ""
        if {$name ne ""} {
            set name {[lindex [info level -1] 0]}
        }
        #foreach {name argspec} [list $argspec $name] {}
        # parse argspec into segments:
        #  argspec ::= required* | optional* | "args"? | optional* | required*
        #  required ::= name
        #  optional ::= {name default}
        set req_l {}
        set opt_l {}
        set args {}
        set opt_r {}
        set req_r {}
        for {set i 0} {$i < [llength $argspec]} {incr i} {
            set a [lindex $argspec $i]
            if {!($a ne "args" && [llength $a] == 1)} { break }
            lappend req_l $a
        }
        for {} {$i < [llength $argspec]} {incr i} {
            set a [lindex $argspec $i]
            if {[llength $a] == 1} { break }
            lappend opt_l $a
        }
        for {} {$i < [llength $argspec]} {incr i} {
            set a [lindex $argspec $i]
            if {$a ne "args"} { break }
            lappend args $a
        }
        for {} {$i < [llength $argspec]} {incr i} {
            set a [lindex $argspec $i]
            if {[llength $a] == 1} { break }
            lappend opt_r $a
        }
        for {} {$i < [llength $argspec]} {incr i} {
            set a [lindex $argspec $i]
            if {[llength $a] != 1} { break }
            lappend req_r $a
        }
        set opt_r [lreverse $opt_r]
        set req_r [lreverse $req_r]
        if {[llength $args] > 1} {error "args can only occur once!"}
        if {$i != [llength $argspec]} {error "didn't consume whole argspec!"}
        set min_argc [expr {[llength [concat $req_l $req_r]]}]
        debug show {[list $req_l $opt_l $args $opt_r $req_r]}
        set parser [GenArgParser $req_l $opt_l $args $opt_r $req_r]

        # emit code for parsing args:
        set badArgMsg [format {wrong # args: should be "%s"} [concat $name [FormatArgspec $argspec]]]
        return "try {$parser}\
            trap {TCL WRONGARGS} {} {throw {TCL WRONGARGS} [list $badArgMsg]}"
       # sl {
       #     try $parser
       #     trap {TCL WRONGARGS} {} {
       #         throw {TCL WRONGARGS} $badArgMsg
       #     }
       # }
    }

    ;# rl - required left
    ;# ol - optional left
    ;# as - args
    ;# or - optional right
    ;# rr - required right
    proc GenArgParser {rl {ol ""} {as ""} {or ""} {rr ""}} {

        set olnames [lmap x $ol      {lindex $x 0}]
        set ollist  [lmap x $olnames {string cat \$ [list $x]}]
        set ollist  [join $ollist \ ]

        set ornames [lmap x $or      {lindex $x 0}]
        set orlist  [lmap x $ornames {string cat \$ [list $x]}]
        set orlist  [join $orlist \ ]

        set arglen [llength [concat {*}$rl {*}$rr]]
        if {$ol eq "" && $or eq "" && $as eq ""} {
            set op !=
        } else {
            set op <
        }
        set precheck [subst -noc  {if {[llength \$args] $op $arglen} {throw {TCL WRONGARGS} ""}}]

        set script {}
        lappend script     [subst       {set args}                                          ]

        if {$rl ne ""} {
            lappend script [subst       {lassign ~ $rl}                                     ]
        }

        if {$rr ne ""} {
            lappend script [subst       {lreverse}                                          ]
            lappend script [subst       {lassign ~ $rr}                                     ]
            lappend script [subst       {lreverse}                                          ]
        }

        if {$ol ne ""} {
            if {$or eq "" && $as eq ""} {
                lappend script [subst   {apply {{$ol} {list $ollist}} {*}~}                 ]
            } else {
                lappend script [subst   {apply {{$ol args} {list $ollist {*}\$args}} {*}~}  ]

            }
            lappend script [subst       {lassign ~ $olnames}                                ]
        }

        if {$or ne ""} {
            lappend script [subst       {lreverse}                                          ]
            if {$as eq ""} {
                lappend script [subst   {apply {{$or} {list $orlist}} {*}~}                 ]
            } else {
                lappend script [subst   {apply {{$or args} {list $orlist {*}\$args}} {*}~}  ]
            }
            lappend script [subst       {lassign ~ $ornames}                                ]
            lappend script [subst       {lreverse}                                          ]
        }
        if {$as ne ""} {
            lappend script [subst       {set args}                                          ]
        } else {
            lappend script [subst       {if {~ ne ""} {throw {TCL WRONGARGS} ""};unset args}]
        }
        debug log {script is: $script}
        return "$precheck;[pipe {*}$script]"
    }