classes.mixin: privacy please
parent
830e25c70b
commit
8b19b56a1c
|
@ -17,23 +17,6 @@ M: mixin-class reset-class
|
||||||
|
|
||||||
M: mixin-class rank-class drop 3 ;
|
M: mixin-class rank-class drop 3 ;
|
||||||
|
|
||||||
: redefine-mixin-class ( class members -- )
|
|
||||||
[ (define-union-class) ]
|
|
||||||
[ drop t "mixin" set-word-prop ]
|
|
||||||
2bi ;
|
|
||||||
|
|
||||||
: define-mixin-class ( class -- )
|
|
||||||
dup mixin-class? [
|
|
||||||
drop
|
|
||||||
] [
|
|
||||||
{
|
|
||||||
[ { } redefine-mixin-class ]
|
|
||||||
[ H{ } clone "instances" set-word-prop ]
|
|
||||||
[ changed-definition ]
|
|
||||||
[ update-classes ]
|
|
||||||
} cleave
|
|
||||||
] if ;
|
|
||||||
|
|
||||||
TUPLE: check-mixin-class class ;
|
TUPLE: check-mixin-class class ;
|
||||||
|
|
||||||
: check-mixin-class ( mixin -- mixin )
|
: check-mixin-class ( mixin -- mixin )
|
||||||
|
@ -41,6 +24,13 @@ TUPLE: check-mixin-class class ;
|
||||||
\ check-mixin-class boa throw
|
\ check-mixin-class boa throw
|
||||||
] unless ;
|
] unless ;
|
||||||
|
|
||||||
|
<PRIVATE
|
||||||
|
|
||||||
|
: redefine-mixin-class ( class members -- )
|
||||||
|
[ (define-union-class) ]
|
||||||
|
[ drop t "mixin" set-word-prop ]
|
||||||
|
2bi ;
|
||||||
|
|
||||||
: if-mixin-member? ( class mixin true false -- )
|
: if-mixin-member? ( class mixin true false -- )
|
||||||
[ check-mixin-class 2dup members member-eq? ] 2dip if ; inline
|
[ check-mixin-class 2dup members member-eq? ] 2dip if ; inline
|
||||||
|
|
||||||
|
@ -61,11 +51,6 @@ TUPLE: check-mixin-class class ;
|
||||||
[ 2nip [ update-class ] each ]
|
[ 2nip [ update-class ] each ]
|
||||||
} 3cleave ;
|
} 3cleave ;
|
||||||
|
|
||||||
GENERIC# add-mixin-instance 1 ( class mixin -- )
|
|
||||||
|
|
||||||
M: class add-mixin-instance
|
|
||||||
[ 2drop ] [ (add-mixin-instance) ] if-mixin-member? ;
|
|
||||||
|
|
||||||
: (remove-mixin-instance) ( class mixin -- )
|
: (remove-mixin-instance) ( class mixin -- )
|
||||||
#! Call update-methods after removing the member:
|
#! Call update-methods after removing the member:
|
||||||
#! - Call sites of generics specializing on 'mixin'
|
#! - Call sites of generics specializing on 'mixin'
|
||||||
|
@ -79,20 +64,43 @@ M: class add-mixin-instance
|
||||||
[ nip update-methods ]
|
[ nip update-methods ]
|
||||||
} 3cleave ;
|
} 3cleave ;
|
||||||
|
|
||||||
|
PRIVATE>
|
||||||
|
|
||||||
|
GENERIC# add-mixin-instance 1 ( class mixin -- )
|
||||||
|
|
||||||
|
M: class add-mixin-instance
|
||||||
|
[ 2drop ] [ (add-mixin-instance) ] if-mixin-member? ;
|
||||||
|
|
||||||
: remove-mixin-instance ( class mixin -- )
|
: remove-mixin-instance ( class mixin -- )
|
||||||
[ (remove-mixin-instance) ] [ 2drop ] if-mixin-member? ;
|
[ (remove-mixin-instance) ] [ 2drop ] if-mixin-member? ;
|
||||||
|
|
||||||
M: mixin-class class-forgotten remove-mixin-instance ;
|
M: mixin-class class-forgotten remove-mixin-instance ;
|
||||||
|
|
||||||
|
: define-mixin-class ( class -- )
|
||||||
|
dup mixin-class? [
|
||||||
|
drop
|
||||||
|
] [
|
||||||
|
{
|
||||||
|
[ { } redefine-mixin-class ]
|
||||||
|
[ H{ } clone "instances" set-word-prop ]
|
||||||
|
[ changed-definition ]
|
||||||
|
[ update-classes ]
|
||||||
|
} cleave
|
||||||
|
] if ;
|
||||||
|
|
||||||
! Definition protocol implementation ensures that removing an
|
! Definition protocol implementation ensures that removing an
|
||||||
! INSTANCE: declaration from a source file updates the mixin.
|
! INSTANCE: declaration from a source file updates the mixin.
|
||||||
TUPLE: mixin-instance class mixin ;
|
TUPLE: mixin-instance class mixin ;
|
||||||
|
|
||||||
C: <mixin-instance> mixin-instance
|
C: <mixin-instance> mixin-instance
|
||||||
|
|
||||||
|
<PRIVATE
|
||||||
|
|
||||||
: >mixin-instance< ( mixin-instance -- class mixin )
|
: >mixin-instance< ( mixin-instance -- class mixin )
|
||||||
[ class>> ] [ mixin>> ] bi ; inline
|
[ class>> ] [ mixin>> ] bi ; inline
|
||||||
|
|
||||||
|
PRIVATE>
|
||||||
|
|
||||||
M: mixin-instance where >mixin-instance< "instances" word-prop at ;
|
M: mixin-instance where >mixin-instance< "instances" word-prop at ;
|
||||||
|
|
||||||
M: mixin-instance set-where >mixin-instance< "instances" word-prop set-at ;
|
M: mixin-instance set-where >mixin-instance< "instances" word-prop set-at ;
|
||||||
|
|
Loading…
Reference in New Issue