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

compiler.tree.propagation.call-effect: changing back call-effect-unsafe?, changing it made all images to large for some reason

db4
Björn Lindqvist 2015-03-17 15:47:06 +00:00 committed by John Benediktsson
parent 92165e4ee7
commit eda9535ce6
2 changed files with 12 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -16,6 +16,12 @@ IN: compiler.tree.propagation.call-effect.tests
100 [ sq ] ( a -- b ) call-effect-slow>quot call 100 [ sq ] ( a -- b ) call-effect-slow>quot call
] unit-test ] unit-test
! call-effect-unsafe?
{ f t } [
[ ] ( m -- ) call-effect-unsafe?
[ ] ( x -- x ) call-effect-unsafe?
] unit-test
[ t ] [ \ + ( a b -- c ) execute-effect-unsafe? ] unit-test [ t ] [ \ + ( a b -- c ) execute-effect-unsafe? ] unit-test
[ t ] [ \ + ( a b c -- d e ) execute-effect-unsafe? ] unit-test [ t ] [ \ + ( a b c -- d e ) execute-effect-unsafe? ] unit-test
[ f ] [ \ + ( a b c -- d ) execute-effect-unsafe? ] unit-test [ f ] [ \ + ( a b c -- d ) execute-effect-unsafe? ] unit-test

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

@ -57,9 +57,6 @@ M: quotation cached-effect
dup cached-effect-valid? dup cached-effect-valid?
[ cached-effect>> ] [ [ safe-infer dup ] keep save-effect ] if ; [ cached-effect>> ] [ [ safe-infer dup ] keep save-effect ] if ;
: call-effect-unsafe? ( cached-effect effect -- ? )
over +unknown+ eq? [ 2drop f ] [ effect<= ] if ;
: call-effect-slow>quot ( effect -- quot ) : call-effect-slow>quot ( effect -- quot )
[ \ call-effect def>> curry ] [ add-effect-input ] bi [ \ call-effect def>> curry ] [ add-effect-input ] bi
'[ _ _ call-effect-unsafe ] ; '[ _ _ call-effect-unsafe ] ;
@ -70,8 +67,13 @@ M: quotation cached-effect
\ call-effect-slow t "no-compile" set-word-prop \ call-effect-slow t "no-compile" set-word-prop
: call-effect-unsafe? ( quot effect -- ? )
[ cached-effect ] dip
over +unknown+ eq?
[ 2drop f ] [ [ { effect } declare ] dip effect<= ] if ; inline
: call-effect-fast ( quot effect inline-cache -- ) : call-effect-fast ( quot effect inline-cache -- )
2over [ cached-effect ] dip call-effect-unsafe? 2over call-effect-unsafe?
[ [ nip update-inline-cache ] [ drop call-effect-unsafe ] 3bi ] [ [ nip update-inline-cache ] [ drop call-effect-unsafe ] 3bi ]
[ drop call-effect-slow ] [ drop call-effect-slow ]
if ; inline if ; inline