procx foo {a {b 0} {c -default 0} {d 0 -flagval {d 1}} {e 0}} { list $a -- $b -- $c -- $d -- $e }

foo A
foo A B
foo A B C
foo A B C -d
foo A B C E


procx process {
   {loglvl -default 3
           -name lvl -flagvals {q 0 v 9} }
   {type -default "snafu" -flags {foo bar} }
   args
} { list lvl $loglvl -- type $type -- args $args }

process la la la
process -foo
process -lvl 42
process -v
process -q -- -bar goes in args


procx testrep {{opt -default 42 -name o} val} { tcl::unsupported::representation $val }

testrep [expr {-42}]
testrep -- [expr {-42}]
testrep -o 0 [expr {-42}]
testrep -o 0 -- [expr {-42}]


procx justsick {
   {arg1 -flags {foo bar} -name baz -list 2 -default none }
   {arg2 none}
   {arg3 -flags {foo bar baz} }
   args
   {arg4 -list 2}
} { 
   list $arg1 -- $arg2 -- $arg3 -- $args -- $arg4
}

justsick -baz -baz -baz
justsick -baz -baz -baz -baz
justsick -baz -baz -baz -baz -baz
justsick -baz -baz -baz -baz -baz -baz
justsick -baz -baz -baz -baz -baz -baz -baz
justsick -baz -baz -baz -baz -baz -baz -baz -baz
justsick -baz -baz -baz -baz -baz -baz -baz -baz -baz 
justsick -baz -baz -baz -baz -baz -baz -baz -baz -baz -baz

namespace eval procx {
   proc procx {name params body} {
      set cache {}; set allnames {}; set upvars {}; set arrays {}
      set group_args  [dict create]; # formal argnames with options
      set group_names [dict create]; # option names with description
      set group_minArgs 0          ; # number of required arguments in group
      set total_minArgs 0          ; # total number of required arguments
      # compatible procs cannot have reqd arg after dflted, nor named arguments:
      set iscompatible 1; set proc_has_def 0; set proc_has_args 0
      
      foreach argspec $params {
         set argspec [lassign $argspec argname]; # extract argname
         # initialize option container and argspec state:
         set argopts {}; set listlen 0; set nameset 0
         set defval {}; set defset 0; set argtype ""

         if {$argname eq "args"} {
            if {$proc_has_args} { error "multiple arguments named `args'" }
            set proc_has_args 1 ; # will be added to proc-signature as last one.
            if {[llength $argspec]} { error "no flags or default allowed for `args'" }
            set minArgs 0; # "args" auto-defaults to {}
         } else {
            if {$proc_has_args} { set iscompatible 0 }; # anything after args
            # canonicalize argspec:
            if {[llength $argspec] & 1} {
               set argspec [linsert $argspec 0 "-default"]
            }; set minArgs -1 ;# not yet decided

            # sort out options into option groups:
            foreach {o v} $argspec {
               switch -exact -- $o {
                  "-default" - "-def" - "-d" {
                     if {$defset && $defval ne $v} {
                        error "conflicting defaults for `$argname'"
                     }; set defval $v; set defset 1; set minArgs 0
                  }
                  "-list" - "-l" {
                     if {$listlen && $listlen != $v} {
                        error "conflicting -list options for `$argname'"
                     } elseif {$v <= 0} { error "-list arg must be positive" }
                     set listlen $v; set iscompatible 0
                  }
                  "-upvar" - "-u" {
                     if {$argtype ne ""} {
                        error "conflicting types: $o versus $argtype"
                     }; lappend upvars [list $argname] $v; set argtype "upvar"
                  }
                  "-bool" - "-boolean" - "-b" {;# boolean option names
                     if {[llength $v]} {
                        # boolean implies 0 as default. value is 1 for all aliases.
                        if {$defset && $defval ne 0} {
                           error "conflicting defaults for `$argname'"
                        }; set defval "0"; set defset 1; set minArgs 0
                        foreach f $v {
                           if {[dict exists group_names "-$f"]} {
                              error "duplicate option name within group"
                           }; dict set group_names "-$f" [list $argname 1 1]
                        }; set nameset 1; set iscompatible 0
                     }
                  }
                  "-flags" - "-flag" - "-f" {;# option names are their own values
                     if {[llength $v]} {
                        if {$minArgs!=0} { set minArgs 1 }
                        foreach f $v {
                           if {[dict exists group_names "-$f"]} {
                              error "duplicate option name within group"
                           }; dict set group_names "-$f" [list $argname 1 $f]
                        }; set nameset 1; set iscompatible 0
                     }
                  }
                  "-flagvals" - "-flagval" - "-fv" {;# option names mapped to values
                     if {[llength $v]} {
                        if {$minArgs!=0} { set minArgs 1 }
                        foreach {f fv} $v {
                           if {[dict exists group_names "-$f"]} {
                              error "duplicate option name within group"
                           }; dict set group_names "-$f" [list $argname 1 $fv]
                        }; set nameset 1; set iscompatible 0
                     }
                  }
                  "-names" - "-name" - "-n" {;# option names taking >0 argument(s)
                     if {[llength $v]} {
                        foreach f $v {
                           if {[dict exists group_names "-$f"]} {
                              error "duplicate option name within group"
                           }; dict set group_names "-$f" [list $argname 0 {}]
                        }; set nameset 1; set iscompatible 0
                     }
                  }
                  "-array" - "-arr" - "-a" {;# initialize a local array with given dict.
                     # TODO: think of a good use for the option argument...
                     if {$argtype ne ""} {
                        error "conflicting types: $o versus $argtype"
                     }; lappend arrays [list $argname]; set argtype "array"
                  }
                  default {
                     set err "unknown option `$o' in argspec for `$argname' "
                     append err "(Maybe, some option is missing its argument.)"
                     error $err
                  }
               }
            }
            if {$defset} {
               dict set argopts "-default" $defval
               lappend allnames [list $argname $defval]
               set proc_has_def 1
            } else {
               # non-defaulted after defaulted: not in plain proc
               if {$proc_has_def} { set iscompatible 0 }
               lappend allnames [list $argname]
            }
            # listlen: 0: no enlisting (but still takes 1 arg); <n>: enlist <n> arguments
            # minArgs: 0: has default; 1: has flags; -1: -name (no -flag) or positional
            # nameset: 1: names (or flags, unless $minArgs<0); 0: positional
            # if minArgs<0: re-adjust to  $nameset + max(1,$listlen)
            if {$minArgs < 0} { set minArgs [expr {$nameset + max($listlen,1)}] }

            # save information for call-wrapper
            dict set argopts "-list" $listlen; dict set argopts "minArgs" $minArgs
            # update number of predictable required arguments (will be reserved)
            incr total_minArgs $minArgs
         }
         # also relevant for "args" (in particular the else block)
         if {$nameset} {;# named argument: add to group
            dict set group_args $argname $argopts
            incr group_minArgs $minArgs
         } else {;# positional argument
            # eventually finish group of named arguments
            if {[dict size $group_args]>0} {;# flush
               lappend cache $group_args $group_names $group_minArgs
               set group_args {}; set group_names {}; set group_minArgs 0
            }
            # add this positional argument to the cache
            lappend cache [list $argname $argopts] [dict create] $minArgs
         }
      }
      # eventually finish a remaining open group of named arguments
      if {[dict size $group_names]>0} {;# flush
         lappend cache $group_args $group_names $group_minArgs
      }

      if {[llength $arrays]} {
         set templ {array set %s [set %s][unset %s];}; set intro ""
         foreach {la} $arrays {
            append intro [format $templ $la $la $la]
         }
         set body [string cat $intro $body]
      }
      if {[llength $upvars]} {
         # inject the upvars into the body
         set templ0 { [set %s][unset %s] %s}
         set templ1 { [set %s [set %s]][unset %s] %s}
         set intro "upvar 1"
         foreach {la an} $upvars {
            if {$an eq ""} {
               append intro [format $templ0 $la $la $la]
            } else {
               append intro [format $templ1 [list $an] $la $la $la]
            }
         }
         set body [string cat $intro ";" $body]
      }

      if {$iscompatible} {
         if {$proc_has_args} { lappend allnames "args" }
         uplevel 1 [list proc $name $allnames $body]
         return ""; # empty return for compatible procs
      } else {
         set intname "cache::$name"
         # call-wrapper will deal with defaults:
         set allnames [lmap {a} $allnames { lrange $a 0 0 }]
         set cache::data($intname) [list $total_minArgs $allnames $cache]
         #debug Cache: $intname -- $cache::data($intname)
         if {$proc_has_args} { lappend allnames "args" }
         uplevel 1 [list interp alias {} $name {} ::procx::call $intname]
         proc $intname $allnames $body
         return [namespace origin $intname]; # for debugging/information
      }
   }
   proc call {name args} {
      set argnr 0; set formargs [dict create "args" {}]
      lassign $cache::data($name) total_minArg allnames cache
      set nargs [expr {[llength $args]-$total_minArg}]
      #debug llengh [llength $args] -- tmin $total_minArg -- nargs $nargs 
      if {$nargs < 0} { error "too few arguments" }

      foreach {argopts nameopts minArgs} $cache {
         set arg [lindex $args $argnr]; set isnamed [dict size $nameopts]
         #debug group [dict keys $argopts] -- arg $arg -- [expr {$isnamed?"isnamed":""}]

         if {$isnamed} {; # assign value to named argument
            set horizon [expr {$nargs + $minArgs}]
            #debug argnr $argnr -- min $minArgs -- horiz $horizon -- nargs $nargs
            while { $argnr < $horizon && $arg ne "--" && [dict exists $nameopts $arg] } {
               lassign [dict get $nameopts $arg] argname isflag flagval
               set opts [dict get $argopts $argname]
               set minArgs [dict get $opts "minArgs"]
               set listlen [dict get $opts "-list"]
               
               # Aspects to consider:
               # A)  a) flag   b) name w/o list  c) name with list
               #  -> number of values it would consume, if accepted
               set wanted [expr {$isflag ? 1 : max(1,$listlen) }]
               # B)  arg has  a) def  b) flags  c) only name
               #       and: is the formal arg already set
               #  -> number of values reserved for this option
               set reserved [expr {[dict exists $formargs $argname] ? 0 : $minArgs } ]

               if {$argnr+$wanted > $nargs+$reserved} {
                  #debug not taken -- $argnr+$wanted>$nargs+$reserved
                  break; # cannot use this option for this group!
               }

               incr nargs $reserved; 
               if {$isflag} {
                  dict set formargs $argname $flagval
               } elseif {$listlen} {
                  set argto [expr {$argnr+$listlen-1}]
                  dict set formargs $argname [lrange $args $argnr $argto]
                  set argnr $argto
               } else {
                  dict set formargs $argname [lindex $args [incr argnr]]
               }; incr argnr; set arg [lindex $args $argnr]
            }
            # no more args available for this group
            if {$argnr < $nargs && $arg eq "--"} { incr argnr }
            # now try to complete the group with defaults
            dict for {n opts} $argopts {; # check if all have value or default
               if {![dict exists $formargs $n]} {
                  if {[dict exists $opts "-default"]} {
                     dict set formargs $n [dict get $opts "-default"]
                  } else { 
                     #puts "formargs: [dict get $formargs]"
                     error "formal argument $n has not been given a value"
                  }
               }
               #debug $n = [dict get $formargs $n]
            }
         } else {
            lassign $argopts argname opts
            #debug argnr $argnr -- min $minArgs -- nargs $nargs
            if {$argname eq "args"} {
               set argto [expr {$nargs-1}]
               dict set formargs "args" [lrange $args $argnr $argto]
               set argnr $nargs
            } else {
               set listlen [dict get $opts "-list"]; set useargs [expr {max(1,$listlen)}]
               # for positional arguments, minArgs equals either 0 or $useargs
               if {$minArgs || $argnr+$useargs <= $nargs} {;# fits
                  incr nargs $minArgs; # $minArgs values are already reserved.
                  if {$listlen} {
                     set argto [expr {$argnr+$listlen-1}]
                     dict set formargs $argname [lrange $args $argnr $argto]
                     set argnr $argto
                  } else {
                     dict set formargs $argname $arg
                  }; incr argnr; set arg [lindex $args $argnr]
               } else {;# doesn't fit => use default (not list'ed!)
                  dict set formargs $argname [dict get $opts "-default"]
               }
            }
            #debug $argname = [dict get $formargs $argname]
         }
      }
      if {$argnr < [llength $args]} {
         error "too many arguments"
      }
      set args [lmap x $allnames {dict get $formargs $x}]
      lappend args {*}[dict get $formargs "args"]
      tailcall $name {*}$args
   }
   #proc debug {args} { puts "Debug: $args" }
   namespace eval cache {}
   namespace export procx 
}
namespace import procx::procx