Changing the stack effect of a generic word could break the compiler

db4
Slava Pestov 2009-04-20 04:21:00 -05:00
parent dff8f80ea6
commit 5165d811d5
4 changed files with 40 additions and 20 deletions

View File

@ -0,0 +1,10 @@
IN: compiler.tests.redefine16
USING: eval tools.test definitions words compiler.units
quotations stack-checker ;
[ ] [ [ "blah" "compiler.tests.redefine16" lookup forget ] with-compilation-unit ] unit-test
[ ] [ "IN: compiler.tests.redefine16 GENERIC# blah 2 ( foo bar baz -- )" eval( -- ) ] unit-test
[ ] [ "IN: compiler.tests.redefine16 USING: strings math arrays prettyprint ; M: string blah 1 + 3array . ;" eval( -- ) ] unit-test
[ ] [ "IN: compiler.tests.redefine16 GENERIC# blah 2 ( foo bar baz -- x )" eval( -- ) ] unit-test
[ "blah" "compiler.tests.redefine16" lookup 1quotation infer ] must-fail

View File

@ -18,11 +18,18 @@ IN: compiler.tree.optimizer
SYMBOL: check-optimizer?
: ?check ( nodes -- nodes' )
check-optimizer? get [
compute-def-use
dup check-nodes
] when ;
: optimize-tree ( nodes -- nodes' )
analyze-recursive
normalize
propagate
cleanup
?check
dup run-escape-analysis? [
escape-analysis
unbox-tuples
@ -30,10 +37,7 @@ SYMBOL: check-optimizer?
apply-identities
compute-def-use
remove-dead-code
check-optimizer? get [
compute-def-use
dup check-nodes
] when
?check
compute-def-use
optimize-modular-arithmetic
finalize ;

View File

@ -218,6 +218,8 @@ M: object infer-call*
alien-callback
} [ t "special" set-word-prop ] each
M\ quotation call t "no-compile" set-word-prop
M\ word execute t "no-compile" set-word-prop
\ clear t "no-compile" set-word-prop
: non-inline-word ( word -- )

View File

@ -68,10 +68,6 @@ M: word crossref?
vocabulary>> >boolean
] if ;
GENERIC: compiled-crossref? ( word -- ? )
M: word compiled-crossref? crossref? ;
GENERIC# (quot-uses) 1 ( obj assoc -- )
M: object (quot-uses) 2drop ;
@ -131,26 +127,38 @@ compiled-generic-crossref [ H{ } clone ] initialize
: inline? ( word -- ? ) "inline" word-prop ; inline
GENERIC: subwords ( word -- seq )
M: word subwords drop f ;
<PRIVATE
SYMBOL: visited
CONSTANT: reset-on-redefine { "inferred-effect" "cannot-infer" }
: relevant-callers ( word -- seq )
crossref get at keys
[ word? ] filter
[
[ reset-on-redefine [ word-prop ] with any? ]
[ inline? ]
bi or
] filter ;
: (redefined) ( word -- )
dup visited get key? [ drop ] [
[ reset-on-redefine reset-props ]
[ visited get conjoin ]
[
crossref get at keys
[ word? ] filter
[
[ reset-on-redefine [ word-prop ] with any? ]
[ inline? ]
bi or
] filter
[ (redefined) ] each
[ relevant-callers [ (redefined) ] each ]
[ subwords [ (redefined) ] each ]
bi
] tri
] if ;
PRIVATE>
: redefined ( word -- )
[ H{ } clone visited [ (redefined) ] with-variable ]
[ changed-definition ]
@ -199,10 +207,6 @@ M: word reset-word
"writer" "delimiter"
} reset-props ;
GENERIC: subwords ( word -- seq )
M: word subwords drop f ;
: reset-generic ( word -- )
[ subwords forget-all ]
[ reset-word ]