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

Merge branch 'master' of git://factorcode.org/git/factor

db4
Doug Coleman 2009-08-01 23:47:40 -05:00
parent d8c9247b0e e01fc93812
commit de5a42c9f7
3 changed files with 16 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
basis/compiler/tree/propagation/call-effect/call-effect-tests.factor
View File

@ -49,3 +49,7 @@ IN: compiler.tree.propagation.call-effect.tests
[ f ] [ [ [ [ ] [ 1 ] if ] ] final-info first infer-value ] unit-test
[ f ] [ [ [ 1 ] '[ @ ] ] final-info first infer-value ] unit-test
[ f ] [ [ dup drop ] final-info first infer-value ] unit-test
! This should not hang
[ ] [ [ [ dup call( quot -- ) ] dup call( quot -- ) ] final-info drop ] unit-test
[ ] [ [ [ dup curry call( quot -- ) ] dup curry call( quot -- ) ] final-info drop ] unit-test

10
basis/compiler/tree/propagation/call-effect/call-effect.factor
View File

@ -3,7 +3,8 @@
USING: accessors combinators combinators.private effects fry
kernel kernel.private make sequences continuations quotations
words math stack-checker stack-checker.transforms
compiler.tree.propagation.info slots.private ;
compiler.tree.propagation.info
compiler.tree.propagation.inlining ;
IN: compiler.tree.propagation.call-effect
! call( and execute( have complex expansions.
@ -130,8 +131,9 @@ ERROR: uninferable ;
: (infer-value) ( value-info -- effect )
dup class>> {
{ \ quotation [
literal>> [ uninferable ] unless* cached-effect
dup +unknown+ = [ uninferable ] when
literal>> [ uninferable ] unless*
dup already-inlined? [ uninferable ] when
cached-effect dup +unknown+ = [ uninferable ] when
] }
{ \ curry [
slots>> third (infer-value)
@ -151,7 +153,7 @@ ERROR: uninferable ;
: (value>quot) ( value-info -- quot )
dup class>> {
{ \ quotation [ literal>> '[ drop @ ] ] }
{ \ quotation [ literal>> dup remember-inlining '[ drop @ ] ] }
{ \ curry [
slots>> third (value>quot)
'[ [ obj>> ] [ quot>> @ ] bi ]

8
basis/compiler/tree/propagation/inlining/inlining.factor
View File

@ -163,13 +163,17 @@ DEFER: (flat-length)
SYMBOL: history
: already-inlined? ( obj -- ? ) history get memq? ;
: add-to-history ( obj -- ) history [ swap suffix ] change ;
: remember-inlining ( word -- )
[ inlining-count get inc-at ]
[ history [ swap suffix ] change ]
[ add-to-history ]
bi ;
:: inline-word ( #call word -- ? )
word history get memq? [ f ] [
word already-inlined? [ f ] [
#call word splicing-body [
[
word remember-inlining