]> gitweb.factorcode.org Git - factor.git/blobdiff - core/generic/generic.factor
Fixing everything for mandatory stack effects
[factor.git] / core / generic / generic.factor
index c99de94ded4cb9430315a6f283a47066d2f461f5..fb9820008a575abef8584fc07a5c4f3e7ff98c0c 100755 (executable)
@@ -56,8 +56,19 @@ TUPLE: check-method class generic ;
         \ check-method boa throw
     ] unless ; inline
 
-: with-methods ( generic quot -- )
-    swap [ "methods" word-prop swap call ] keep make-generic ;
+: affected-methods ( class generic -- seq )
+    "methods" word-prop swap
+    [ nip classes-intersect? ] curry assoc-filter
+    values ;
+
+: update-generic ( class generic -- )
+    [ affected-methods [ +called+ changed-definition ] each ]
+    [ make-generic ]
+    bi ;
+
+: with-methods ( class generic quot -- )
+    [ [ "methods" word-prop ] dip call ]
+    [ drop update-generic ] 3bi ;
     inline
 
 : method-word-name ( class word -- string )
@@ -140,15 +151,17 @@ M: method-body forget*
 M: method-body smart-usage
     "method-generic" word-prop smart-usage ;
 
-: implementors* ( classes -- words )
+GENERIC: implementors ( class/classes -- seq )
+
+M: class implementors
+    all-words [ "methods" word-prop key? ] with filter ;
+
+M: assoc implementors
     all-words [
-        "methods" word-prop keys
+         "methods" word-prop keys
         swap [ key? ] curry contains?
     ] with filter ;
 
-: implementors ( class -- seq )
-    dup associate implementors* ;
-
 : forget-methods ( class -- )
     [ implementors ] [ [ swap 2array ] curry ] bi map forget-all ;
 
@@ -164,8 +177,8 @@ M: class forget* ( class -- )
     ]
     [ call-next-method ] bi ;
 
-M: assoc update-methods ( assoc -- )
-    implementors* [ make-generic ] each ;
+M: assoc update-methods ( class assoc -- )
+    implementors [ update-generic ] with each ;
 
 : define-generic ( word combination -- )
     over "combination" word-prop over = [