manipulating a proc with tags


Thanks AM, I changed it.

I reworked the whole thing some, I think it's a lot more functional now. Got rid of the random id's; now they are specified. I'll leave this here in case somebody likes it, but I think the following is much better.


See lego proc manipulation for the improved version.


Here's what I came up with to create and manipulate parts of a proc's body by setting tags for each part of the body. Setting these tags allows me to split up the list accordingly and treat and change parts like changing list items.

Functions:

  ##### _pgetid
  # Creates a 10 digit id greater than 0
  #####
  proc _pgetid {checklist} {
     set z 0
     while {$z < 1} {
       set y [expr { int( rand() * 9 ) }]
       set w [expr { int( rand() * 9 ) }]
       set r [expr { int( rand() * 9 ) }]
       set b [expr { int( rand() * 9 ) }]
       set g [expr { int( rand() * 9 ) }]
       set l [expr { int( rand() * 9 ) }]
       set p [expr { int( rand() * 9 ) }]
       set d [expr { int( rand() * 9 ) }]
       set q [expr { int( rand() * 9 ) }]
       set s 1
       set n "$y$w$r$b$g$l$p$d$q$s"
       if {[lsearch $checklist $n] < 0} {set z 1}
     }
     return $n
  }
  ###

  ###### pinsert
  #  Inserts code at id'd index position and returns the new codes id, id will be 0000000000 -
  # if proc does not exist
  ######
  proc pinsert {name index code} {
     set c1 [format %c 1]
     if {![llength [info procs $name]]} {
       set id 0000000000
       set bodylist [list]
       set pargs { }
     } else {
       set idlist [pgetlist $name bodylist]
       set id [_pgetid $idlist]
       set pargs [info args $name]
     }
     set code "\#$c1$id$c1\#\n$code\n\#$c1$id$c1\#"
     set bodylist [linsert $bodylist $index $code]
     uplevel #0 [list proc $name $pargs [join $bodylist \n]]
    return $id
  }
  ###

  ###### preplace
  #  Removes or replace id's code 
  # if code is specified it will have the previous codes id
  # else id is removed as well
  ######
  proc preplace {name id {code 0}} {
    set idlist [pgetlist $name bodylist]
    set tmp [lsearch $idlist $id]
    set pargs [info args $name]
    if {$tmp >= 0} {
     if {$code == 0} { 
       set bodylist [lreplace $bodylist $tmp $tmp]
     } else {
       set c1 [format %c 1]
       set code "\#$c1$id$c1\#\n$code\n\#$c1$id$c1\#"
       set bodylist [lreplace $bodylist $tmp $tmp $code]
     }
     uplevel #0 [list proc $name $pargs [join $bodylist \n]]
    }
  }
  ###

  ###### pargs
  # Sets the args of a proc
  ######
  proc pargs {name parg} { 
    if {[llength [info procs $name]]} { uplevel #0 [list proc $name $parg [info body $name]] } 
  }
  ###

  ###### pgetlist
  # 1. It returns a list of all id's in a proc with lindex relative to its code
  # 2. Creates a list to varname with the body of a proc split at prior id's
  # 3. If the proc has no pinsert id's it tags the existing body with 0000000000
  #   This means you can easily refer to the initial code in a proc 
  ######
  proc pgetlist {name {varname ""}} {
     set c1 [format %c 1]
     set code [info body $name]
     set tmp [string length [string trim $code]]
     set code [split $code \n]
     set pattern "\#$c1\??????????$c1\#"
     set codepos [lsearch -all $code $pattern]
     if {[llength $codepos] == 0 && $tmp != 0} {
        set id 0000000000
        lappend codepos 0 end
        set code [linsert $code 0 "\#$c1$id$c1\#"]
        lappend code "\#$c1$id$c1\#"
     }
     set codelist [list]
     set idlist [list]
     foreach {start end} $codepos {
        lappend codelist [join [lrange $code $start $end] \n]
        set chunk [lindex $code $start]
        lappend idlist [string range $chunk 2 [expr [string length $chunk] - 3]] 
    }
    if {$varname != ""} { uplevel 1 [list set $varname $codelist] }
    return $idlist
  }
  ###

  ############ for debug
  #! DEBUG
    proc proc_view {name} {
      set tmp [split [info body $name] \n]
      set tmpa [info args $name]
      set tmpres "proc $name \{$tmpa\} \{\n"
      foreach {line} $tmp { set tmpres "$tmpres   $line\n" }
      set tmpres "$tmpres\}\n"
      puts "\n############################\n### DEBUG - proc view ###"
      puts "$tmpres\###########################\n"
    }
  #####

Functions work almost like the list functions with similar name. Main difference is that code is tagged with a 10 digit random id number instead of a list index. If i think of an easy way to maintain ease of use and efficiency, or if somebody makes a suggestion, I may use some other type of separation id and keep an actual index count like a list. The main problem i saw with this is that when inserting into it causes the other items to change. It would be hard to keep track of what code is where.

Example:

  #############################################
  #### LETS TRY IT OUT - create/manipulate "sayit"
  #############################################
  set code(0) {set say "$say IS"}
  set code(1) {set say "$say FUN"}
  set code(2) {set say "$say\."}
  set code(3) {puts "YOU SAY: [string trim $say]"}

  ### these will contain the id tags to locate our code
  set codeID(0) [pinsert sayit end $code(0)]
  set codeID(1) [pinsert sayit end $code(1)]
  set codeID(2) [pinsert sayit end $code(2)]
  set codeID(3) [pinsert sayit end $code(3)]
  pargs sayit {say}
  proc_view sayit
  sayit "TCL"

  ### lets change it
  preplace sayit $codeID(3) {return [string trim $say]}
  puts "- [sayit "THIS"]"
  preplace sayit $codeID(0) {set say "$say ARE"}
  puts "- [sayit "PUPPIES"]"

  ### just a tad more technical
  ## I want to add a word in a specific place,
  ## so i need to get an Index from an ID
  set tmp [pgetlist sayit]
  set x [lsearch $tmp $codeID(1)]
  set codeID(4) [pinsert sayit $x {set say "$say PROCS"}]
  set codeID(5) [pinsert sayit $x {set say "$say TCL"}]
  puts "- I THINK: [sayit "THESE"]"

  ### Removing code
  ##  I realize to do the following i could just proc again, this is just for show
  foreach {id} [pgetlist sayit] {
    preplace sayit $id
  }
  proc_view sayit

  ### lets make it a calculator
  set codeID(0) [pinsert sayit 0 {puts "- $args = [expr $args]"}]
  pargs sayit {args}
  proc_view sayit
  sayit (3 + 3 * 2) * 10

I'm not as familiar with TCL as some of you fellow wikians. Therefore Suggestions and Corrections are well appreciated. Thanks.

- David Myers aka xonecubed


AM Some comments, as I promised:

The series of assignments:

       set y [expr { int( rand() * 9 ) }]
       set w [expr { int( rand() * 9 ) }]
       set r [expr { int( rand() * 9 ) }]
       ...

can be made more compact:

      foreach var {y w r ...} { 
          set $var [expr {int(rand()*9)}]
      }

and I do not think it is necessary to use:

    uplevel #0 [list proc $name ...]

The command:

    proc ::$name ...

will give the same effect.

Just a few remarks :)