Summary  edit

See Also  edit

TOOT with {*}

WHD: A slightly different take

TOOT revisited

NEM: And another one

Yet another object system

Description  edit

• Normal Tcl syntax, using ensembles, e.g., [List length $item]
• OO syntax with polymorphic method dispatch, e.g., [$item length]

set l [::List create a b c d]
set d [::Dict | $l]

• Rewrite to make handling packing-unpacking of values simpler.
• Define everything a bit better, so most functionality is in an object class at the base of the class hierachy.
• Implement inheritance.
• Steal as many interesting features from XOTcl as possible :-)
• Try and make it rely on less tricks, to improve performance (may need Tcl 9 with new features).

# toot.tcl --
#
#   TOOT - Transparent OO for Tcl. This package implements a simple
#   object oriented programming environment, where all values are fully
#   transparent. This is an experiment in how well the worlds of Tcl's
#   transparent values, and OO design, traditionally implemented using handle
#   types, can be combined. The design presented here is a functional view of
#   objects, in that procedures/methods which update a value return the new
#   value. All values are represented as a tagged list of length three:
#
#   {$type | $value}
#
#   The "|" is some sugar, which also helps to disambiguate method calls from
#   construction cases. I was going to use ":", but that interacts badly with
#   Tcl's namespace separator.
#
#   Classes in the system are namespaces which form ensembles. You can use
#   either an OO syntax or a functional syntax when accessing values. When
#   using the OO syntax [$value method args], type is preserved. When using
#   the functional syntax [type method $value $args], the value will
#   automatically be converted to the correct type, in the usual Tcl way (the
#   original value will not change type however). The type command also serves
#   as a type-conversion copy-constructor, which means that you can explicitly
#   create a copy of a value and change it's type. E.g. to get a list object
#   from a dict object, you could do:
#
#   set l [List | $dict]
#
#   Most of the time, this will be unnecessary. This also has the added
#   benefit of transparent serialisation - values can be written to a file and
#   read in at a later date, and will just work (assuming the correct type is
#   still available). Requires auto-expansion of leading word to work
#   correctly, and currently achieves this through a global unknown handler.
#   If TIP 181 passes, then this could be done on a per-namespace basis.
#   Auto-expansion as a core feature for Tcl-9 would rock!
#
# Copyright (c) 2004, Neil Madden.
# License: Tcl/BSD style.

package provide toot 0.1

namespace eval toot {
    namespace export class extract method
}

# Helper for extracting real value
proc toot::extract {value} {
    return [lindex $value 2]
}

# Helper for creating procs which do the right thing
proc toot::method {name arglist body} {
    set arglist [linsert $arglist 0 self]
    uplevel 1 [list proc $name $arglist $body]
}

# Class is itself a class.
namespace eval toot::class { }

proc toot::class {cmd args} {
    uplevel 1 [linsert $args 0 ::toot::class::$cmd]
}

proc toot::class::| {self args} {
    # Copy constructor/instance command
    if {[llength $args] == 0} {
        # Copy constructor
        return [list ::toot::class | [::toot::extract $self]]
    } else {
        # Redispatch - assume uplevel 1 is within correct namespace
        uplevel 1 [linsert $args 1 $self]
    }
}

# Real constructor
proc toot::class::create {name body} {
    # Fully qualify the name
    if {![string match ::* $name]} {
        set ns [uplevel 1 namespace current]
        if {$ns eq "::"} { set ns "" }
        set name ${ns}::$name
    }
    # Create the namespace
    uplevel 1 [list namespace eval $name $body]
    # Create dispatch method
    set body [string map [list %NAME% $name] {
        if {[llength $args] == 0} {
            return [list %NAME% | [::toot::extract $self]]
        } else {
            uplevel 1 [linsert $args 1 [list %NAME% | $self]]
        }
    }]
    uplevel 1 [list proc ${name}::| {self args} $body]

    # Default constructor
    uplevel 1 [list proc ${name}::create {args} [string map [list %N $name] {
        return [list %N | $args]
    }]]
    
    # Create the type-method
    uplevel 1 [list proc $name {args} [string map [list %NAME% $name] {
        uplevel 1 [list namespace eval %NAME% $args]
    }]]

    return [list ::toot::class | [list $name]]
}

# Install unknown handler for auto-expand
if {[llength [info commands ::_toot_unknown]] == 0} {
    rename ::unknown ::_toot_unknown
    proc unknown {cmd args} {
        if {[llength $cmd] > 1} {
            uplevel 1 $cmd $args
        } else {
            uplevel 1 [linsert $args 0 ::_toot_unknown $cmd]
        }
    }
}

# Test stuff
proc test {} {
    namespace import toot::*
    class create List {
        method index {args} {
            return [eval [linsert $args 0 lindex \
                [extract $self] $args]]
        }

        method length {} {
            return [llength [extract $self]]
        }
    
        method append {args} {
            set s [extract $self]
            return [list ::List | [eval lappend s $args]]
        }

        method loop {varname body} {
            uplevel 1 [list ::foreach $varname [extract $self] $body]
        }
    }
    class create Dict {
        method get {key} {
            return [dict get [extract $self] $key]
        }
        method set {args} {
            return [eval ::Dict create [eval [linsert $args 0 \
                dict replace [extract $self]]]]
        }
    }
    # Now some tests
    set l [List create a b c d e f]
    puts "l = $l"
    # Loop
    $l loop item {
        puts "Item = $item"
    }
    # Use dict method
    puts "a = [Dict get $l a]"
    # Convert to dict
    set d [Dict | $l]
    # Set a key
    set d [$d set a "Hello!"]
    # Loop as list
    List loop $d item {
        puts "item = $item"
    }
    puts "d = $d"
    puts "l = $l"
}

Discussion  edit

• How would I define and set "fields" for an object?
• It seems to me that programming a specific method is a bit involved

# a reference handle type
class create Reference {

    variable ref

    method <- {val} {
        variable ref
        set ref([extract $self]) $val
    }

    method -> {} {
         variable ref
         return $ref([extract $self])
    }
}
set a [Reference create foo]
$a <- [List create a b c d e]
$a <- [[$a ->] append f g h]
puts [$a ->]

class create Person {
    method setName {name} {
        set d [dict replace [extract $self] name $name]
        return [list ::Person | $d]
    }
    method getName {} {
        return [dict get [extract $self] name]
    }
    method setAge {age} {
        set d [dict replace [extract $self] age $age]
        return [list ::Person | $d]
    }
    method getAge {} {
        return [dict get [extract $self] age]
    }
}
set neil [Person create name "Neil Madden" age 23]
set neil [$neil setAge 82]
puts "[$neil getName] is [$neil getAge]!"

• every object is by value and carries its class as well as its state: {class | {state...}}
• a call relies on expansion, so "$o meth args..." will be evaluated as "class | {state...} meth args..."
• a reshuffle is needed, to put the method call in the right spot: "class meth {state...} args..."
• ensembles as namespaces would now be useful, turning it into "::class::meth {state...} args ..."
• to make the story complete, methods are defined as: "proc ::class::meth {self args} {...}"

• agree with NEM that a handle is the way to go, name of an array for example
• it would be great to see refcounts work in this context, i.e., array be unset when last handle ref to it goes away
• perhaps it can be done: a special list variant, which knows the 2nd item is a handle
• copies of the list bump the refcount
• stringify when dual rep is lost causes a copy of the handle contents to be inserted, i.e. the name to be dropped
• re-use later creates a new handle, puts contents in it, and proceeds with a handle again
• this has the effect that when dual rep is lost, state is copied, mutability is lost
• but as long as it isn't it's a real handle, with shared mutable content across all copies of the same Tcl_Obj
• not sure this makes sense or works, just wanted to dump it here...

::List length $obj ;# -> ::List length {::List | {state}}
$obj length        ;# -> ::List | {state} length  -> ::List length {::List | {state}} (i.e. same as above)

::List length $obj ;# -> ::List length {| ::List {state}}
$obj length        ;# -> | ::List {state} length  -> ::List length {| ::List {state}}

proc ::| {type state method args} {
    uplevel 1 [linsert $args 0 ${type}::$method [list ::| $type $state]]
}

method foo {a b} {
    $self bar $a $b
}

{| class {the values}}

$x get member

{| class {the values}} get member

| class {the values} get member

toot::class::get {the values} member

{class | {the values}} get member

class | {the values} get member

::toot::dispatch class | {the values} get member

::toot::class::get {the values} member

• Home
• Recent changes
• Help
• WhoAmI/Logout
• Create new page
• Random page
• Previous page
• Next page
• 
  
• Add comments
• Edit
• History
• Edit summary
• References