new is inlined in the propagation pass when the class is known
parent
bf54aebcc1
commit
bb06facb01
|
@ -6,7 +6,7 @@ math.parser math.order layouts words sequences sequences.private
|
||||||
arrays assocs classes classes.algebra combinators generic.math
|
arrays assocs classes classes.algebra combinators generic.math
|
||||||
splitting fry locals classes.tuple alien.accessors
|
splitting fry locals classes.tuple alien.accessors
|
||||||
classes.tuple.private slots.private definitions strings.private
|
classes.tuple.private slots.private definitions strings.private
|
||||||
vectors hashtables generic
|
vectors hashtables generic quotations
|
||||||
stack-checker.state
|
stack-checker.state
|
||||||
compiler.tree.comparisons
|
compiler.tree.comparisons
|
||||||
compiler.tree.propagation.info
|
compiler.tree.propagation.info
|
||||||
|
@ -360,3 +360,15 @@ generic-comparison-ops [
|
||||||
[ swap equal? ] f ?
|
[ swap equal? ] f ?
|
||||||
] [ drop f ] if
|
] [ drop f ] if
|
||||||
] "custom-inlining" set-word-prop
|
] "custom-inlining" set-word-prop
|
||||||
|
|
||||||
|
: inline-new ( class -- quot/f )
|
||||||
|
dup tuple-class? [
|
||||||
|
dup inlined-dependency depends-on
|
||||||
|
[ all-slots [ initial>> literalize ] map ]
|
||||||
|
[ tuple-layout '[ _ <tuple-boa> ] ]
|
||||||
|
bi append [ drop ] prepend >quotation
|
||||||
|
] [ drop f ] if ;
|
||||||
|
|
||||||
|
\ new [
|
||||||
|
in-d>> first value-info literal>> inline-new
|
||||||
|
] "custom-inlining" set-word-prop
|
||||||
|
|
|
@ -704,3 +704,16 @@ TUPLE: circle me ;
|
||||||
|
|
||||||
! Joe found an oversight
|
! Joe found an oversight
|
||||||
[ V{ integer } ] [ [ >integer ] final-classes ] unit-test
|
[ V{ integer } ] [ [ >integer ] final-classes ] unit-test
|
||||||
|
|
||||||
|
TUPLE: foo bar ;
|
||||||
|
|
||||||
|
[ t ] [ [ foo new ] { new } inlined? ] unit-test
|
||||||
|
|
||||||
|
GENERIC: whatever ( x -- y )
|
||||||
|
M: number whatever drop foo ;
|
||||||
|
|
||||||
|
[ t ] [ [ 1 whatever new ] { new } inlined? ] unit-test
|
||||||
|
|
||||||
|
: that-thing ( -- class ) foo ;
|
||||||
|
|
||||||
|
[ f ] [ [ that-thing new ] { new } inlined? ] unit-test
|
||||||
|
|
|
@ -108,15 +108,6 @@ IN: stack-checker.transforms
|
||||||
|
|
||||||
\ boa t "no-compile" set-word-prop
|
\ boa t "no-compile" set-word-prop
|
||||||
|
|
||||||
\ new [
|
|
||||||
dup tuple-class? [
|
|
||||||
dup inlined-dependency depends-on
|
|
||||||
[ all-slots [ initial>> literalize ] map ]
|
|
||||||
[ tuple-layout '[ _ <tuple-boa> ] ]
|
|
||||||
bi append
|
|
||||||
] [ drop f ] if
|
|
||||||
] 1 define-transform
|
|
||||||
|
|
||||||
! Fast at for integer maps
|
! Fast at for integer maps
|
||||||
CONSTANT: lookup-table-at-max 256
|
CONSTANT: lookup-table-at-max 256
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue