"Maybe" Accessor

Factor has support for standard "object-oriented" programming concepts such as classes and attributes. Recently, I wanted to "get an attributes value (setting it first if not set)". I came up with a technique to do this, and wanted to share.

First, some background. Defining a class "person" with attributes "name" and "age":

TUPLE: person name age ;

You can then create a new instance with all attributes unset (e.g., set to f):

( scratchpad ) person new .
T{ person }

Or, you can create an instance by order of arguments (taking values from the stack):

( scratchpad ) "Frank" 20 person boa .
T{ person { name "Frank" } { age 20 } }

Alternatively, you can use the accessors vocabulary to set attributes on the instance:

( scratchpad ) person new 
( scratchpad ) "Frank" >>name 20 >>age .
T{ person { name "Frank" } { age 20 } }

Reading attributes from an instance:

( scratchpad ) "Frank" 20 person boa
( scratchpad ) name>>
"Frank"

Sometimes it is useful to change attributes:

( scratchpad ) "Frank" 20 person boa 
( scratchpad ) [ 1 + ] change-age .
T{ person { name "Frank" } { age 21 } }

If you want to change an attribute only if it was not already set, we could use change-name. The definition of change-name is built using "get" and "set" words (first get the current value, then call the quotation and set the result as the new value).

( scratchpad ) person new 
( scratchpad ) [ "Frank" or ] change-name .
T{ person { name "Frank" } }

Coming back to the original problem: how can I "set an attribute if not set and then immediately get the attribute"? Using the "get, set, or change" concepts, we could first change the name, then get the current value:

( scratchpad ) person new 
( scratchpad ) [ "Frank" or ] change-name
( scratchpad ) name>> .
"Frank"

One problem with that is it performs two get's and a set (and potentially does work in the quotation that is not necessary if a value already exists). It would be more efficient if we could do something like:

( scratchpad ) person new 
( scratchpad ) dup name>> [ nip ] [ "Frank" [ >>name drop ] keep ] if* .
"Frank"

But that code is pretty verbose, and obscures our intentions. It would be better if we could define a maybe-name word that performs this action:

: maybe-name ( object quot: ( -- x ) -- value )
    [ [ >>name drop ] keep ] compose
    [ dup name>> [ nip ] ] dip if* ; inline

Perhaps a better name for this word could be ?name>> or |name>>, both of which I like also.

This works like so:

( scratchpad ) person new
( scratchpad ) [ "Joe" ] maybe-name .
"Joe"

( scratchpad ) "Frank" 30 person boa 
( scratchpad ) [ "Joe" ] maybe-name .
"Frank"

It would be even better if we could define these words automatically for every attribute in the class (the way the accessors vocab does). Well, this isn't too difficult (although the code that builds the word programmatically is a little involved). We can take advantage of the very dynamic nature of Factor:

USING: accessors arrays kernel make quotations sequences
slots words ;

IN: accessors.maybe

: maybe-word ( name -- word )
    "maybe-" prepend "accessors" create ;

: define-maybe ( name -- )
    dup maybe-word dup deferred? [
        [
            over setter-word \ drop 2array >quotation
            [ keep ] curry , \ compose ,
            swap reader-word [ dup ] swap 1quotation compose
            [ [ nip ] ] compose , \ dip , \ if* ,
        ] [ ] make (( object quot: ( -- x ) -- value )) define-inline
    ] [ 2drop ] if ;

: define-maybe-accessors ( class -- )
    "slots" word-prop [
        dup read-only>> [ drop ] [ name>> define-maybe ] if
    ] each ;

Calling it will define a "maybe" accessor word for each slot in the tuple:

( scratchpad ) << person define-maybe-accessors >>

This code and some tests is available on my Github.