new is inlined in the propagation pass when the class is known

db4
Daniel Ehrenberg 2009-07-14 14:16:39 -05:00
parent bf54aebcc1
commit bb06facb01
3 changed files with 26 additions and 10 deletions

View File

@ -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

View File

@ -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

View File

@ -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