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

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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
basis/compiler/tree/propagation/propagation-tests.factor
View File

@ -799,3 +799,6 @@ SYMBOL: not-an-assoc
[ t ] [ [ (( a b c -- c b a )) 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

26
basis/compiler/tree/propagation/simple/simple.factor
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.
USING: fry accessors kernel sequences sequences.private assocs words
namespaces classes.algebra combinators classes classes.tuple
classes.tuple.private continuations arrays alien.c-types
math math.private slots generic definitions
stack-checker.state
USING: fry accessors kernel sequences sequences.private assocs
words namespaces classes.algebra combinators
combinators.short-circuit classes classes.tuple
classes.tuple.private continuations arrays alien.c-types math
math.private slots generic definitions stack-checker.state
compiler.tree
compiler.tree.propagation.info
compiler.tree.propagation.nodes
@ -63,9 +63,19 @@ M: #declare propagate-before
[ in-d>> [ value-info ] map ] [ "outputs" word-prop ] bi*
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" 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 )
[ [ out-d>> ] [ in-d>> [ value-info literal>> ] map ] bi ] [ '[ _ execute ] ] bi*