steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

classes.mixin: privacy please

release
Slava Pestov 2010-01-21 04:32:31 +13:00
parent 830e25c70b
commit 8b19b56a1c
1 changed files with 30 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

52
core/classes/mixin/mixin.factor
View File

@ -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 ;