Tcl homework

proc foo text {
  set words [list]
  set pos 0
  while {[regexp -indices -start $pos {[^[:punct:]\s]+} $text match]} {
    lappend words $match
    lassign $match -> pos; incr pos
  }
  set nwords [llength $words]
  array set seen {}
  set out $text
  for {set i 0} {$i <= int(rand() * $nwords)} {incr i} {
    while 1 {
      set ix [expr {int(rand() * $nwords)}]
      if {![info exists seen($ix)]} break
    }
    set seen($ix) yo!
    lassign [lindex $words $ix] a b
    set out [string replace $out $a $b [string repeat * [expr {$b - $a + 1}]]]
  }
  set out
}