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

Trying to fix mixin semantics

release
Slava Pestov 2010-01-20 20:26:47 +13:00
parent d3db7e0225
commit af41dc6169
7 changed files with 44 additions and 32 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
basis/grouping/grouping.factor
View File

@ -1,4 +1,4 @@
! Copyright (C) 2005, 2009 Slava Pestov.
! Copyright (C) 2005, 2010 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel math math.order strings arrays vectors sequences
sequences.private accessors fry ;
@ -20,14 +20,16 @@ M: chunking-seq set-nth group@ <slice> 0 swap copy ;
M: chunking-seq like drop { } like ; inline
INSTANCE: chunking-seq sequence
MIXIN: subseq-chunking
INSTANCE: subseq-chunking sequence
M: subseq-chunking nth group@ subseq ; inline
MIXIN: slice-chunking
INSTANCE: slice-chunking sequence
M: slice-chunking nth group@ <slice> ; inline
M: slice-chunking nth-unsafe group@ slice boa ; inline

18
core/classes/algebra/algebra-tests.factor
View File

@ -79,9 +79,9 @@ INSTANCE: union-with-one-member mixin-with-one-member
[ t ] [ a1 b1 class-or a1 c1 class-or class-and a1 class<= ] unit-test
[ t ] [ growable tuple sequence class-and class<= ] unit-test
[ f ] [ growable tuple sequence class-and class<= ] unit-test
[ t ] [ growable assoc class-and tuple class<= ] unit-test
[ f ] [ growable assoc class-and tuple class<= ] unit-test
[ t ] [ object \ f \ f class-not class-or class<= ] unit-test
@ -130,6 +130,11 @@ INSTANCE: union-with-one-member mixin-with-one-member
[ t ] [ a union-with-one-member class<= ] unit-test
[ f ] [ union-with-one-member class-not integer class<= ] unit-test
MIXIN: empty-mixin
[ f ] [ empty-mixin class-not null class<= ] unit-test
[ f ] [ empty-mixin null class<= ] unit-test
! class-and
: class-and* ( cls1 cls2 cls3 -- ? ) [ class-and ] dip class= ;
@ -146,8 +151,6 @@ INSTANCE: union-with-one-member mixin-with-one-member
[ t ] [ slice reversed null class-and* ] unit-test
[ t ] [ \ f class-not \ f null class-and* ] unit-test
[ t ] [ vector virtual-sequence null class-and* ] unit-test
[ t ] [ vector array class-not vector class-and* ] unit-test
! class-or
@ -160,7 +163,8 @@ INSTANCE: union-with-one-member mixin-with-one-member
! classes-intersect?
[ t ] [ both tuple classes-intersect? ] unit-test
[ f ] [ vector virtual-sequence classes-intersect? ] unit-test
[ t ] [ vector virtual-sequence classes-intersect? ] unit-test
[ t ] [ number vector class-or sequence classes-intersect? ] unit-test
@ -188,11 +192,11 @@ INSTANCE: union-with-one-member mixin-with-one-member
[ t ] [ union-with-one-member object classes-intersect? ] unit-test
[ t ] [ a mixin-with-one-member classes-intersect? ] unit-test
[ f ] [ fixnum mixin-with-one-member classes-intersect? ] unit-test
[ t ] [ fixnum mixin-with-one-member classes-intersect? ] unit-test
[ t ] [ object mixin-with-one-member classes-intersect? ] unit-test
[ t ] [ mixin-with-one-member a classes-intersect? ] unit-test
[ f ] [ mixin-with-one-member fixnum classes-intersect? ] unit-test
[ t ] [ mixin-with-one-member fixnum classes-intersect? ] unit-test
[ t ] [ mixin-with-one-member object classes-intersect? ] unit-test
! class=

17
core/classes/algebra/algebra.factor
View File

@ -1,4 +1,4 @@
! Copyright (C) 2004, 2008 Slava Pestov.
! Copyright (C) 2004, 2010 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel classes combinators accessors sequences arrays
vectors assocs namespaces words sorting layouts math hashtables
@ -34,12 +34,9 @@ DEFER: (class-or)
GENERIC: (flatten-class) ( class -- )
: normalize-class ( class -- class' )
{
{ [ dup members ] [ members <anonymous-union> normalize-class ] }
{ [ dup participants ] [ participants <anonymous-intersection> normalize-class ] }
[ ]
} cond ;
GENERIC: normalize-class ( class -- class' )
M: object normalize-class ;
PRIVATE>
@ -93,6 +90,9 @@ M: word valid-class? drop f ;
: left-anonymous-union<= ( first second -- ? )
[ members>> ] dip [ class<= ] curry all? ;
: right-union<= ( first second -- ? )
members [ class<= ] with any? ;
: right-anonymous-union<= ( first second -- ? )
members>> [ class<= ] with any? ;
@ -117,7 +117,7 @@ M: word valid-class? drop f ;
[ class-not normalize-class ] map
<anonymous-union>
] }
[ <anonymous-complement> ]
[ drop object ]
} cond ;
: left-anonymous-complement<= ( first second -- ? )
@ -147,6 +147,7 @@ PREDICATE: empty-intersection < anonymous-intersection participants>> empty? ;
{ [ over anonymous-union? ] [ left-anonymous-union<= ] }
{ [ over anonymous-intersection? ] [ left-anonymous-intersection<= ] }
{ [ over nontrivial-anonymous-complement? ] [ left-anonymous-complement<= ] }
{ [ dup members ] [ right-union<= ] }
{ [ dup anonymous-union? ] [ right-anonymous-union<= ] }
{ [ dup anonymous-intersection? ] [ right-anonymous-intersection<= ] }
{ [ dup anonymous-complement? ] [ class>> classes-intersect? not ] }

5
core/classes/intersection/intersection.factor
View File

@ -1,4 +1,4 @@
! Copyright (C) 2004, 2008 Slava Pestov.
! Copyright (C) 2004, 2010 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: words accessors sequences kernel assocs combinators classes
classes.algebra classes.algebra.private classes.builtin
@ -33,6 +33,9 @@ M: intersection-class rank-class drop 2 ;
M: intersection-class instance?
"participants" word-prop [ instance? ] with all? ;
M: intersection-class normalize-class
participants <anonymous-intersection> normalize-class ;
M: intersection-class (flatten-class)
participants <anonymous-intersection> (flatten-class) ;

4
core/classes/mixin/mixin-tests.factor
View File

@ -38,8 +38,8 @@ MIXIN: mx1
INSTANCE: integer mx1
[ t ] [ integer mx1 class<= ] unit-test
[ t ] [ mx1 integer class<= ] unit-test
[ t ] [ mx1 number class<= ] unit-test
[ f ] [ mx1 integer class<= ] unit-test
[ f ] [ mx1 number class<= ] unit-test
"IN: classes.mixin.tests USE: arrays INSTANCE: array mx1" eval( -- )

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

@ -1,11 +1,17 @@
! Copyright (C) 2004, 2009 Slava Pestov.
! Copyright (C) 2004, 2010 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: classes classes.union words kernel sequences
definitions combinators arrays assocs generic accessors ;
USING: classes classes.algebra classes.algebra.private
classes.union words kernel sequences definitions combinators
arrays assocs generic accessors ;
IN: classes.mixin
PREDICATE: mixin-class < union-class "mixin" word-prop ;
M: mixin-class normalize-class ;
M: mixin-class (classes-intersect?)
members [ classes-intersect? ] with any? ;
M: mixin-class reset-class
[ call-next-method ] [ { "mixin" } reset-props ] bi ;
@ -53,13 +59,6 @@ TUPLE: check-mixin-class class ;
GENERIC# add-mixin-instance 1 ( class mixin -- )
M: class add-mixin-instance
#! Note: we call update-classes on the new member, not the
#! mixin. This ensures that we only have to update the
#! methods whose specializer intersects the new member, not
#! the entire mixin (since the other mixin members are not
#! affected at all). Also, all usages of the mixin will get
#! updated by transitivity; the mixins usages appear in
#! class-usages of the member, now that it's been added.
[ 2drop ] [
[ (add-mixin-instance) ] 2keep
[ nip ] [ [ new-class? ] either? ] 2bi

5
core/classes/union/union.factor
View File

@ -1,4 +1,4 @@
! Copyright (C) 2004, 2008 Slava Pestov.
! Copyright (C) 2004, 2010 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: words sequences kernel assocs combinators classes
classes.algebra classes.algebra.private namespaces arrays math
@ -34,5 +34,8 @@ M: union-class rank-class drop 2 ;
M: union-class instance?
"members" word-prop [ instance? ] with any? ;
M: union-class normalize-class
members <anonymous-union> normalize-class ;
M: union-class (flatten-class)
members <anonymous-union> (flatten-class) ;