]> gitweb.factorcode.org Git - factor.git/blobdiff - basis/vocabs/metadata/metadata.factor
use reject instead of [ ... not ] filter.
[factor.git] / basis / vocabs / metadata / metadata.factor
index 5048b0edd065f880ac48a673df7a9bda9c82fc2c..a89c581ea469f586af71f81c1243ae197ff48a23 100644 (file)
@@ -1,10 +1,10 @@
 ! Copyright (C) 2009, 2010 Slava Pestov, Joe Groff.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays assocs io.directories io.encodings.utf8
-io.files io.pathnames kernel make math.parser memoize sequences
-sets sorting summary vocabs vocabs.loader words system
-classes.algebra combinators.short-circuit fry continuations
-namespaces ;
+USING: accessors arrays assocs classes.algebra
+combinators.short-circuit continuations io.directories
+io.encodings.utf8 io.files io.pathnames kernel make math.parser
+memoize namespaces sequences sets summary system vocabs
+vocabs.loader words ;
 IN: vocabs.metadata
 
 : check-vocab ( vocab -- vocab )
@@ -14,8 +14,6 @@ MEMO: vocab-file-contents ( vocab name -- seq )
     vocab-append-path dup
     [ dup exists? [ utf8 file-lines ] [ drop f ] if ] when ;
 
-: ?delete-file ( pathname -- ) '[ _ delete-file ] ignore-errors ;
-
 : set-vocab-file-contents ( seq vocab name -- )
     dupd vocab-append-path [
         swap [ ?delete-file ] [ swap utf8 set-file-lines ] if-empty
@@ -94,7 +92,7 @@ ERROR: bad-platform name ;
 
 : vocab-platforms ( vocab -- platforms )
     dup vocab-platforms-path vocab-file-contents
-    [ dup "system" lookup [ ] [ bad-platform ] ?if ] map ;
+    [ dup "system" lookup-word [ ] [ bad-platform ] ?if ] map ;
 
 : set-vocab-platforms ( platforms vocab -- )
     [ [ name>> ] map ] dip
@@ -103,15 +101,24 @@ ERROR: bad-platform name ;
 : supported-platform? ( platforms -- ? )
     [ t ] [ [ os swap class<= ] any? ] if-empty ;
 
-: unportable? ( vocab -- ? )
+: don't-load? ( vocab -- ? )
     {
-        [ vocab-tags "untested" swap member? ]
+        [ vocab-tags "not loaded" swap member? ]
         [ vocab-platforms supported-platform? not ]
     } 1|| ;
 
+: filter-don't-load ( vocabs -- vocabs' )
+    [ vocab-name don't-load? ] reject ;
+
+: don't-test? ( vocab -- ? )
+    vocab-tags "not tested" swap member? ;
+
+: filter-don't-test ( vocabs -- vocabs' )
+    [ don't-test? ] reject ;
+
 TUPLE: unsupported-platform vocab requires ;
 
-: unsupported-platform ( vocab requires -- )
+: throw-unsupported-platform ( vocab requires -- )
     \ unsupported-platform boa throw-continue ;
 
 M: unsupported-platform summary
@@ -119,5 +126,5 @@ M: unsupported-platform summary
 
 [
     dup vocab-platforms dup supported-platform?
-    [ 2drop ] [ [ vocab-name ] dip unsupported-platform ] if
+    [ 2drop ] [ [ vocab-name ] dip throw-unsupported-platform ] if
 ] check-vocab-hook set-global