Move changes from work/ to core/ and basis/

diff --git a/basis/bootstrap/syntax.factor b/basis/bootstrap/syntax.factor
index 414edcd8305fa401b427a249cfacf16ca9dabaad..b2a737bbd1fee42356877d384d2e1381a10790c2 100644 (file)
--- a/basis/bootstrap/syntax.factor
+++ b/basis/bootstrap/syntax.factor
@@ -88,6 +88,7 @@ IN: bootstrap.syntax
         "maybe{"
         "union{"
         "intersection{"
+        "predicate{"
         "initial:"
         "read-only"
         "call("

diff --git a/basis/prettyprint/backend/backend.factor b/basis/prettyprint/backend/backend.factor
index c14f99e5dc2c32fad988ecb5d5e24c8d9ec39717..292770f5e5c89cd45c0631ebc6aea6ebc457fda3 100644 (file)
--- a/basis/prettyprint/backend/backend.factor
+++ b/basis/prettyprint/backend/backend.factor
@@ -234,6 +234,7 @@ M: hash-set pprint-delims drop \ HS{ \ } ;
 M: anonymous-union pprint-delims drop \ union{ \ } ;
 M: anonymous-intersection pprint-delims drop \ intersection{ \ } ;
 M: anonymous-complement pprint-delims drop \ not{ \ } ;
+M: anonymous-predicate pprint-delims drop \ predicate{ \ } ;
 M: maybe pprint-delims drop \ maybe{ \ } ;
 
 M: object >pprint-sequence ;
@@ -247,6 +248,7 @@ M: hash-set >pprint-sequence sets:members ;
 M: anonymous-union >pprint-sequence members>> ;
 M: anonymous-intersection >pprint-sequence participants>> ;
 M: anonymous-complement >pprint-sequence class>> 1array ;
+M: anonymous-predicate >pprint-sequence [ class>> ] [ predicate>> ] bi 2array ;
 M: maybe >pprint-sequence class>> 1array ;
 
 : class-slot-sequence ( class slots -- sequence )
@@ -314,6 +316,7 @@ M: hash-set pprint* pprint-object ;
 M: anonymous-union pprint* pprint-object ;
 M: anonymous-intersection pprint* pprint-object ;
 M: anonymous-complement pprint* pprint-object ;
+M: anonymous-predicate pprint* pprint-object ;
 M: maybe pprint* pprint-object ;
 
 M: wrapper pprint*

diff --git a/basis/stack-checker/dependencies/dependencies.factor b/basis/stack-checker/dependencies/dependencies.factor
index fa61197dfcf66e37c34ce9c3c9477ad8ae0e2e39..4128c030e8df9a4d3407dac497b37a6f81f3d525 100644 (file)
--- a/basis/stack-checker/dependencies/dependencies.factor
+++ b/basis/stack-checker/dependencies/dependencies.factor
@@ -46,6 +46,9 @@ M: anonymous-intersection add-depends-on-class
 M: anonymous-complement add-depends-on-class
     class>> add-depends-on-class ;
 
+M: anonymous-predicate add-depends-on-class
+    class>> add-depends-on-class ;
+
 GENERIC: add-depends-on-c-type ( c-type -- )
 
 M: void add-depends-on-c-type drop ;

diff --git a/core/classes/algebra/algebra.factor b/core/classes/algebra/algebra.factor
index 81bd5ea331a82d67ed323f3aced1a1fa55ad59f1..b3193b7fcac86e26fbbfde425a56ff51c9e77ec5 100644 (file)
--- a/core/classes/algebra/algebra.factor
+++ b/core/classes/algebra/algebra.factor
@@ -1,8 +1,8 @@
 ! Copyright (C) 2004, 2010 Slava Pestov.
 ! See https://factorcode.org/license.txt for BSD license.
 USING: accessors arrays assocs classes classes.private
-combinators kernel make math math.order namespaces sequences
-sets sorting vectors ;
+combinators kernel make math math.order namespaces quotations 
+sequences sets sorting vectors ;
 IN: classes.algebra
 
 DEFER: sort-classes
@@ -49,6 +49,20 @@ M: anonymous-complement instance?
 M: anonymous-complement class-name
     class>> class-name ;
 
+
+TUPLE: anonymous-predicate 
+    { class classoid read-only initial: object }
+    { predicate callable read-only initial: [ drop f ] } ;
+
+INSTANCE: anonymous-predicate classoid
+
+: <anonymous-predicate> ( object -- classoid )
+    first2 [ classoid check-instance ] [ quotation check-instance ] bi*
+        anonymous-predicate boa ;
+
+! Used for ordering classes
+M: anonymous-predicate rank-class drop 1.5 ;
+
 DEFER: (class<=)
 
 DEFER: (class-not)
@@ -199,6 +213,9 @@ M: anonymous-intersection (classes-intersect?)
 M: anonymous-complement (classes-intersect?)
     class>> class<= not ;
 
+M: anonymous-predicate (classes-intersect?)
+    class>> classes-intersect? ;
+
 : anonymous-union-and ( first second -- class )
     members>> [ class-and ] with map <anonymous-union> ;
 
@@ -261,6 +278,9 @@ M: anonymous-complement (classes-intersect?)
 M: anonymous-union (flatten-class)
     members>> [ (flatten-class) ] each ;
 
+M: anonymous-predicate (flatten-class)
+    class>> (flatten-class) ;
+
 PRIVATE>
 
 ERROR: topological-sort-failed ;

diff --git a/core/classes/predicate/predicate.factor b/core/classes/predicate/predicate.factor
index 4aaabaa7c4830296b1bfff3daa0ccc2ee9261d92..356a97c10cd43e848547b3a4cd721abfe898855a 100644 (file)
--- a/core/classes/predicate/predicate.factor
+++ b/core/classes/predicate/predicate.factor
@@ -1,7 +1,7 @@
 ! Copyright (C) 2004, 2010 Slava Pestov.
 ! See https://factorcode.org/license.txt for BSD license.
-USING: classes classes.algebra classes.algebra.private
-classes.private kernel words ;
+USING: accessors classes classes.algebra 
+classes.algebra.private classes.private kernel words ;
 IN: classes.predicate
 
 PREDICATE: predicate-class < class
@@ -43,3 +43,18 @@ M: predicate-class (flatten-class)
 
 M: predicate-class (classes-intersect?)
     superclass-of classes-intersect? ;
+
+M: anonymous-predicate predicate-def 
+    '[ _ 2dup instance? 
+        [ predicate>> call( obj -- ? ) ] [ 2drop f ] if ] ;
+
+M: anonymous-predicate instance?
+    2dup class>> instance? 
+        [ predicate>> call( object -- ? ) ] [ 2drop f ] if ;
+
+M: anonymous-predicate class-name
+    class>> class-name ;
+
+M: anonymous-predicate normalize-class
+    class>> normalize-class ;
+

diff --git a/core/generic/generic.factor b/core/generic/generic.factor
index c3b8aa247be646a7ad32d59e435cd28ab11c2ea9..bdf89edc42ce9cd16a4aea40843da0e1b1fa577f 100644 (file)
--- a/core/generic/generic.factor
+++ b/core/generic/generic.factor
@@ -138,6 +138,8 @@ M: anonymous-union implementor-classes members>> ;
 
 M: anonymous-intersection implementor-classes participants>> ;
 
+M: anonymous-predicate implementor-classes class>> 1array ;
+
 : with-implementors ( class generic quot -- )
     [ swap implementor-classes [ implementors-map get at ] map ] dip call ; inline
 

diff --git a/core/syntax/syntax.factor b/core/syntax/syntax.factor
index 10b2568003dac3e8d5ec92838a677d8647906f57..4ed6168956c9d1bce3924e90a62d00c6555ff546 100644 (file)
--- a/core/syntax/syntax.factor
+++ b/core/syntax/syntax.factor
@@ -272,6 +272,10 @@ IN: bootstrap.syntax
         \ } [ <anonymous-union> <anonymous-complement> ] parse-literal
     ] define-core-syntax
 
+    "predicate{" [
+        \ } [ <anonymous-predicate> ] parse-literal
+    ] define-core-syntax
+
     "intersection{" [
          \ } [ <anonymous-intersection> ] parse-literal
     ] define-core-syntax