From 9f9b6bca013ff83c408182d3023ea5d56c1b7fe4 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 7 Sep 2009 23:40:23 -0500 Subject: [PATCH] compiler.tree.propagation: type check inputs to unsafe foldable words manually, so that stuff like [ "Hi" { } fixnum+fast ] doesn't crash in the compiler --- .../tree/propagation/propagation-tests.factor | 3 +++ .../tree/propagation/simple/simple.factor | 26 +++++++++++++------ 2 files changed, 21 insertions(+), 8 deletions(-) diff --git a/basis/compiler/tree/propagation/propagation-tests.factor b/basis/compiler/tree/propagation/propagation-tests.factor index 879ab82c4b..209efb3913 100644 --- a/basis/compiler/tree/propagation/propagation-tests.factor +++ b/basis/compiler/tree/propagation/propagation-tests.factor @@ -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 diff --git a/basis/compiler/tree/propagation/simple/simple.factor b/basis/compiler/tree/propagation/simple/simple.factor index 88c9831a24..5de5e26a30 100644 --- a/basis/compiler/tree/propagation/simple/simple.factor +++ b/basis/compiler/tree/propagation/simple/simple.factor @@ -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* -- 2.34.1