diff options
-rw-r--r-- | README.oo | 29 | ||||
-rw-r--r-- | examples/ootest.tcl | 38 | ||||
-rw-r--r-- | oo.tcl | 19 |
3 files changed, 59 insertions, 27 deletions
@@ -47,10 +47,12 @@ PREDEFINED CLASS METHODS Declaring a class pre-defines a number of "class" methods. i.e. those which don't require an object and simply return or manipulate properties of the class. These are: - new ?instancevars?:: + new ?args...?:: Creates and returns new object, optionally overriding the default class variable values. Note that the class name is an alias for 'classname new {}' and can be used as a shorthand - for creating new objects with default values. + for creating new objects with default values. If the default constructor is used, + 'args' is interpreted as a dictionary of instance variables that are set as given. + These can be interpreted differently if a custom constructor is used. method name arglist body:: Creates or redefines a method for the class with the given name, argument list and body. @@ -87,6 +89,14 @@ PREDEFINED OBJECT METHODS Declaring a class pre-defines a number of "object" methods. i.e. those which operate on a specific object. + defaultconstructor ?dict?:: + This is the default constructor. It sets instance variables from the dictionary. + + constructor ?args...?:: + Invoked after an object is created with the arguments to 'new'. The default implementation + is 'defaultconstructor', but this may be replaced and then the arguments can be + interpreted in a class-specific manner. + destroy:: Destroys the object. This method may be overridden, but note that it should delete the object with {rename $self ""}. This method will also be called @@ -102,10 +112,7 @@ on a specific object. RESERVED METHODS ---------------- -The following methods are special - - constructor:: - If this method exists, it is invoked (with no arguments) after an object is created +The following method is special unknown methodname ...:: If an undefined method is invoked, and this method exists, it is called with the methodname @@ -132,7 +139,15 @@ For example: . $b get balance 1000 -If the 'constructor' method exists, it is invoked just after the object is created +The default constructor is used above. Alternatively, we could define a custom constructor: + + Account method constructor {initial} { + set balance $initial + } + +Now we can do: + + set b [Account new 1000] DECLARING METHODS ----------------- diff --git a/examples/ootest.tcl b/examples/ootest.tcl index 731e46a..b0b3665 100644 --- a/examples/ootest.tcl +++ b/examples/ootest.tcl @@ -13,12 +13,13 @@ puts "Account vars=[Account vars]" puts "Account methods=[Account methods]" puts "" -# Create a constructor. This does validation, but it could -# do other things -Account method constructor {} { - if {$balance < 0} { - error "Can't initialise account with a -ve balance" +# Create a constructor that takes a name and an optional balance. +Account method constructor {who {amount 0}} { + if {$amount < 0} { + error "Can't initialise account for $who with a -ve balance" } + set name $who + set balance $amount } # Now flesh out the class with some methods @@ -42,8 +43,16 @@ Account method describe {} { } } -# Now an instance, initialisition some fields -set a [Account new {name "Bob Smith"}] +# Since the constructor requires an argument, can't +# not provide them +try { + set a [Account] +} on error msg { + puts "Correctly did not create uninitialised account" +} + +# Now an instance, using the constructor for initialisation +set a [Account new "Bob Smith"] puts "---- object Account ----" # We can use class methods on the instance too @@ -70,10 +79,11 @@ class CreditAccount Account { limit -1000 } -CreditAccount method constructor {} { - # Dummy constructor - # If desired, manually invoke the baseclass constructor - super constructor +CreditAccount method constructor {who {amount 0}} { + # Invoke the baseclass constructor, then + # set the amount, which may be -ve + super constructor $who + set balance $amount } # Override the 'withdraw' method to allow overdrawing @@ -96,7 +106,7 @@ puts "CreditAccount methods=[CreditAccount methods]" puts "" puts "---- object CreditAccount ----" -set b [CreditAccount new {name "John White"}] +set b [CreditAccount new "John White" -20] puts b.vars=[$b vars] puts b.classname=[$b classname] @@ -128,8 +138,8 @@ puts "Total of accounts [$a get name] and [$b eval {return "$name (Credit Limit: # Almost. We can't really distinguish those which aren't real classes. # This will get all references which aren't simple lambdas. puts "---- All objects ----" -Account new {name "Terry Green" balance 20} -set x [Account] +Account new "Terry Green" 20 +set x [Account new -] lambda {} {dummy} ref blah blah @@ -34,12 +34,11 @@ proc class {classname {baseclasses {}} classvars} { } # Constructor - proc "$classname new" {{instvars {}}} {classname classvars} { - set instvars [dict merge $classvars $instvars] - + proc "$classname new" {args} {classname classvars} { # This is the object dispatcher for $classname. # Store the classname in both the ref value and tag, for debugging set obj ::[ref $classname $classname "$classname finalize"] + set instvars $classvars proc $obj {method args} {classname instvars} { if {![exists -command "$classname $method"]} { if {![exists -command "$classname unknown"]} { @@ -49,9 +48,7 @@ proc class {classname {baseclasses {}} classvars} { } "$classname $method" {*}$args } - if {[exists -command "$classname constructor"]} { - $obj constructor - } + $obj constructor {*}$args return $obj } # Finalizer to invoke destructor during garbage collection @@ -81,6 +78,16 @@ proc class {classname {baseclasses {}} classvars} { }] } # Pre-defined some instance methods + $classname method defaultconstructor {{__vars {}}} { + set __classvars [$self classvars] + foreach __v [dict keys $__vars] { + if {![dict exists $__classvars $__v]} { + return -code error "$classname, $__v is not a class variable" + } + set $__v [dict get $__vars $__v] + } + } + alias "$classname constructor" "$classname defaultconstructor" $classname method destroy {} { rename $self "" } $classname method get {var} { set $var } $classname method eval {{__locals {}} __body} { |