]> gitweb.factorcode.org Git - factor.git/blobdiff - basis/hints/hints.factor
basis: use lint.vocabs tool to trim using lists
[factor.git] / basis / hints / hints.factor
index 7a3fa323d216cf91885c629480a1e0185a935950..403bb4e12e3c7dd05da1cfd437a6f221d1591760 100644 (file)
@@ -1,16 +1,15 @@
 ! Copyright (C) 2008, 2010 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors arrays assocs byte-arrays byte-vectors classes
-combinators definitions effects fry generic generic.single
-generic.standard hashtables io.binary io.streams.string kernel
-kernel.private math math.integers.private math.parser math.parser.private
-namespaces parser sbufs sequences splitting splitting.private strings
-vectors words ;
+combinators definitions fry generic generic.single
+generic.standard hashtables kernel kernel.private math
+math.parser parser sbufs sequences splitting strings vectors
+words ;
 IN: hints
 
 GENERIC: specializer-predicate ( spec -- quot )
 
-M: class specializer-predicate "predicate" word-prop ;
+M: class specializer-predicate '[ _ instance? ] ;
 
 M: object specializer-predicate '[ _ eq? ] ;
 
@@ -18,15 +17,15 @@ GENERIC: specializer-declaration ( spec -- class )
 
 M: class specializer-declaration ;
 
-M: object specializer-declaration class ;
+M: object specializer-declaration class-of ;
 
 : specializer ( word -- specializer )
     "specializer" word-prop ;
 
 : make-specializer ( specs -- quot )
-    dup length iota <reversed>
+    dup length <iota> <reversed>
     [ (picker) 2array ] 2map
-    [ drop object eq? not ] assoc-filter
+    [ drop object eq? ] assoc-reject
     [ [ t ] ] [
         [ swap specializer-predicate append ] { } assoc>map
         [ ] [ swap [ f ] \ if 3array append [ ] like ] map-reduce
@@ -52,7 +51,7 @@ M: object specializer-declaration class ;
     specializer [ specialize-quot ] when* ;
 
 : standard-method? ( method -- ? )
-    dup method-body? [
+    dup method? [
         "method-generic" word-prop standard-generic?
     ] [ drop f ] if ;
 
@@ -67,73 +66,73 @@ M: object specializer-declaration class ;
 : specialized-length ( specializer -- n )
     dup [ array? ] all? [ first ] when length ;
 
+ERROR: cannot-specialize word specializer ;
+
+: set-specializer ( word specializer -- )
+    over inline-recursive? [ cannot-specialize ] when
+    "specializer" set-word-prop ;
+
 SYNTAX: HINTS:
     scan-object dup wrapper? [ wrapped>> ] when
     [ changed-definition ]
     [ subwords [ changed-definition ] each ]
-    [ parse-definition { } like "specializer" set-word-prop ] tri ;
+    [ parse-definition { } like set-specializer ] tri ;
 
 ! Default specializers
-{ last pop* pop } [
-    { vector } "specializer" set-word-prop
+{ pop* pop push last } [
+    { vector } set-specializer
 ] each
 
-\ push { { vector } { sbuf } } "specializer" set-word-prop
-
-\ last { { vector } } "specializer" set-word-prop
-
-\ set-last { { object vector } } "specializer" set-word-prop
+\ set-last { { object vector } } set-specializer
 
 \ push-all
 { { string sbuf } { array vector } { byte-array byte-vector } }
-"specializer" set-word-prop
+set-specializer
 
-\ append
-{ { string string } { array array } }
-"specializer" set-word-prop
+{ append prepend } [
+    { { string string } { array array } }
+    set-specializer
+] each
+
+{ suffix prefix } [
+    { { string object } { array object } }
+    set-specializer
+] each
 
 \ subseq
 { { fixnum fixnum string } { fixnum fixnum array } }
-"specializer" set-word-prop
+set-specializer
 
 \ reverse!
 { { string } { array } }
-"specializer" set-word-prop
+set-specializer
 
 \ mismatch
 { string string }
-"specializer" set-word-prop
-
-\ >string { sbuf } "specializer" set-word-prop
-
-\ >array { { vector } } "specializer" set-word-prop
-
-\ >vector { { array } { vector } } "specializer" set-word-prop
-
-\ >sbuf { string } "specializer" set-word-prop
-
-\ split, { string string } "specializer" set-word-prop
-
-\ member-eq? { array } "specializer" set-word-prop
+set-specializer
 
-\ member? { array } "specializer" set-word-prop
+\ >string { sbuf } set-specializer
 
-\ assoc-stack { vector } "specializer" set-word-prop
+\ >array { { vector } } set-specializer
 
-\ >le { { fixnum fixnum } { bignum fixnum } } "specializer" set-word-prop
+\ >vector { { array } { vector } } set-specializer
 
-\ >be { { bignum fixnum } { fixnum fixnum } } "specializer" set-word-prop
+\ >sbuf { string } set-specializer
 
-\ base> { string fixnum } "specializer" set-word-prop
+\ split { string string } set-specializer
 
-M\ hashtable at* { { fixnum object } { word object } } "specializer" set-word-prop
+\ member? { { array } { string } } set-specializer
 
-M\ hashtable set-at { { object fixnum object } { object word object } } "specializer" set-word-prop
+\ member-eq? { { array } { string } } set-specializer
 
-\ dec>float { string } "specializer" set-word-prop
+\ assoc-stack { vector } set-specializer
 
-\ hex>float { string } "specializer" set-word-prop
+\ base> { string fixnum } set-specializer
 
-\ string>integer { string fixnum } "specializer" set-word-prop
+M\ hashtable at*
+{ { fixnum object } { word object } }
+set-specializer
 
-\ bignum/f { { bignum bignum } { bignum fixnum } { fixnum bignum } { fixnum fixnum } } "specializer" set-word-prop
+M\ hashtable set-at
+{ { object fixnum object } { object word object } }
+set-specializer