Clean up some duplication in annotate/deep-annotate

db4
Doug Coleman 2011-08-26 17:11:50 -05:00
parent 4d3ae36674
commit 8d4ba7e2b6
1 changed files with 11 additions and 6 deletions

View File

@ -36,24 +36,29 @@ M: cannot-annotate-twice summary drop "Cannot annotate a word twice" ;
cannot-annotate-twice cannot-annotate-twice
] when ; ] when ;
: annotate-generic ( word quot -- )
[ "methods" word-prop values ] dip each ; inline
: prepare-annotate ( word quot -- word quot quot )
[ check-annotate-twice ] dip
[ dup def>> 2dup "unannotated-def" set-word-prop ] dip ;
GENERIC# (annotate) 1 ( word quot -- ) GENERIC# (annotate) 1 ( word quot -- )
M: generic (annotate) M: generic (annotate)
[ "methods" word-prop values ] dip '[ _ (annotate) ] each ; '[ _ (annotate) ] annotate-generic ;
M: word (annotate) M: word (annotate)
[ check-annotate-twice ] dip prepare-annotate
[ dup def>> 2dup "unannotated-def" set-word-prop ] dip
call( old -- new ) define ; call( old -- new ) define ;
GENERIC# (deep-annotate) 1 ( word quot -- ) GENERIC# (deep-annotate) 1 ( word quot -- )
M: generic (deep-annotate) M: generic (deep-annotate)
[ "methods" word-prop values ] dip '[ _ (deep-annotate) ] each ; '[ _ (deep-annotate) ] annotate-generic ;
M: word (deep-annotate) M: word (deep-annotate)
[ check-annotate-twice ] dip prepare-annotate
[ dup def>> 2dup "unannotated-def" set-word-prop ] dip
'[ dup callable? [ _ call( old -- new ) ] when ] deep-map define ; '[ dup callable? [ _ call( old -- new ) ] when ] deep-map define ;
PRIVATE> PRIVATE>