steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Rice

db4
Slava Pestov 2008-10-23 05:28:04 -05:00
parent 885adc8dc9
commit 95eb0f696b
1 changed files with 5 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
core/generic/standard/engines/tag/tag.factor
View File

@ -43,17 +43,19 @@ C: <hi-tag-dispatch-engine> hi-tag-dispatch-engine
: num-hi-tags ( -- n ) num-types get num-tags get - ; : num-hi-tags ( -- n ) num-types get num-tags get - ;
: hi-tag-number ( class -- n ) : hi-tag-number ( class -- n )
"type" word-prop num-tags get - ; "type" word-prop ;
: hi-tag-quot ( -- quot ) : hi-tag-quot ( -- quot )
\ hi-tag def>> num-tags get [ fixnum-fast ] curry compose ; \ hi-tag def>> ;
M: hi-tag-dispatch-engine engine>quot M: hi-tag-dispatch-engine engine>quot
methods>> engines>quots* [ >r hi-tag-number r> ] assoc-map methods>> engines>quots* [ >r "type" word-prop r> ] assoc-map
[ [
picker % hi-tag-quot % [ picker % hi-tag-quot % [
linear-dispatch-quot linear-dispatch-quot
] [ ] [
num-tags get , \ fixnum-fast ,
[ >r num-tags get - r> ] assoc-map
num-hi-tags direct-dispatch-quot num-hi-tags direct-dispatch-quot
] if-small? % ] if-small? %
] [ ] make ; ] [ ] make ;