class>> class-name ;
-TUPLE: anonymous-predicate
- { class classoid read-only initial: object }
- { predicate callable read-only initial: [ drop f ] } ;
+TUPLE: anonymous-predicate
+ { class read-only }
+ { predicate read-only } ;
INSTANCE: anonymous-predicate classoid
-: <anonymous-predicate> ( object -- classoid )
- first2 [ classoid check-instance ] [ quotation check-instance ] bi*
- anonymous-predicate boa ;
+: <anonymous-predicate> ( class predicate -- classoid )
+ [ classoid check-instance ] [ quotation check-instance ] bi*
+ anonymous-predicate boa ;
! Used for ordering classes
M: anonymous-predicate rank-class drop 1.5 ;
{ 10 } [ 10 abs ] unit-test
{ 0 } [ 0 abs ] unit-test
+GENERIC: anonymous-abs ( n -- n )
+M: integer anonymous-abs ;
+M: predicate{ integer [ 0 < ] } anonymous-abs -1 * ;
+M: predicate{ integer [ 0 > ] } anonymous-abs ;
+
+{ 10 } [ -10 anonymous-abs ] unit-test
+{ 10 } [ 10 anonymous-abs ] unit-test
+{ 0 } [ 0 anonymous-abs ] unit-test
+
! Bug report from Bruno Deferrari
TUPLE: tuple-a slot ;
TUPLE: tuple-b < tuple-a ;