]> gitweb.factorcode.org Git - factor.git/commitdiff
classes.predicate: fix dispatch
authorJohn Benediktsson <mrjbq7@gmail.com>
Fri, 13 Oct 2023 18:39:46 +0000 (11:39 -0700)
committerJohn Benediktsson <mrjbq7@gmail.com>
Fri, 13 Oct 2023 18:39:46 +0000 (11:39 -0700)
core/classes/algebra/algebra.factor
core/classes/predicate/predicate-tests.factor
core/classes/predicate/predicate.factor
core/syntax/syntax.factor

index b3193b7fcac86e26fbbfde425a56ff51c9e77ec5..d1c6a0988df373916562cf5d257bc3b3a814c09e 100644 (file)
@@ -50,15 +50,15 @@ M: anonymous-complement class-name
     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 ;
index 1246bb08022c5edd9905e410e8e222fc7ffe7e72..e9be629113df50e3c9cffc659bd37adb6a047cf0 100644 (file)
@@ -21,6 +21,15 @@ M: positive abs ;
 { 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 ;
index 31639c4f0cc712c82c89ac19995fe0b3a4bc1d2d..51d5c3e852cb7e84d379ead3908aa413f8e3720f 100644 (file)
@@ -54,7 +54,3 @@ M: anonymous-predicate instance?
 
 M: anonymous-predicate class-name
     class>> class-name ;
-
-M: anonymous-predicate normalize-class
-    class>> normalize-class ;
-
index 4ed6168956c9d1bce3924e90a62d00c6555ff546..295d15157e6b83171c9c248027e3fdcf7a707113 100644 (file)
@@ -273,7 +273,7 @@ IN: bootstrap.syntax
     ] define-core-syntax
 
     "predicate{" [
-        \ } [ <anonymous-predicate> ] parse-literal
+        \ } [ first2 <anonymous-predicate> ] parse-literal
     ] define-core-syntax
 
     "intersection{" [