set randchan [tcl::chan::random [tcl::randomseed]]
proc rand_hex {} {
  global randchan
  return [binary encode hex [read randchan 8]]
}

proc lindex* {list args} {
  lmap index $args {lindex $list {*}$index}
}

proc sproc {name args} {
  if {[llength $args] == 1} {
    set config [lindex $args 0]
  } else {
    set config $args
  }
  if {[llength $config] % 3 != 0 || $config == {}} {
    return -code error "wrong # args: should be \"sproc name { subcommand args body ?subcommand args body ...? }\""
  }

  set config [lsort -stride 3 $config]
  set subcommands [lmap {subcommand _ _} $config {expr {$subcommand}}]

  set prefix_args {}
  set prefix_body {}
  if {[set subcmd_idx [lsearch $subcommands _prefix]] != -1} {
    set prefix_idx [expr {$subcmd_idx * 3}]
    lassign [lindex* $config $prefix_idx+1 $prefix_idx+2] prefix_args prefix_body
    set config [lreplace $config $prefix_idx $prefix_idx+2]
    set subcommands [lreplace $subcommands $subcmd_idx $subcmd_idx]
  }

  set qualifiers [namespace qualifiers $name]
  if {[string range $name 0 1] == "::"} {
    if {$qualifiers == {}} {
      set namespace ::
    } else {
      set namespace $qualifiers
    }
  } else {
    set parent [uplevel {namespace current}]
    if {$qualifiers == {}} {
      set namespace ${parent}
    } else {
      set namespace ${parent}::${qualifiers}
    }
  }

  set name [namespace tail $name]

  interp alias {} ${namespace}::${name} {} ::__sproc_impl $name $namespace $prefix_args $prefix_body $subcommands $config
}
proc __sproc_impl {name namespace prefix_args prefix_body subcommands config args} {
  if {[llength $args] < [llength prefix_args] + 1} {
    return -code error "wrong # args: should be \"$name [concat subcommand $prefix_args] ?arg ...?\""
  }
  set args [lassign $args subcommand]

  # TODO: don't search the list twice, if possible
  set subcommand [::tcl::prefix match -message subcommand $subcommands $subcommand]
  set cmd_index [expr {[lsearch -sorted $subcommands $subcommand] * 3}]
  lassign [lindex* $config $cmd_index+1 $cmd_index+2] sc_args sc_body
  set sc_args [concat $prefix_args $sc_args]
  set sc_body [string cat $prefix_body \n $sc_body]

  if {[lindex $sc_args end] == "args"} {
    if {[llength $args] >= [llength $sc_args] - 1} {
      uplevel [list apply [list $sc_args $sc_body $namespace] {*}$args]
    } else {
      return -code error "wrong # args: should be \"$name $subcommand [concat [lrange $sc_args 0 end-1] {?arg ...?}]\""
    }
  } else {
    if {[llength $args] == [llength $sc_args]} {
      uplevel [list apply [list $sc_args $sc_body $namespace] {*}$args]
    } else {
      return -code error "wrong # args: should be \"$name [concat [list $subcommand] $sc_args]\""
    }
  }
}