compiler.tree.propagation: type check inputs to unsafe foldable words manually, so that stuff like [ "Hi" { } fixnum+fast ] doesn't crash in the compiler

Slava Pestov 2009-09-07 23:40:23 -05:00
parent 77aae1473f
commit b279c5751c
2 changed files with 21 additions and 8 deletions

View File

@ -799,3 +799,6 @@ SYMBOL: not-an-assoc
[ t ] [ [ (( a b c -- c b a )) shuffle ] { shuffle } inlined? ] unit-test [ t ] [ [ (( a b c -- c b a )) shuffle ] { shuffle } inlined? ] unit-test
[ f ] [ [ { 1 2 3 } swap shuffle ] { shuffle } inlined? ] unit-test [ f ] [ [ { 1 2 3 } swap shuffle ] { shuffle } inlined? ] unit-test
! Don't crash if bad literal inputs are passed to unsafe words
[ f ] [ [ { } 1 fixnum+fast ] final-info first literal?>> ] unit-test

View File

@ -1,10 +1,10 @@
! Copyright (C) 2008 Slava Pestov. ! Copyright (C) 2008, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: fry accessors kernel sequences sequences.private assocs words USING: fry accessors kernel sequences sequences.private assocs
namespaces classes.algebra combinators classes classes.tuple words namespaces classes.algebra combinators
classes.tuple.private continuations arrays alien.c-types combinators.short-circuit classes classes.tuple
math math.private slots generic definitions classes.tuple.private continuations arrays alien.c-types math
stack-checker.state math.private slots generic definitions stack-checker.state
compiler.tree compiler.tree
compiler.tree.propagation.info compiler.tree.propagation.info
compiler.tree.propagation.nodes compiler.tree.propagation.nodes
@ -63,9 +63,19 @@ M: #declare propagate-before
[ in-d>> [ value-info ] map ] [ "outputs" word-prop ] bi* [ in-d>> [ value-info ] map ] [ "outputs" word-prop ] bi*
with-datastack ; with-datastack ;
: literal-inputs? ( #call -- ? )
in-d>> [ value-info literal?>> ] all? ;
: input-classes-match? ( #call word -- ? )
[ in-d>> ] [ "input-classes" word-prop ] bi*
[ [ value-info literal>> ] dip instance? ] 2all? ;
: foldable-call? ( #call word -- ? ) : foldable-call? ( #call word -- ? )
"foldable" word-prop {
[ in-d>> [ value-info literal?>> ] all? ] [ drop f ] if ; [ nip "foldable" word-prop ]
[ drop literal-inputs? ]
[ input-classes-match? ]
} 2&& ;
: (fold-call) ( #call word -- info ) : (fold-call) ( #call word -- info )
[ [ out-d>> ] [ in-d>> [ value-info literal>> ] map ] bi ] [ '[ _ execute ] ] bi* [ [ out-d>> ] [ in-d>> [ value-info literal>> ] map ] bi ] [ '[ _ execute ] ] bi*