Prototype Pattern in Tcl

EKB: This is a simple implementation of Steve Yegge's Prototype Pattern (or modeling approach, since he argues that it is actually a way to model programs and not just a pattern). (And see the extra-sleek 8.6 implementation by DKF farther down the page.)

Description

The idea is that it offers an alternative to class inheritance, in which you generalize from specific cases. Inheritance goes something like this:

  1. "B is like A" becomes "new B <- A"
  2. "But unlike A, whose property p1 is foo, B's p1 property is bar" becomes "B set p1 bar"
  3. "Also, B has a property p2 that A doesn't have, with value baz" becomes "B set p2 baz"

Aside from inheritance it is just a subset of dict.

Apparently this is a structure available in some languages used for gaming and is also available in JavaScript.

start of excerpt From Yegge's article

At a high level, every implementation of the Properties Pattern has the same core API. It's the core API for any collection that maps names to values:

  • get(name)
  • put(name, value)
  • has(name)
  • remove(name)

There are typically also ways to iterate over the properties, optionally with a filter of some sort.

So the simplest implementation of the Properties Pattern is a Map of some sort. The objects in your system are Maps, and their elements are Properties.

The next step in expressive power is to reserve a special property name to represent the (optional) parent link. You can call it "parent", or "class", or "prototype", or "mommy", or anything you like. If present, it points to another Map.

Now that you have a parent link, you can enhance the semantics of get, put, has and remove to follow the parent pointer if the specified property isn't in the object's list. This is largely straightforward, with a few catches that we'll discuss below. But you should be able to envision how you'd do it without too much thought.

At this point you have a full-fledged Prototype Pattern implementation. All it took was a parent link!

From here the pattern can expand in many directions, and we'll cover a few of the interesting ones in the remainder of this article.

end of excerpt From Yegge's article

AM 2008-12-09: The article by Yegge mentions the language Self - so, you might want to have a look at the it, too. One obvious flaw in the article is that it does not mention Tcl, but I must say I like the Self approach ...

Here is my Tcl implementation:

# Basic data object is a "property list", implemented as a dict

# Needed API is:
#  obj get name
#  obj put name value
#  obj has name
#  obj remove name

# Also need a creation command (here called "new")

# To follow the "properties pattern", there also needs to be
# a "parent" property. Here are the rules:
#  - Recurse up the list of parents when looking for a property
#  - If you set a value, set in the child, not the parent, even if
#    the parent has the property
#  - When you clear a property, clear only in the child

namespace eval pp {
    variable prototypes
    dict set prototypes root parent NULL
}

proc pp::new {obj <- parent} {
    variable prototypes
    
    dict set prototypes $obj parent $parent
    proc $obj {cmd args} {
        variable prototypes
        
        # Peel off just the proc name
        regexp {::(.*)$} [lindex [dict get [info frame 1] cmd] 0] -> self
        lassign $args name value
        switch -- $cmd {
            get {
                set obj $self
                while 1 {
                    if [dict exists $prototypes $obj $name] {
                        return [dict get $prototypes $obj $name]
                    }
                    set obj [dict get $prototypes $obj parent]
                    if {$obj eq "NULL"} {
                        break
                    }
                }
                error "$self: $name not found"
            }
            put {
                dict set prototypes $self $name $value
                return $value
            }
            has {
                set obj $self
                while 1 {
                    lassign $args name 
                    if [dict exists $prototypes $obj $name] {
                        return 1
                    }
                    set obj [dict get $prototypes $obj parent]
                    if {$obj eq "NULL"} {
                        break
                    }
                }
                return 0
            }
            remove {
                dict unset prototypes $self $name
                return {}
            }
            default {
                error "Available commands: get, put, has, remove"
            }
        }
    }
}

An example of use:

% pp::new test <- root
% pp::test put a foo
foo
% pp::test get a
foo
% pp::new test2 <- test
% pp::test2 get a
foo
% pp::test2 put b bar
% pp::test2 get b
bar
% pp::test2 remove b
% pp::test2 get b
test2: b not found
% pp::test2 remove a    <----- This does nothing, since it is defined in the parent
% pp::test2 get a
foo

RS 2008-12-08: The interface described above seems to me to be just a subset of dict: dict get/set/exists/unset...

EKB That is almost true. The thing that makes it more than dict is the recursive passing up to the parent. It's an alternative to class inheritance. I've added a note above to clarify.


DKF: Here's how to do it in 8.6:

oo::class create prototype {
    variable state parent
    constructor {{parentObject {}}} {
        array set state {}
        set parent $parentObject
    }
    method get name {
        if {[info exists state($name)] || $parent eq ""} {
            return $state($name)
        } else {
            return [$parent get $name]
        }
    }
    method put {name value} {
        set state($name) $value
        return
    }
    method has name {
        if {[info exists state($name)]} {
            return 1
        } elseif {$parent eq ""} {
            return 0
        } else {
            return [$parent has $name]
        }
    }
    method remove name {
        unset state($name)
    }
}

Isn't that just about as simple as could be?

EKB That's lovely. I haven't got 8.6 installed... and this will pass up to the parent?

DKF: Oooh, missed that part. Try this slightly longer version...

EKB Cool. And only barely longer.

See Also

Frames
A knowledge-representation format proposed by Marvin Minsky.
IO
A prototype-based programming language inspired by Smalltalk that employs recursive lookup for all name resolution.
tclssg
Nested configuration settings reflect the prototype pattern described on this page