\ 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 )
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 ;
]
[ 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 = [