generic.math: eliminate a redundant fixnum check, separate out the fixnum dispatch hack.
parent
0948479743
commit
77b5aaa62c
|
@ -97,6 +97,14 @@ SYMBOL: generic-word
|
||||||
[ [ { ratio complex } ] dip make-math-method-table tuple-dispatch ] 2bi
|
[ [ { ratio complex } ] dip make-math-method-table tuple-dispatch ] 2bi
|
||||||
tuple swap 2array prefix tag-dispatch ; inline
|
tuple swap 2array prefix tag-dispatch ; inline
|
||||||
|
|
||||||
|
: fixnum-dispatch ( word quot -- word quot' )
|
||||||
|
[ dup fixnum bootstrap-word dup math-method ]
|
||||||
|
[
|
||||||
|
dup length 3 - cut unclip
|
||||||
|
[ length 2 - ] [ nth ] bi prefix append
|
||||||
|
] bi*
|
||||||
|
[ if ] 2curry [ 2dup both-fixnums? ] prepend ;
|
||||||
|
|
||||||
PRIVATE>
|
PRIVATE>
|
||||||
|
|
||||||
SINGLETON: math-combination
|
SINGLETON: math-combination
|
||||||
|
@ -106,18 +114,14 @@ M: math-combination make-default-method
|
||||||
|
|
||||||
M: math-combination perform-combination
|
M: math-combination perform-combination
|
||||||
drop dup generic-word [
|
drop dup generic-word [
|
||||||
dup
|
dup [ over ] [
|
||||||
[ fixnum bootstrap-word dup math-method ]
|
|
||||||
[
|
|
||||||
[ over ] [
|
|
||||||
dup math-class? [
|
dup math-class? [
|
||||||
[ dup ] [ math-method ] with with math-dispatch-step
|
[ dup ] [ math-method ] with with math-dispatch-step
|
||||||
] [
|
] [
|
||||||
drop object-method
|
drop object-method
|
||||||
] if
|
] if
|
||||||
] with math-dispatch-step
|
] with math-dispatch-step
|
||||||
] bi
|
fixnum-dispatch
|
||||||
[ if ] 2curry [ 2dup both-fixnums? ] prepend
|
|
||||||
define
|
define
|
||||||
] with-variable ;
|
] with-variable ;
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue