         [ define-tuple-slots ]
         [ define-tuple-predicate ]
         [ define-tuple-prototype ]
-        [ define-tuple-constructor ]
-        [ define-tuple-initial-quots ]
     } cleave ;
 
 : define-new-tuple-class ( class superclass slots -- )


: define-tuple-layout ( class -- )
    dup make-tuple-layout "layout" set-word-prop ;

: define-tuple-constructor ( class -- )
    {
        { [ dup initial-quots? ] [ "initial-quots" ] }
        { [ dup "prototype" word-prop ] [ "prototype" ] }
        [ f ]
    } cond "constructor" set-word-prop ;

: define-tuple-initial-quots ( class -- )
    dup all-slots [ initial-quot>> ] filter
    [
        [
            [ initial-quot>> , (( -- obj )) , \ call-effect , \ over , ]
            [ offset>> , ] bi \ set-slot ,
        ] each
    ] [ ] make "initial-quots-setter" set-word-prop ;

: set-initial-quots ( tuple -- tuple' )
    dup class "initial-quots-setter" word-prop call( obj -- obj ) ;

: calculate-initial-value ( slot-spec -- value )
    dup initial>> [

M: tuple hashcode* tuple-hashcode ;

M: tuple-class new
    dup "prototype" word-prop [
        first2 [ (clone) ] dip [ call( obj -- obj ) ] when*
    ] [
        tuple-layout <tuple>
    ] ?if ;

M: tuple-class boa
    [ "boa-check" word-prop [ call ] when* ]
