Generic word cleanups continued

slava 2006-08-02 07:10:09 +00:00
parent 8df790ec36
commit f9b8f32e67
6 changed files with 13 additions and 12 deletions

View File

@ -67,11 +67,8 @@ words ;
: will-inline-method ( node -- quot/t ) : will-inline-method ( node -- quot/t )
#! t indicates failure #! t indicates failure
dup inlining-class dup [ dup inlining-class dup
swap node-param "methods" word-prop hash [ swap node-param method ] [ 2drop t ] if ;
] [
2drop t
] if ;
: inline-standard-method ( node -- node ) : inline-standard-method ( node -- node )
dup will-inline-method (inline-method) ; dup will-inline-method (inline-method) ;

View File

@ -1,7 +1,7 @@
! Copyright (C) 2006 Slava Pestov. ! Copyright (C) 2006 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
IN: generic IN: generic
USING: words kernel sequences namespaces ; USING: words kernel sequences namespaces hashtables ;
PREDICATE: compound generic ( word -- ? ) PREDICATE: compound generic ( word -- ? )
"combination" word-prop ; "combination" word-prop ;
@ -28,3 +28,6 @@ M: generic definer drop \ G: ;
bootstrap-combination bootstrap-combination
dupd "combination" set-word-prop dupd "combination" set-word-prop
dup init-methods ?make-generic ; dup init-methods ?make-generic ;
: generic-tags ( word -- seq )
"methods" word-prop hash-keys [ types ] map concat prune ;

View File

@ -37,8 +37,7 @@ TUPLE: no-math-method left right generic ;
3dup <no-math-method> throw ; 3dup <no-math-method> throw ;
: applicable-method ( generic class -- quot ) : applicable-method ( generic class -- quot )
over "methods" word-prop hash over method [ ] [ [ no-math-method ] curry ] ?if ;
[ ] [ [ no-math-method ] curry ] ?if ;
: object-method ( generic -- quot ) : object-method ( generic -- quot )
object bootstrap-word applicable-method ; object bootstrap-word applicable-method ;

View File

@ -3,6 +3,9 @@
IN: generic IN: generic
USING: words hashtables sequences arrays errors kernel ; USING: words hashtables sequences arrays errors kernel ;
: method ( class generic -- quot )
"methods" word-prop hash ;
: methods ( generic -- alist ) : methods ( generic -- alist )
"methods" word-prop hash>alist "methods" word-prop hash>alist
[ [ first ] 2apply class-compare ] sort ; [ [ first ] 2apply class-compare ] sort ;

View File

@ -76,9 +76,6 @@ TUPLE: no-method object generic ;
: big-generic ( dispatch# word n dispatcher -- def ) : big-generic ( dispatch# word n dispatcher -- def )
[ >r pick picker % r> , <vtable> , \ dispatch , ] [ ] make ; [ >r pick picker % r> , <vtable> , \ dispatch , ] [ ] make ;
: generic-tags ( word -- seq )
"methods" word-prop hash-keys [ types ] map concat prune ;
: tag-generic? ( word -- ? ) : tag-generic? ( word -- ? )
#! If all the types we dispatch upon can be identified #! If all the types we dispatch upon can be identified
#! based on tag alone, we change the dispatcher primitive #! based on tag alone, we change the dispatcher primitive

View File

@ -12,7 +12,7 @@ M: compound definition word-def t ;
M: generic definition "combination" word-prop t ; M: generic definition "combination" word-prop t ;
M: method-spec definition first2 "methods" word-prop hash t ; M: method-spec definition first2 method t ;
GENERIC: see ( spec -- ) GENERIC: see ( spec -- )
@ -54,6 +54,8 @@ M: generic see-methods*
M: class see-methods* M: class see-methods*
dup implementors [ 2array ] map-with ; dup implementors [ 2array ] map-with ;
M: word see-methods* drop f ;
: see-methods ( word -- ) : see-methods ( word -- )
see-methods* [ see ] each ; see-methods* [ see ] each ;