Changing the stack effect of a generic word could break the compiler
parent
dff8f80ea6
commit
5165d811d5
|
@ -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
|
|
@ -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 ;
|
||||
|
|
|
@ -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 -- )
|
||||
|
|
|
@ -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 ]
|
||||
|
|
Loading…
Reference in New Issue