Traits in XOTcl

jima 30 Sep 2005: I liked NEM on Traits so I said to myself this could be put on top of my favourite tcl object extension.

As I understood it, NEM was simply defining an "interface" that Traits should follow. This interface I think could be implemented using forward from XOTcl weaponry. The code I present here is just an outline of it (and I am not a hell of a coder precisely).

By the way, on the public-private issue being talked about on [1] my point of view (jima) is close to (perhaps not identical) to that of Artur Trzewik. I would not go for having the possibility of hidding things away further than having them put on the right namespace. I have experienced the annoying bit of having to code-recode the access policies over an over again. And maintaining them. And besides, for me, all the magic of OO is not in hiding data away but in how the data is organized and the surrounding language capabilities. In this sense I think TOOT related pages (by NEM et RS) introduce very interesting points.

schlenk 30 Sep 2005 wonders who wrote this, may he or she replace one 'I' with a more descriptive name or reference. (jima: done, thanks for the piece of advice.)

jima 30 Sep 2005: Some notes on the code.

I really like tcl but perhaps I am leaping too far at giving names to things, I know I don't use the usual coding standard. I am actually trying to develop a coding standard of my own where every identifier (apart from those coming from other codes or language reserved keywords) has a built-in grammar.
Here, on naming issues, I differ a lot from Artur Trzewik :)

So I use:

To as a prefix to denote function.
Ab as a prefix to denote Class.
Ar as a prefix to denote argument.
Gl as a prefix to denote global variable.
My as a prefix to denote member attribute.
Th as a prefix to denote local variable.

jima 30 Sep 2005: The code (at a very early stage):

 #<
 #~ **Traits.tcl**.
 #
 #Trying to implement traits on top of **Xotcl**.
 #>

 package require XOTcl
 namespace import -force ::xotcl::*

 #<
 #~~ Class **AbTraitable**.
 #
 #Classes that want to have traits have to belong to this metaclass.
 #
 #I don't know if the desirable order of calls is achieved this way.
 #
 #But I believe it is so.
 #
 #An alternative is to use the superclass scheme in order to guarantee that:
 #
 #* Class methods take precedence over trait methods.
 #
 #* Trait methods take precedence over superclass methods.
 #>

 Class AbTraitable -superclass Class

 #<
 #~~~ Method **ToUseTrait**.
 #
 #Given the name of a trait the traitable class will adopt it.
 #
 #It will do so unless there is a conflict.
 #
 #Then something must be done (to do).
 #
 #User will have to resolv the conflict.
 #>

 AbTraitable instproc ToUseTrait {
   ArTraitName
 } {
   #Invokation of ToCheckTraitComposition to do.

   #If everything goes fine.
   #Remember that [self] here is a class.
   foreach ThMethodName [$ArTraitName set MyMethodS] {
     [self] instforward $ThMethodName -objscope $ThMethodName
   }
 }

 #<
 #~~~ Method **ToRemTrait**.
 #
 #Given the name of a trait the traitable class will remove it.
 #>

 AbTraitable instproc ToRemTrait {
   ArTraitName
 } {
   set ThPos [lsearch -exact [my set MyTraitS] $ArTraitName]
   if {[expr {$ThPos >= 0}]} {
     #Remember that [self] here is a class.
     foreach ThMethodName [$ArTraitName set MyMethodS] {
       [self] instforward $ThMethodName
     }
     lreplace [my set MyTraitS] $ThPos $ThPos
   }
 }

 #<
 #~~ Class **AbTrait**.
 #
 #Here we go.
 #>

 Class AbTrait

 #<
 #~~~ Constructor.
 #>

 AbTrait instproc init {
 } {
   my set MyMethodS [list]
 }

 #<
 #~~~ Method **ToAddMethod**.
 #
 #Given a method name add it to the trait.
 #
 #It will do so unless there is a conflict.
 #
 #Then an error method will be used in place.
 #
 #User will have to resolv the conflict.
 #>

 AbTrait instproc ToAddMethod {
   ArMethodName
 } {
   set ThPos [lsearch -exact [my set MyMethodS] $ArMethodName]
   if {[expr {$ThPos < 0}]} {
     my lappend MyMethodS $ArMethodName
   } else {
     my ToAddError_Method $ArMethodName
   }
 }

 #<
 #~~~ Method **ToAddError_Method**.
 #
 #Given a method name add a corresponding error method to the trait.
 #
 #User will have to resolv the conflict.
 #>

 AbTrait instproc ToAddError_Method {
   ArMethodName
 } {
   #To do.
 }

 #<
 #~~~ Method **ToSubMethod**.
 #
 #Given a method name subtract it from the trait if it exists.
 #>

 AbTrait instproc ToSubMethod {
   ArMethodName
 } {
   set ThPos [lsearch -exact [my set MyMethodS] $ArMethodName]
   if {[expr {$ThPos >= 0}]} {
     lreplace [my set MyMethodS] $ThPos $ThPos
   }
 }

 #<
 #~~~ Method **ToCompose5Trait**.
 #
 #Given a trait name compose the methods of self with those of the object.
 #
 #It will do so unless there is a conflict.
 #
 #Then an error method will be used in place.
 #
 #User will have to resolv the conflict.
 #>

 AbTrait instproc ToCompose5Trait {
   ArTraitName
 } {
   #To do.
 }

 #<
 #~~ Example.
 #>

 AbTraitable AbCircle\
   -parameter {{MyCentre {100}}}\
   -parameter {{MyRadius {100}}}\
   -parameter {{MyColour {black}}}

 proc ToRenameColour {
   ArColour
 } {
   my set MyColour $ArColour
 }

 proc ToPutColour {
 } {
   puts "[self] is [my set MyColour] coloured."
 }

 AbTrait GlCircleTrait

 GlCircleTrait ToAddMethod ToRenameColour
 GlCircleTrait ToAddMethod ToPutColour

 AbCircle ToUseTrait GlCircleTrait

 AbCircle GlCircle

 GlCircle ToPutColour
 GlCircle ToRenameColour magenta
 GlCircle ToPutColour

Category XOTcl Code