From caa89de401a1f5a9a3d1823842581be4acac9195 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Thu, 26 Mar 2009 21:25:21 -0500
Subject: [PATCH] hints: allow hints on generic words, these are propagated to
 each method

---
 basis/hints/hints.factor | 18 +++++++++++-------
 1 file changed, 11 insertions(+), 7 deletions(-)

diff --git a/basis/hints/hints.factor b/basis/hints/hints.factor
index 52684e55f5..597367c353 100644
--- a/basis/hints/hints.factor
+++ b/basis/hints/hints.factor
@@ -34,16 +34,18 @@ M: object specializer-declaration class ;
         [ specializer-declaration ] map '[ _ declare ] pick append
     ] { } map>assoc ;
 
+: specialize-quot ( quot specializer -- quot' )
+    specializer-cases alist>quot ;
+
 : method-declaration ( method -- quot )
     [ "method-generic" word-prop dispatch# object <array> ]
     [ "method-class" word-prop ]
     bi prefix ;
 
 : specialize-method ( quot method -- quot' )
-    method-declaration '[ _ declare ] prepend ;
-
-: specialize-quot ( quot specializer -- quot' )
-    specializer-cases alist>quot ;
+    [ method-declaration '[ _ declare ] prepend ]
+    [ "method-generic" word-prop "specializer" word-prop ] bi
+    [ specialize-quot ] when* ;
 
 : standard-method? ( method -- ? )
     dup method-body? [
@@ -52,9 +54,11 @@ M: object specializer-declaration class ;
 
 : specialized-def ( word -- quot )
     [ def>> ] keep
-    [ dup standard-method? [ specialize-method ] [ drop ] if ]
-    [ "specializer" word-prop [ specialize-quot ] when* ]
-    bi ;
+    dup generic? [ drop ] [
+        [ dup standard-method? [ specialize-method ] [ drop ] if ]
+        [ "specializer" word-prop [ specialize-quot ] when* ]
+        bi
+    ] if ;
 
 : specialized-length ( specializer -- n )
     dup [ array? ] all? [ first ] when length ;