Listing of doc/example-scripts/starmethod.tcl
Star Methods
Design study for implementing methods which applies to instances of instances meta-classes. This study implements in addition to the regular "method" a new construct called "*method" which has the mentioned transitive property. The same behavior can be achieved in many ways. In this study, we define a special class (the method container class for *methods) which is kept in the precedence path of instances. This way, it can be defined freely with other extension mechanisms such as mixins, traits or filters.
nx::Class eval { # # Define a *method, which is a method that applies for instances of # the instances of a meta-class. # - *methods are only defineable on meta-classes # - *methods are applicable on the instances of the instances of the # meta-class # - If one defines a *method "bar" on a meta-class "MClass", and a # class "C" as an instance of "MClass", and "c1" is an instance of # "C", then "bar" is applicable for "c1". # # The "*method" has the same signature as regular methods, and can # be used in combination with the modifiers # public/protected/private as usual. # :public method *method {name arguments:parameter,0..* -returns body -precondition -postcondition} { # # Allow the definition only on meta-classes # if {![nsf::is metaclass [self]]} { error "[self] is not a meta-class" } # # Do we have the class for keeping the *methods already? # set starClass [nx::Class create [self]::*] if {![nsf::object::exists $starClass]} { # # If not, create the *method container class and provide # it as a default in the superclass hierarchy. This # happens by modifying the property "-superclasses" which # is used on every class to specify the class hierarchy. # :property [list superclasses $starClass] { # # Define a slot-specific method for keeping the # *method container class in the hierarchy. # :public object method appendToRelations { class property value } { set sc [nsf::relation::get $class $property] if {$sc eq "::nx::Object"} { nsf::relation::set $class $property $value } else { nsf::relation::set $class $property [concat $sc $value] } } # # Whenever the "-superclasses" relation is called, # make sure, we keep the *method container class in # the hierarchy. # :public object method value=set { class property value } { :appendToRelations $class superclass $value } } # # Update class hierarchies of the previously created instances # of the meta-class. # foreach class [:info instances] { set slot [$class info lookup slots superclasses] $slot appendToRelations $class superclass $starClass } } # # Define the *method as regular method in the star method # container class. # [self]::* method $name $arguments \ {*}[expr {[info exists returns] ? [list -returns $returns] : ""}] \ $body \ {*}[expr {[info exists precondition] ? [list -precondition $precondition] : ""}] \ {*}[expr {[info exists postcondition] ? [list -postcondition $postcondition] : ""}] } } set ::nsf::methodDefiningMethod(*method) 1
Some base test cases:
Define a meta-class MClass with a method "foo" and to star methods named "foo" and "bar".
nx::Class create MClass -superclass nx::Class { :public method foo {} {return MClass-[next]} :public *method foo {} {return *-[next]} :public *method bar {} {return *-[next]} }
Define a class based on MClass and define here as well a method "foo" to show the next-path in combination with the *methods.
MClass create C { :public method foo {} {return C-[next]} } % C info superclasses ::MClass::*
Finally create an instance with the method foo as well.
C create c1 { :public object method foo {} {return c1-[next]} }
The result of "foo" reflects the execution order: object before classes (including the *method container).
% c1 info precedence
::C ::MClass::* ::nx::Object
% c1 foo
c1-C-*-
% c1 bar
*-
Define a Class D as a specialization of C
MClass create D -superclass C { :public method foo {} {return D-[next]} :create d1 } % d1 info precedence ::D ::C ::MClass::* ::nx::Object % d1 foo D-C-*-
Dynamically add *method "baz".
% d1 baz ::d1: unable to dispatch method 'baz' MClass eval { :public *method baz {} {return baz*-[next]} } % d1 baz baz*-
Test adding of *methods at a time, when the meta-class has already instances.
Create a meta-class without a *method
nx::Class create MClass2 -superclass nx::Class MClass2 create X {:create x1} % x1 info precedence ::X ::nx::Object
Now add a *method
MClass2 eval { :public *method baz {} {return baz*-[next]} }
Adding the *method alters the superclass order of already created instances of the meta-class
% x1 info precedence
::X ::MClass2::* ::nx::Object
% x1 baz
baz*-
Finally, there is a simple application example for ActiveRecord pattern. All instances of the application classes (such as "Product") should have a method "save" (together with other methods now shown here). First define the ActiveRecord class (as a meta-class).
Class create ActiveRecord -superclass nx::Class { :property table_name :method init {} { if {![info exists :table_name]} { set :table_name [string tolower [namespace tail [self]]s] } } :public *method save {} { puts "save [self] into table [[:info class] cget -table_name]" } }
Define the application class "Product" with an instance
ActiveRecord create Product Product create p1 p1 save
The last command prints out: "save ::p1 into table products"