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

Try to optimize generic dispatch to speed up + on fixnums, nth on arrays for example

db4
Slava Pestov 2008-11-13 03:51:04 -06:00
parent cfa82cb474
commit ef6206d4bb
2 changed files with 17 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
core/generic/math/math.factor
View File

@ -3,7 +3,7 @@
USING: arrays generic hashtables kernel kernel.private math USING: arrays generic hashtables kernel kernel.private math
namespaces make sequences words quotations layouts combinators namespaces make sequences words quotations layouts combinators
sequences.private classes classes.builtin classes.algebra sequences.private classes classes.builtin classes.algebra
definitions math.order ; definitions math.order math.private ;
IN: generic.math IN: generic.math
PREDICATE: math-class < class PREDICATE: math-class < class
@ -62,13 +62,17 @@ ERROR: no-math-method left right generic ;
2drop object-method 2drop object-method
] if ; ] if ;
SYMBOL: picker
: math-vtable ( picker quot -- quot ) : math-vtable ( picker quot -- quot )
[ [
>r swap picker set
, \ tag , picker get , [ tag 0 eq? ] %
num-tags get [ bootstrap-type>class ] num-tags get swap [ bootstrap-type>class ] prepose map
r> compose map , unclip ,
\ dispatch , [
picker get , [ tag 1 fixnum-fast ] % , \ dispatch ,
] [ ] make , \ if ,
] [ ] make ; inline ] [ ] make ; inline
TUPLE: math-combination ; TUPLE: math-combination ;
@ -85,8 +89,7 @@ M: math-combination perform-combination
] [ ] [
over object-method over object-method
] if nip ] if nip
] math-vtable nip ] math-vtable nip define ;
define ;
PREDICATE: math-generic < generic ( word -- ? ) PREDICATE: math-generic < generic ( word -- ? )
"combination" word-prop math-combination? ; "combination" word-prop math-combination? ;

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

@ -22,13 +22,14 @@ C: <lo-tag-dispatch-engine> lo-tag-dispatch-engine
"type" word-prop "type" word-prop
] if ; ] if ;
: sort-tags ( assoc -- alist ) >alist sort-keys reverse ;
M: lo-tag-dispatch-engine engine>quot M: lo-tag-dispatch-engine engine>quot
methods>> engines>quots* methods>> engines>quots*
[ >r lo-tag-number r> ] assoc-map [ >r lo-tag-number r> ] assoc-map
[ [
picker % [ tag ] % [ picker % [ tag ] % [
>alist sort-keys reverse sort-tags linear-dispatch-quot
linear-dispatch-quot
] [ ] [
num-tags get direct-dispatch-quot num-tags get direct-dispatch-quot
] if-small? % ] if-small? %
@ -51,10 +52,11 @@ C: <hi-tag-dispatch-engine> hi-tag-dispatch-engine
\ hi-tag def>> ; \ 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 hi-tag-number r> ] assoc-map
[ [
picker % hi-tag-quot % [ picker % hi-tag-quot % [
linear-dispatch-quot sort-tags linear-dispatch-quot
] [ ] [
num-tags get , \ fixnum-fast , num-tags get , \ fixnum-fast ,
[ >r num-tags get - r> ] assoc-map [ >r num-tags get - r> ] assoc-map