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

classes.algebra: change (flatten-class) to use arrays.

clean-macosx-x86-64
John Benediktsson 2019-10-24 14:12:26 -07:00
parent 738113d524
commit 80bd0feaef
6 changed files with 8 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -288,5 +288,5 @@ ERROR: topological-sort-failed ;
[ ] [ [ class<= ] most ] map-reduce [ ] [ [ class<= ] most ] map-reduce
] if-empty ; ] if-empty ;
: flatten-class ( class -- assoc ) : flatten-class ( class -- seq )
[ (flatten-class) ] H{ } make ; [ (flatten-class) ] { } make members ;

2
core/classes/builtin/builtin.factor
View File

@ -26,7 +26,7 @@ M: builtin-class rank-class drop 0 ;
M: builtin-class instance? [ tag ] [ class>type ] bi* eq? ; M: builtin-class instance? [ tag ] [ class>type ] bi* eq? ;
M: builtin-class (flatten-class) dup ,, ; M: builtin-class (flatten-class) , ;
M: builtin-class (classes-intersect?) eq? ; M: builtin-class (classes-intersect?) eq? ;

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

@ -46,9 +46,9 @@ M: intersection-class (flatten-class)
M: anonymous-intersection (flatten-class) M: anonymous-intersection (flatten-class)
participants>> [ full-cover ] [ participants>> [ full-cover ] [
[ flatten-class keys ] [ flatten-class ]
[ intersect-flattened-classes ] map-reduce [ intersect-flattened-classes ] map-reduce
[ dup ,, ] each %
] if-empty ; ] if-empty ;
M: anonymous-intersection class-name M: anonymous-intersection class-name

2
core/classes/tuple/tuple.factor
View File

@ -358,7 +358,7 @@ M: tuple-class rank-class drop 1 ;
M: tuple-class instance? M: tuple-class instance?
dup echelon-of layout-class-offset tuple-instance? ; dup echelon-of layout-class-offset tuple-instance? ;
M: tuple-class (flatten-class) dup ,, ; M: tuple-class (flatten-class) , ;
M: tuple-class (classes-intersect?) M: tuple-class (classes-intersect?)
{ {

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

@ -22,8 +22,7 @@ M: class union-of-builtins?
drop f ; drop f ;
: fast-union-mask ( class -- n ) : fast-union-mask ( class -- n )
[ 0 ] dip flatten-class flatten-class 0 [ class>type 2^ bitor ] each ;
[ drop class>type 2^ bitor ] assoc-each ;
: empty-union-predicate-quot ( class -- quot ) : empty-union-predicate-quot ( class -- quot )
drop [ drop f ] ; drop [ drop f ] ;

3
core/generic/single/single.factor
View File

@ -81,8 +81,7 @@ C: <predicate-engine> predicate-engine
] change-at ; ] change-at ;
: flatten-method ( method class assoc -- ) : flatten-method ( method class assoc -- )
over flatten-class keys over flatten-class [ swap push-method ] 2with with each ;
[ swap push-method ] 2with with each ;
: flatten-methods ( assoc -- assoc' ) : flatten-methods ( assoc -- assoc' )
H{ } clone [ [ swapd flatten-method ] curry assoc-each ] keep ; H{ } clone [ [ swapd flatten-method ] curry assoc-each ] keep ;