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

Moving mixin instances between source files works better now

db4
Slava Pestov 2009-03-16 00:04:34 -05:00
parent 0c39ed30e1
commit fe8b55bb90
1 changed files with 24 additions and 27 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -1,4 +1,4 @@
! Copyright (C) 2004, 2008 Slava Pestov. ! Copyright (C) 2004, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: classes classes.union words kernel sequences USING: classes classes.union words kernel sequences
definitions combinators arrays assocs generic accessors ; definitions combinators arrays assocs generic accessors ;
@ -21,8 +21,9 @@ M: mixin-class rank-class drop 3 ;
drop drop
] [ ] [
[ { } redefine-mixin-class ] [ { } redefine-mixin-class ]
[ H{ } clone "instances" set-word-prop ]
[ update-classes ] [ update-classes ]
bi tri
] if ; ] if ;
TUPLE: check-mixin-class class ; TUPLE: check-mixin-class class ;
@ -44,6 +45,11 @@ TUPLE: check-mixin-class class ;
[ [ update-class ] each ] [ [ update-class ] each ]
[ implementors [ remake-generic ] each ] bi ; [ implementors [ remake-generic ] each ] bi ;
: (add-mixin-instance) ( class mixin -- )
[ [ suffix ] change-mixin-class ]
[ [ f ] 2dip "instances" word-prop set-at ]
2bi ;
: add-mixin-instance ( class mixin -- ) : add-mixin-instance ( class mixin -- )
#! Note: we call update-classes on the new member, not the #! Note: we call update-classes on the new member, not the
#! mixin. This ensures that we only have to update the #! mixin. This ensures that we only have to update the
@ -53,20 +59,22 @@ TUPLE: check-mixin-class class ;
#! updated by transitivity; the mixins usages appear in #! updated by transitivity; the mixins usages appear in
#! class-usages of the member, now that it's been added. #! class-usages of the member, now that it's been added.
[ 2drop ] [ [ 2drop ] [
[ [ suffix ] change-mixin-class ] 2keep [ (add-mixin-instance) ] 2keep
[ nip ] [ [ new-class? ] either? ] 2bi [ [ nip ] [ [ new-class? ] either? ] 2bi
update-classes/new [ update-classes/new ] [ update-classes ] if
] [
update-classes
] if
] if-mixin-member? ; ] if-mixin-member? ;
: (remove-mixin-instance) ( class mixin -- )
[ [ swap remove ] change-mixin-class ]
[ "instances" word-prop delete-at ]
2bi ;
: remove-mixin-instance ( class mixin -- ) : remove-mixin-instance ( class mixin -- )
#! The order of the three clauses is important here. The last #! The order of the three clauses is important here. The last
#! one must come after the other two so that the entries it #! one must come after the other two so that the entries it
#! adds to changed-generics are not overwritten. #! adds to changed-generics are not overwritten.
[ [
[ [ swap remove ] change-mixin-class ] [ (remove-mixin-instance) ]
[ nip update-classes ] [ nip update-classes ]
[ class-usages update-methods ] [ class-usages update-methods ]
2tri 2tri
@ -76,32 +84,21 @@ M: mixin-class class-forgotten remove-mixin-instance ;
! 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 loc class mixin ; TUPLE: mixin-instance class mixin ;
M: mixin-instance equal? C: <mixin-instance> mixin-instance
{
{ [ over mixin-instance? not ] [ f ] }
{ [ 2dup [ class>> ] bi@ = not ] [ f ] }
{ [ 2dup [ mixin>> ] bi@ = not ] [ f ] }
[ t ]
} cond 2nip ;
M: mixin-instance hashcode* : >mixin-instance< ( mixin-instance -- class mixin )
[ class>> ] [ mixin>> ] bi 2array hashcode* ; [ class>> ] [ mixin>> ] bi ; inline
: <mixin-instance> ( class mixin -- definition ) M: mixin-instance where >mixin-instance< "instances" word-prop at ;
mixin-instance new
swap >>mixin
swap >>class ;
M: mixin-instance where loc>> ; M: mixin-instance set-where >mixin-instance< "instances" word-prop set-at ;
M: mixin-instance set-where (>>loc) ;
M: mixin-instance definer drop \ INSTANCE: f ; M: mixin-instance definer drop \ INSTANCE: f ;
M: mixin-instance definition drop f ; M: mixin-instance definition drop f ;
M: mixin-instance forget* M: mixin-instance forget*
[ class>> ] [ mixin>> ] bi >mixin-instance<
dup mixin-class? [ remove-mixin-instance ] [ 2drop ] if ; dup mixin-class? [ remove-mixin-instance ] [ 2drop ] if ;