Generic word cleanups continued
parent
8df790ec36
commit
f9b8f32e67
|
|
@ -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) ;
|
||||||
|
|
|
||||||
|
|
@ -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 ;
|
||||||
|
|
|
||||||
|
|
@ -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 ;
|
||||||
|
|
|
||||||
|
|
@ -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 ;
|
||||||
|
|
|
||||||
|
|
@ -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
|
||||||
|
|
|
||||||
|
|
@ -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 ;
|
||||||
|
|
||||||
|
|
|
||||||
Loading…
Reference in New Issue