Add more class algebra opeations
parent
af09eae727
commit
0582f45fcb
|
@ -13,8 +13,6 @@ IN: classes.algebra.tests
|
|||
\ flatten-class must-infer
|
||||
\ flatten-builtin-class must-infer
|
||||
|
||||
: class= ( cls1 cls2 -- ? ) [ class<= ] [ swap class<= ] 2bi and ;
|
||||
|
||||
: class-and* ( cls1 cls2 cls3 -- ? ) >r class-and r> class= ;
|
||||
|
||||
: class-or* ( cls1 cls2 cls3 -- ? ) >r class-or r> class= ;
|
||||
|
|
|
@ -186,6 +186,9 @@ M: anonymous-complement (classes-intersect?)
|
|||
[ [ rank-class ] bi@ < ]
|
||||
} cond ;
|
||||
|
||||
: class= ( first second -- ? )
|
||||
[ class<= ] [ swap class<= ] 2bi and ;
|
||||
|
||||
: largest-class ( seq -- n elt )
|
||||
dup [ [ class< ] with contains? not ] curry find-last
|
||||
[ "Topological sort failed" throw ] unless* ;
|
||||
|
|
|
@ -22,8 +22,14 @@ PREDICATE: math-class < class
|
|||
[ drop { 100 100 } ]
|
||||
} cond ;
|
||||
|
||||
: math-class-max ( class class -- class )
|
||||
[ [ math-precedence ] compare +gt+ eq? ] most ;
|
||||
: math-class<=> ( class1 class2 -- class )
|
||||
[ math-precedence ] compare +gt+ eq? ;
|
||||
|
||||
: math-class-max ( class1 class2 -- class )
|
||||
[ math-class<=> ] most ;
|
||||
|
||||
: math-class-min ( class1 class2 -- class )
|
||||
[ swap math-class<=> ] most ;
|
||||
|
||||
: (math-upgrade) ( max class -- quot )
|
||||
dupd = [ drop [ ] ] [ "coercer" word-prop [ ] or ] if ;
|
||||
|
|
Loading…
Reference in New Issue