(define-class) ( word props -- )

Vocabulary

classes.private

Inputs

word	an object
props	an object

Outputs

None

Definition

USING: accessors assocs classes combinators kernel quotations
words ;

IN: classes.private

: (define-class) ( word props -- )
    reset-caches 2dup "metaclass" of check-metaclass {
        [ 2drop update-map- ]
        [
            2drop dup class?
            [ reset-class ] [ implementors-map+ ] if
        ]
        [ 2drop ?define-symbol ]
        [ drop [ assoc-union ] curry change-props drop ]
        [
            2drop dup create-predicate-word
            [ 1quotation "predicate" set-word-prop ]
            [ swap "predicating" set-word-prop ] 2bi
        ]
        [ 2drop t "class" set-word-prop ]
        [ 2drop f "defining-class" set-word-prop ]
        [ 2drop update-map+ ]
        [ nip ?metaclass-changed ]
    } 3cleave ;