! Example:
! MODEL-TUPLE: my-tuple a b c ;
! 1 2 3 <my-tuple> ! boa constructor automatically defined
! dup b>> . ! prints 2
! dup a-model>> my-control swap add-connection
! 7 >>a ! will notify my-control

: lookup-writer-word ( slot -- writer )
    name>> "(>>" ")" surround "accessors" lookup ;

: lookup-reader-word ( slot -- reader )
    name>> ">>" append "accessors" lookup ;

: model-reader-word ( slot -- model-reader-word )
    name>> "-model>>" append "accessors" create ;

SLOT: models

: writer-body ( slot -- quot ) model-reader-word '[ _ execute set-model ] ;
: reader-body ( slot -- quot ) model-reader-word '[ _ execute value>> ] ;
: constructor-body ( num-slots class -- quot )
    [ '[ [ <model> ] _ napply ] ] dip
    '[ _ boa ] append ;

: define-model-reader ( class slot -- )
    [ model-reader-word ] [ reader-quot ] [ reader-props ] tri define-typecheck ;

: override-writer ( class slot -- )
    [ lookup-writer-word create-method ] keep
    writer-body define ;

: override-reader ( class slot -- )
    [ lookup-reader-word create-method ] keep
    reader-body define ;

: override-accessors ( final-class slots -- )
    [
        [ define-model-reader ]
        [ override-writer ]
        [ override-reader ] 2tri
    ] with each ;

: define-constructor ( num-slots class -- )
    [ constructor-body ] keep
    name>> "<" ">" surround create-in
    swap define ;

:: define-model-tuple ( class superclass slots -- )
    class superclass slots define-tuple-class    
    [let | slots-with-super [ class all-slots ] |
        class slots-with-super override-accessors
        slots-with-super length class define-constructor ] ;


: MODEL-TUPLE: parse-tuple-definition define-model-tuple ; parsing