diff --git a/basis/compiler/tree/propagation/known-words/known-words.factor b/basis/compiler/tree/propagation/known-words/known-words.factor index f6e2bc0940..163b17094a 100644 --- a/basis/compiler/tree/propagation/known-words/known-words.factor +++ b/basis/compiler/tree/propagation/known-words/known-words.factor @@ -37,31 +37,6 @@ most-negative-fixnum most-positive-fixnum [a,b] \ bitnot { integer } "input-classes" set-word-prop -{ - fcosh - flog - fsinh - fexp - fasin - facosh - fasinh - ftanh - fatanh - facos - fpow - fatan - fatan2 - fcos - ftan - fsin - fsqrt -} [ - dup stack-effect - [ in>> length real "input-classes" set-word-prop ] - [ out>> length float "default-output-classes" set-word-prop ] - 2bi -] each - : ?change-interval ( info quot -- quot' ) over interval>> [ [ clone ] dip change-interval ] [ 2drop ] if ; inline @@ -222,8 +197,15 @@ generic-comparison-ops [ { { >fixnum fixnum } + { bignum>fixnum fixnum } + { >bignum bignum } + { fixnum>bignum bignum } + { float>bignum bignum } + { >float float } + { fixnum>float float } + { bignum>float float } } [ '[ _ diff --git a/basis/compiler/tree/propagation/propagation-tests.factor b/basis/compiler/tree/propagation/propagation-tests.factor index 760ff167aa..5a7b096039 100644 --- a/basis/compiler/tree/propagation/propagation-tests.factor +++ b/basis/compiler/tree/propagation/propagation-tests.factor @@ -8,7 +8,7 @@ math.functions math.private strings layouts compiler.tree.propagation.info compiler.tree.def-use compiler.tree.debugger compiler.tree.checker slots.private words hashtables classes assocs locals -float-arrays system sorting ; +float-arrays system sorting math.libm ; IN: compiler.tree.propagation.tests \ propagate must-infer @@ -594,6 +594,10 @@ MIXIN: empty-mixin [ V{ array } ] [ [ [ <=> ] sort [ <=> ] sort ] final-classes ] unit-test +[ V{ float } ] [ [ fsqrt ] final-classes ] unit-test + +[ V{ t } ] [ [ { fixnum } declare 10 mod >float -20 > ] final-literals ] unit-test + ! [ V{ string } ] [ ! [ dup string? t xor [ "A" throw ] [ ] if ] final-classes ! ] unit-test diff --git a/basis/compiler/tree/propagation/simple/simple.factor b/basis/compiler/tree/propagation/simple/simple.factor index d586ff398f..9937c6b9c4 100644 --- a/basis/compiler/tree/propagation/simple/simple.factor +++ b/basis/compiler/tree/propagation/simple/simple.factor @@ -2,7 +2,7 @@ ! 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 +classes.tuple.private continuations arrays alien.c-types math math.private slots generic definitions stack-checker.state compiler.tree @@ -137,11 +137,12 @@ M: #call propagate-after dup word>> "input-classes" word-prop dup [ propagate-input-classes ] [ 2drop ] if ; -M: #alien-invoke propagate-before - out-d>> [ object-info swap set-value-info ] each ; +: propagate-alien-invoke ( node -- ) + [ out-d>> ] [ params>> return>> ] bi + [ drop ] [ c-type-class swap first set-value-info ] if-void ; -M: #alien-indirect propagate-before - out-d>> [ object-info swap set-value-info ] each ; +M: #alien-invoke propagate-before propagate-alien-invoke ; -M: #return annotate-node - dup in-d>> (annotate-node) ; +M: #alien-indirect propagate-before propagate-alien-invoke ; + +M: #return annotate-node dup in-d>> (annotate-node) ;