classes.tuple: speed up slots>tuple a bit.
Only get the initial values that are needed to supplement provided values.master
parent
dc3a11bfc4
commit
fed5fd7c50
|
@ -82,15 +82,13 @@ M: tuple class-of layout-of 2 slot { word } declare ; inline
|
||||||
] 2each
|
] 2each
|
||||||
] if-bootstrapping ; inline
|
] if-bootstrapping ; inline
|
||||||
|
|
||||||
: initial-values ( class -- seq )
|
|
||||||
all-slots [ initial>> ] map ; inline
|
|
||||||
|
|
||||||
: pad-slots ( seq class -- seq' class )
|
: pad-slots ( seq class -- seq' class )
|
||||||
[ initial-values ] keep
|
[ all-slots ] keep 2over [ length ] bi@ 2dup > [
|
||||||
2over [ length ] bi@ 2dup > [
|
|
||||||
[ nip swap ] 2dip too-many-slots
|
[ nip swap ] 2dip too-many-slots
|
||||||
] [
|
] [
|
||||||
drop [ tail append ] curry dip
|
drop [
|
||||||
|
tail-slice [ [ initial>> ] map append ] unless-empty
|
||||||
|
] curry dip
|
||||||
] if ; inline
|
] if ; inline
|
||||||
|
|
||||||
PRIVATE>
|
PRIVATE>
|
||||||
|
@ -174,6 +172,9 @@ M: object final-class? drop f ;
|
||||||
: define-boa-check ( class -- )
|
: define-boa-check ( class -- )
|
||||||
dup boa-check-quot "boa-check" set-word-prop ;
|
dup boa-check-quot "boa-check" set-word-prop ;
|
||||||
|
|
||||||
|
: initial-values ( class -- seq )
|
||||||
|
all-slots [ initial>> ] map ; inline
|
||||||
|
|
||||||
: tuple-prototype ( class -- prototype )
|
: tuple-prototype ( class -- prototype )
|
||||||
[ initial-values ] keep over [ ] any?
|
[ initial-values ] keep over [ ] any?
|
||||||
[ slots>tuple ] [ 2drop f ] if ;
|
[ slots>tuple ] [ 2drop f ] if ;
|
||||||
|
|
Loading…
Reference in New Issue