"STRUCT", need another set of eyes

[johnlopez2000]

Below, I have 2 implementations showing an attempt to replicate a STRUCT(C) or TYPE(VB) in TCL.

IMP#1) eccentially looks to me to be an array of namespaces, whereas IMP#2) seems to be an array within a namespace.

Both implementations work. ::Object::init is called first, then each struct array element is populated with something similar to:

set x [::Object::addRecord "Mech Dwg" 300601 A]

One can view array elements as:

IMP#1) puts $::Object(3,REV)

IMP#2) puts $::Object::Obj(3,REV)

Even though both work, is IMP#1 invalid per TCL standards or styling? Will I get in trouble with memory requirements with #1 or #2?

Your opinions are appreciated. (see below)

#~~~~~~~# implementation #1 #~~~~~~~#
#~STRUCT object and methods~#
namespace eval Object {

proc init {} {
variable index
set index 0
}

proc incrIndex {} {
incr ::Object::index
}

proc addRecord { xType xName xRev } {
set ::Object($::Object::index,TYPE) $xType
set ::Object($::Object::index,NAME) $xName
set ::Object($::Object::index,REV) $xRev
set x [::Object::incrIndex]
}
}

#~~~~~~~# implementation #2 #~~~~~~~#
namespace eval Object {

proc init {} {
variable index
set index 0
}

proc incrIndex {} {
incr ::Object::index
}

proc addRecord { xType xName xRev } {
set ::Object::Obj($::Object::index,TYPE) $xType
set ::Object::Obj($::Object::index,NAME) $xName
set ::Object::Obj($::Object::index,REV) $xRev
set x [::Object::incrIndex]
}
}

 

[AviaTraining]

I don't see anything obviously wrong with either approach. It looks as though you've developed a rather interesting approach to implementing structured data in Tcl.

Implementation 1 is cool in the way it makes the namespace itself appear like a data object by creating a variable in the global namespace :Object) with the same name as the namespace itself :Object). The second implementation distinguishes between the two, which might help prevent some confusion in the internals of your "Object library," but I don't think it will cause any problems in your main application.

I do have a few stylistic comments on your actual implementation code....

You don't need the init procedure if you don't want it. You can include the initialization "in-line" when you declare the namespace:

[tt]namespace eval Object {
variable index 0

proc addRecord ...
}[/tt]

Note that with the variable command, you can declare the namespace variable and set its value all in one command. By placing this command directly inside the namespace eval block, it gets executed automatically when you create the namespace.

Then, to access this namespace variable, you can either use the fully-qualifed name (which you currently do -- "::Object::index&quot, or you can include a variable declaration at the beginning of each namespace procedure that wants to access it. Thus, you could change your incrIndex and addRecord procedures to this:

[tt]namespace eval Object {
variable index 0

proc incrIndex {} {
variable index
incr index
}

proc addRecord { xType xName xRev } {
variable index
set ::Object($index,TYPE) $xType
set ::Object($index,NAME) $xName
set ::Object($index,REV) $xRev
[ignore]set x [::Object::incrIndex][/ignore]
}
}[/tt]

This has the added advantage that if you later change the name of your namespace, you won't have to go through all of your code to update your namespace variable references.

Similarly, from within a namespace, you don't have to use the fully-qualified procedure names to access other procedures within that namespace. When you're within the context of a namespace and you call a command, Tcl first checks for a command by that name within the namespace, and then checks in the global namespace only if it couldn't find one within the namespace. Thus, we could further modify your addRecord procedure as follows:

[tt]namespace eval Object {
variable index 0

proc incrIndex {} {
variable index
incr index
}

proc addRecord { xType xName xRev } {
variable index
set ::Object($index,TYPE) $xType
set ::Object($index,NAME) $xName
set ::Object($index,REV) $xRev
set x [ignore][incrIndex][/ignore]
}
}[/tt]

On the other hand, I don't see anything else being done by incrIndex that really warrants abstracting into a separate procedure. Perhaps you're simplifying the code for presentation on this group. But if not, I'd eliminate it and call incr directly from addRecord:

[tt]namespace eval Object {
variable index 0

proc addRecord { xType xName xRev } {
variable index
set ::Object($index,TYPE) $xType
set ::Object($index,NAME) $xName
set ::Object($index,REV) $xRev
set x [ignore][incr index][/ignore]
}
}[/tt]

Finally, I don't actually see any purpose in the "set x" command at the end of addRecord (again, unless you've simplified the code for posting here). In this case, x is a local variable, immediately destroyed when your procedure exits. I suppose you could be using the old trick of using the set command to return a value from a procedure. (This works because, if you don't have an explicit return command in a procedure, the return value of the procedure is the return value of the last command executed within the procedure.) This trick used to be slightly faster than simply using return to return the value. But in recent version of Tcl, return has been optimized so that this is no longer true.

So, if you simply want to return the latest value of index, you could simply have:

[tt]incr index[/tt]

as the last line of your procedure, because incr returns the updated value of the variable. But I still prefer an explicit return command. It makes your intention more obvious to maintainance programmers, and it's less likely that you'll accidentally break things by unwittingly inserting additional commands after the last statement if you later modify the procedure.

Additionally, if your intention is to return the index of the object just created, you really want to return the value of index before incrementing it. Alternately, you could increment index before creating the record. Assuming that that's what you intended, I'll take this approach in my example.

So, here's my last "refactoring" of your Implementation 1:

[tt]namespace eval Object {

# Assuming you want to start with
# index 0, account for the pre-creation
# increment.

variable index -1

proc addRecord { xType xName xRev } {
variable index

incr index
set ::Object($index,TYPE) $xType
set ::Object($index,NAME) $xName
set ::Object($index,REV) $xRev
return $index
}
}[/tt] - Ken Jones, President, ken@avia-training.com
Avia Training and Consulting,

http://www.avia-training.com

866-TCL-HELP (866-825-4357) US Toll free
415-643-8692 Voice
415-643-8697 Fax

 

[johnlopez2000]

Thanks Ken, that really tightened up my code and understanding.

I've also added a "destroyObj" method (since it will be called often and needs to be reinitialized) and some additional parameters to cover database relationships, etc. to the above.

One of the downfalls of the above is the inability to instantiate 'instances' of the object def.

One bizzare idea hit:

foreach Obj {Dog Cat Cow} {
namespace eval $Obj {
set x A
set y B
set z C
}
}
puts "$::Cat::x , $::Cat::y , $::Cat::z"

that would then iteratively define the namespace(s) for all instances of an object classification. But I realize (i think from viewing in TCL Pro debugger) that the interpreter sets up the namespaces within the context of each loop iteration and it is only persistant for that iteration. However, if this could somehow work, a single "object classification" could be setup, and instances iteratively instantiated, or maybe have a method that would instantiate new instances:

proc bldObjInstance {some params} {
namespace eval ...
}

thanks

 

[johnlopez2000]

a further example for a method to build object instances:

proc Obj {ObjName} {
namespace eval $ObjName {
set x A
set y B
set z C
}
}
set x [Obj Cat]

[note: unfortunately the version of TCL that I am tied to does not have nor can it have incrTCL]

thanks

 

[AviaTraining]

Well, [ignore][incr Tcl][/ignore] isn't the only OO extension available for Tcl. Check out the Tcl'ers Wiki (

http://wiki.tcl.tk),

specifically the page "Object orientation,"

http://mini.net/tcl/970.

You might find stooop of particular note. stooop is a Tcl-only OO extension that's distributed as part of Tcllib, the standard Tcl library. You can find out more about stooop on the Wiki at

http://mini.net/tcl/2165,

and more about Tcllib at

http://mini.net/tcl/1246.

Some other Wiki pages that you might find interesting and applicable to what you're doing are:[ul][li]"On things,"

http://mini.net/tcl/1066

[/li][li]"Doing things in namespaces,"

http://mini.net/tcl/1071

[/li][li]"Gadgets,"

http://mini.net/tcl/909

[/li][li]"LOST,"

http://mini.net/tcl/923

[/li][li]"Yet another object system,"

http://mini.net/tcl/3271

[/li][/ul] - Ken Jones, President, ken@avia-training.com
Avia Training and Consulting,

http://www.avia-training.com

866-TCL-HELP (866-825-4357) US Toll free
415-643-8692 Voice
415-643-8697 Fax

 

[marsd]

Here is my own amateurish version.

proc DataObj {args} {
foreach member $args {
if {[regexp "(\[ailst\])\.(\[a-zA-Z0-9\]+)\.(\[a-zA-Z0-9\]+)" $member a c d e]} {
lappend namelist $member
} else {
error "Invalid struct member: $member."
}
switch -exact -- $c {
"l" {
uplevel #0 "
set [subst -novariable $d] \[eval $e\]
"
} "a" {
uplevel #0 "
set x 0 ; array set [subst -novariable $d] {}
foreach n \[eval $e\] {
set [subst -novariable $d](\[incr x\]) \$n
} ; set x 0
"

} "s" {
uplevel #0 "
set [subst -novariable $d] $e
"

} "i" {
uplevel #0 "
set [subst -novariable $d] $e
"
} "t" {
uplevel #0 "eval {proc $d {{xlist \"$namelist\"}} {
foreach nme \$xlist {
set base \[split \$nme \".\"\]
if {\"\[lindex \$base 0\]\" == \"a\"} {
set arr \[lindex \$base 1\] ; uplevel #0 \"parray \$arr\"
} elseif {\"\[lindex \$base 0\]\" == \"i\"} {
set in \[lindex \$base 1\] ; uplevel #0 \"puts \$\$in\"
} elseif {\"\[lindex \$base 0\]\" == \"s\"} {
set in \[lindex \$base 1\] ; uplevel #0 \"puts \$\$in\"
} elseif {\"\[lindex \$base 0\]\" == \"l\"} {
set lis \[lindex \$base 1\] ; uplevel #0 \"puts \$\$lis\"
}
}
}}"
uplevel #0 "trace add execution $d {enter} handl"
}
}
}
return
}

proc resetmethodhandler {args} {
if {[regexp "(\[a-zA-Z\]+)\.(\[mM\]odify|\[Uu\]nset)\.(\[a-zA-Z0-9\]+)\.(\[a-zA-Z0-9\]+)" [lindex $args 0] all m n o p]} {
if {[set ind [lsearch [info procs] $m]] > -1} {
set pnme [lindex [info procs] $ind]
set err [catch {info default $pnme xlist orij_obj_list}]
if {$err} {
return -errorinfo $err
} elseif {[set ind [lsearch -regexp $orij_obj_list "\.$o\..*"]] > -1} {
switch -regexp -- $n {
"\[Uu\]nset" {
regexp "(\[ails\])\..*\..*" [lindex $orij_obj_list $ind] all type
set arglist [lreplace $orij_obj_list $ind $ind ""]
uplevel #0 "eval DataObj $arglist"
return $arglist
} "\[Mm\]odify" {
regexp "(\[ails\])\..*\..*" [lindex $orij_obj_list $ind] all type
set newarg "$type.$o.$p"
set arglist [lreplace $orij_obj_list $ind $ind $newarg]
uplevel #0 "eval DataObj $arglist"
return $arglist
}}
} else {
return "Could not find index-> $ind, in $orij_obj_list"
}
} else {
error "Could not find a valid handler named: $m in $orij_obj_list"
}
} elseif {[set i [lsearch [info procs] [lindex $args 0]]] > -1} {
info default [lindex $args 0] xlist orij_obj_list
return $orij_obj_list
}
return
}

proc handl {c o} {
set baseargs [split $c "."]
if {[llength $baseargs] == 1} {
return
} elseif {[llength $baseargs] == 2} {
set base [string trim [lindex $baseargs 1]]
puts "[uplevel #0 resetmethodhandler $base]"
return
} else {
set base [string trim [lindex $baseargs 1]]
set baseargs [join [lrange $baseargs 1 [llength $baseargs]] "."]
set baseargs [string trim $baseargs]
puts "[uplevel #0 resetmethodhandler $baseargs]"
uplevel #0 "trace add execution $base {enter} handl"
}
}


This was inspired a little by the examples above, but since I'm a messy coder it may not be immediately understandable. This requires tcl 8.4.

Example:
DataObj {
a.array1.method
a.array2.method
l.mylist1.lmethod
l.mylist2.method
i.num1.284993
i.num2.784993
t.ref.NULL
}

Every time you call the procedurehandler
(assigned via t.xxx.NULL).
the contents of the "Struct" are output.

To see a listing of the individual members
you can reference the procedure by name:
ref .ref

To modify:
ref .ref.modify.dataref.newmethod
To unset:
ref .ref.unset.dataref.NULL

After each call a new trace is attached to the
handler to modify the datamembers.

This is still a work in progress, and needs error
handling a fix for duplicate traces,more defined
behavior, correction of errors, other order of args
based stuff.
It might be good for a database, or a server program
where multipart records are necessary and some type checking would be good. It really is amazing what you
can get tcl to look like...

 

[johnlopez2000]

way cool marsd!

thanks! John Lopez
Enterprise PDM & Integration Consulting
Development for MatrixOne PDM Systems
johnlopez2000@hotmail.com