Posted to tcl by aspect at Thu Aug 27 13:00:15 GMT 2015view raw

  1. # why is this so subtle?
  2. #
  3. # because object methods, class methods, constructors, initialisation scripts, classes, metaclasses,
  4. # instances and subclasses are all concepts just a little bit too close to one another.
  5. #
  6. # But I think I've (finally!) nailed it.
  7. #
  8. #
  9. # To best understand this, it helps to reflect on a few things:
  10. #
  11. # TclOO consists of four commands: oo::class, oo::object, oo::define, oo::objdefine. The first two
  12. # are objects: they're tasty and the whole point of the exercise. The other two are a bit funny.
  13. # They're kinda like namespace ensembles with a -parameter, but if you check, that expansion doesn't
  14. # hold:
  15. #
  16. # % oo::define myclass method bark {} {puts woof}
  17. # % oo::define::method myclass bark {} {puts woof}
  18. # error
  19. #
  20. # They seem to work by inspecting the stack to see which object is being defined -- at least, that's
  21. # the best method I've seen used in script. Basically, they're a little bit perverse and resistant
  22. # to extension in a way most things in Tcl aren't, which is why I kept picking at this like a scab.
  23. #
  24. # It's worth noting (accepting) that objects and classes are different. Which is why there are these
  25. # two definition commands. And hard-to-articulate differences between class methods and object
  26. # methods, to say nothing of the weird involuted relationship between oo::class and oo::object.
  27. #
  28. # This module makes classes better, but does nothing for objects. That will come later.
  29. #
  30. # An object is a command with a namespace tied to its lifetime. And various properties relating to
  31. # OO and Classes, but the namespace lifetime is really the nugget.
  32. #
  33. # A class is a special kind of object that can also (create) be the class of objects. This is why
  34. # there is no oo::objdefine::constructor, and why a mixin can only be a class.
  35. #
  36. # oo::class is special among classes in that its instances are classes. This is why they get a create
  37. # method, but their instances don't. We call it a metaclass.
  38. #
  39. # How do you make a metaclass? By creating a class which is a subclass of oo::class: this way its
  40. # instances will have create methods and be able to act as classes.
  41. #
  42. # It is worth having [Inspecting TclOO] handy as you proceed. Nothing beats looking under the covers.
  43. #
  44. catch {namespace delete meta}
  45.  
  46. namespace eval meta {
  47.  
  48. ;#proc debug {args} { puts "D: [uplevel 1 subst $args]" }
  49. proc debug args {}
  50.  
  51. ;# doesn't everybody use these? [interp alias] + all those [namespace] calls is so verbose
  52.  
  53. proc alias {alias cmd args} {
  54. if {![string match ::* $alias]} {
  55. set alias [uplevel 1 {namespace current}]::$alias
  56. }
  57. if {![string match ::* $cmd]} {
  58. set c [uplevel 1 [list namespace which $cmd]]
  59. if {$c eq ""} {
  60. return -code error "Could not resolve $cmd!"
  61. }
  62. set cmd $c
  63. }
  64. tailcall interp alias {} $alias {} $cmd {*}$args
  65. }
  66.  
  67. proc unalias {args} {
  68. foreach cmd $args {
  69. interp alias {} [uplevel 1 [list namespace which $cmd]] {}
  70. }
  71. }
  72.  
  73. ;# now we start:
  74.  
  75. # The class of all classes ...
  76. oo::class create Metaclass {
  77. superclass oo::class
  78. }
  79.  
  80. # .. has all the oo::define commands as methods.
  81. # they take an extra argument at the beginning: [$metaclass method $class name args body]
  82. # .. compare: [oo::define $class method name args body]
  83. foreach cmd [info commands ::oo::define::*] {
  84. set tail [namespace tail $cmd]
  85. if {$tail eq "self"} continue
  86.  
  87. oo::define Metaclass method $tail {cls args} [format {
  88. set cls [uplevel 1 [list namespace which $cls]] ;# could avoid this with [tailcall]..
  89. debug log {defining %1$s on $cls}
  90. oo::define $cls %1$s {*}$args
  91. } $tail]
  92. }
  93.  
  94. # The base class of all classes is an instance of Metaclass and a subclass of oo::class.
  95. # Got that? No, neither have I. But play along .. it works.
  96. #
  97. # As an instance of Metaclass, it gets all the methods defined above (eg [Class export $cls $name ...]).
  98. #
  99. # As a subclass of oo::class, its instances are classes with no special features.
  100. #
  101. Metaclass create Class0 {
  102.  
  103. superclass oo::class
  104.  
  105. # Class's constructor takes a script, which it evaluates
  106. # in the new class's namespace, temporarily augmented
  107. # with aliases to all of its own methods.
  108. constructor {{script ""}} {
  109. set class [info object class [self]] ;# not [self class] !
  110. debug log {creating $class [self]}
  111.  
  112. set cmds [info object methods $class -all]
  113. foreach cmd $cmds {
  114. alias $cmd $class $cmd [self]
  115. }
  116.  
  117. try $script finally [list unalias {*}$cmds]
  118. }
  119. }
  120. ;# This is a drop-in extension for oo::class. It has some extra methods, which should
  121. ;# not get in the way next to the normally-used [$cls create] [$cls new] and [$cls destroy].
  122.  
  123. ;# Its constructor (class initialiser) behaves slightly differently, but these changes should
  124. ;# not be able to impact any but the most pathological constructor scripts. See below.
  125.  
  126. ;# Costs only occur at class creation time, which should be insignificant unless your name
  127. ;# is hypnotoad. The aliases exist only as long as they need to, and in the class object's
  128. ;# namespace where they shouldn't be able to affect anything but the class's initialisation
  129. ;# script.
  130.  
  131. ;# Normally only one command exists in this namespace (as with any object's namespace): [my]
  132. ;# Commands from oo::Helpers are also in the path (self, next, nextto), but nothing else.
  133.  
  134.  
  135. ;# !!! There is one loss !!!
  136. ;# [oo::define::self], normally an alias to ~ [oo::objdefine [self class]], is gone
  137. ;# since we're running in the constructor. I don't think that's a big loss, since it's
  138. ;# a confusing name coincidence and rarely used. It needs exposure under a better name,
  139. ;# like [class].
  140.  
  141. ;# I think we could restore [self] as a method on Metaclass, but it strikes me as risky.
  142. ;# Maybe that's not the case. But I'm not sure I like the pun.
  143.  
  144.  
  145. ;# Some useful extensions are immediately visible:
  146. ;#
  147. ;# * restore [self]-like behaviour through a different name ([class])
  148. ;# * add [uplevel 1 namespace current] to the path during the initialisation script
  149. ;# in fact, leave it there. I want it more often than not.
  150. ;#
  151. oo::define Metaclass method class {cls cmd args} { ;# restoration of oo::define::self
  152. debug log {class $cmd $cls [info object class [self]]!}
  153. oo::objdefine $cls $cmd {*}$args
  154. }
  155. Metaclass create Class {
  156. superclass ::meta::Class0
  157. constructor args {
  158. set p [namespace path]
  159. namespace path [list {*}$p [uplevel 1 {namespace current}]]
  160. next {*}$args
  161. ;#namespace path $p
  162. }
  163. }
  164.  
  165. }
  166.  
  167. ;# Well .. but so what?
  168.  
  169. if 1 {
  170. namespace path [list meta {*}[namespace path]]
  171.  
  172. ;# The net effect is close to zero: Class has methods forwarding to oo::define's
  173. ;# pseudo-methods, and its constructor runs the new class's initialisation script
  174. ;# in the class's own namespace, with appropriate aliases in the namespace as though
  175. ;# you were really there.
  176. ;#
  177. ;# Creating a class works pretty much the same:
  178. Class create C1 {
  179. method bark args woof
  180. variable foo
  181.  
  182. ;# except this is neat:
  183. debug log {Creating [self] in [namespace current] (eq [info object namespace [self]])}
  184. ;# oo::class initialisers run on oo::define! These run in the class's own namespace.
  185. ;#
  186. ;# This is a fairly big deal, since that's where most creative commands like to write
  187. ;# (like [proc]).
  188. }
  189.  
  190. ;# we get this for free, which is just as well because it seems more distracting than useful:
  191. Class method C1 foo {args} {set foo {*}$args}
  192.  
  193. ;# notice that these methods don't get in the way, as the only (object) methods we normally
  194. ;# use from a class are [$cls create] [$cls new] and sometimes [$cls destroy].
  195. ;#
  196. ;# This is a different thing (I think) than "class methods" as they exist in other languages.
  197. ;# But the concept appears pretty weak to me, so I don't think much is lost. Note also that
  198. ;# other Tcl object systems (which?) have taken an interpretation of class methods (or "class
  199. ;# subcommands"?) similar to this.
  200.  
  201. ;# but the magic comes here:
  202. Metaclass create Fancy {
  203. method accessor {cls args} { ;# remember the extra cls argument!
  204. set cls [uplevel 1 [list namespace which $cls]] ;# remember this bit too!
  205. foreach name $args {
  206. my variable $cls $name
  207. my method $cls $name args [format {
  208. set %s {*}$args
  209. } [list $name]]
  210. }
  211. }
  212. }
  213.  
  214. ;# now we could just:
  215. #oo::objdefine Class mixin Fancy
  216. ;# but in the interest of neighbourliness, let's leave our nice Class alone and
  217. ;# mess with a derivative:
  218. Metaclass create Klass {
  219. superclass ::meta::Class
  220. }
  221. oo::objdefine Klass mixin Fancy
  222. ;# notice that this used objdefine, not define, because it's affecting the class and not its instances.
  223. ;# a strong case could be made for making this a (object) method of Class.
  224.  
  225. ;# of course, we can also do it with oo::objdefine ... or uplevel!
  226. oo::objdefine Klass method public {cls cmd name args} {
  227. my $cmd $cls $name {*}$args
  228. my export $cls $name
  229. }
  230. oo::objdefine Klass method private {cls cmd name args} {
  231. debug what
  232. uplevel 1 [list $cmd $name {*}$args]
  233. uplevel 1 [list unexport $name]
  234. }
  235.  
  236. ;# now we can use that like this:
  237. Klass accessor C1 bar baz
  238.  
  239. ;# or the better way:
  240. Klass create C2 {
  241. constructor args {
  242. lassign $args frop quaz
  243. }
  244. accessor frop quaz
  245.  
  246. class method bar bar bar
  247.  
  248. private method shush sh shh
  249. public method Brum {} gogogo
  250. }
  251.  
  252. ;# notice that C2's instances bear no sign of being metaclass-derived. This is good.
  253.  
  254. ;# what you just saw is a SAFE way to extend object creation. While I request that you squint
  255. ;# past my mixin directly on Class, notice that [accessor] as defined here need not conflict with
  256. ;# any other extension's use of the same command! No more fighting over oo::define. Or even
  257. ;# scribbling on it - that's just rude.
  258. }
  259.  
  260. # Having done this, it's tempting to try a lot more. Sensible namespace behaviour for oo::object
  261. # initialisers; using [info object namespace oo::class]::my CreateWithNamespace; much more. But
  262. # it's a twisty maze of passages all alike, so go gently.
  263.  
  264.