classes.algebra: change (flatten-class) to use arrays.
parent
738113d524
commit
80bd0feaef
|
@ -288,5 +288,5 @@ ERROR: topological-sort-failed ;
|
|||
[ ] [ [ class<= ] most ] map-reduce
|
||||
] if-empty ;
|
||||
|
||||
: flatten-class ( class -- assoc )
|
||||
[ (flatten-class) ] H{ } make ;
|
||||
: flatten-class ( class -- seq )
|
||||
[ (flatten-class) ] { } make members ;
|
||||
|
|
|
@ -26,7 +26,7 @@ M: builtin-class rank-class drop 0 ;
|
|||
|
||||
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? ;
|
||||
|
||||
|
|
|
@ -46,9 +46,9 @@ M: intersection-class (flatten-class)
|
|||
|
||||
M: anonymous-intersection (flatten-class)
|
||||
participants>> [ full-cover ] [
|
||||
[ flatten-class keys ]
|
||||
[ flatten-class ]
|
||||
[ intersect-flattened-classes ] map-reduce
|
||||
[ dup ,, ] each
|
||||
%
|
||||
] if-empty ;
|
||||
|
||||
M: anonymous-intersection class-name
|
||||
|
|
|
@ -358,7 +358,7 @@ M: tuple-class rank-class drop 1 ;
|
|||
M: tuple-class 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?)
|
||||
{
|
||||
|
|
|
@ -22,8 +22,7 @@ M: class union-of-builtins?
|
|||
drop f ;
|
||||
|
||||
: fast-union-mask ( class -- n )
|
||||
[ 0 ] dip flatten-class
|
||||
[ drop class>type 2^ bitor ] assoc-each ;
|
||||
flatten-class 0 [ class>type 2^ bitor ] each ;
|
||||
|
||||
: empty-union-predicate-quot ( class -- quot )
|
||||
drop [ drop f ] ;
|
||||
|
|
|
@ -81,8 +81,7 @@ C: <predicate-engine> predicate-engine
|
|||
] change-at ;
|
||||
|
||||
: flatten-method ( method class assoc -- )
|
||||
over flatten-class keys
|
||||
[ swap push-method ] 2with with each ;
|
||||
over flatten-class [ swap push-method ] 2with with each ;
|
||||
|
||||
: flatten-methods ( assoc -- assoc' )
|
||||
H{ } clone [ [ swapd flatten-method ] curry assoc-each ] keep ;
|
||||
|
|
Loading…
Reference in New Issue