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

Add toutput ype propagation for #alien-invoke and #alien-indirect nodes

db4
Slava Pestov 2008-11-29 03:47:38 -06:00
parent 1c0789e616
commit 86d45262dc
3 changed files with 20 additions and 33 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

32
basis/compiler/tree/propagation/known-words/known-words.factor
View File

@ -37,31 +37,6 @@ most-negative-fixnum most-positive-fixnum [a,b]
\ bitnot { integer } "input-classes" set-word-prop \ 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 <repetition> "input-classes" set-word-prop ]
[ out>> length float <repetition> "default-output-classes" set-word-prop ]
2bi
] each
: ?change-interval ( info quot -- quot' ) : ?change-interval ( info quot -- quot' )
over interval>> [ [ clone ] dip change-interval ] [ 2drop ] if ; inline over interval>> [ [ clone ] dip change-interval ] [ 2drop ] if ; inline
@ -222,8 +197,15 @@ generic-comparison-ops [
{ {
{ >fixnum fixnum } { >fixnum fixnum }
{ bignum>fixnum fixnum }
{ >bignum bignum } { >bignum bignum }
{ fixnum>bignum bignum }
{ float>bignum bignum }
{ >float float } { >float float }
{ fixnum>float float }
{ bignum>float float }
} [ } [
'[ '[
_ _

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

@ -8,7 +8,7 @@ math.functions math.private strings layouts
compiler.tree.propagation.info compiler.tree.def-use compiler.tree.propagation.info compiler.tree.def-use
compiler.tree.debugger compiler.tree.checker compiler.tree.debugger compiler.tree.checker
slots.private words hashtables classes assocs locals slots.private words hashtables classes assocs locals
float-arrays system sorting ; float-arrays system sorting math.libm ;
IN: compiler.tree.propagation.tests IN: compiler.tree.propagation.tests
\ propagate must-infer \ propagate must-infer
@ -594,6 +594,10 @@ MIXIN: empty-mixin
[ V{ array } ] [ [ [ <=> ] sort [ <=> ] sort ] final-classes ] unit-test [ 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 } ] [ ! [ V{ string } ] [
! [ dup string? t xor [ "A" throw ] [ ] if ] final-classes ! [ dup string? t xor [ "A" throw ] [ ] if ] final-classes
! ] unit-test ! ] unit-test

15
basis/compiler/tree/propagation/simple/simple.factor
View File

@ -2,7 +2,7 @@
! 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 words
namespaces classes.algebra combinators classes classes.tuple 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 math math.private slots generic definitions
stack-checker.state stack-checker.state
compiler.tree compiler.tree
@ -137,11 +137,12 @@ M: #call propagate-after
dup word>> "input-classes" word-prop dup dup word>> "input-classes" word-prop dup
[ propagate-input-classes ] [ 2drop ] if ; [ propagate-input-classes ] [ 2drop ] if ;
M: #alien-invoke propagate-before : propagate-alien-invoke ( node -- )
out-d>> [ object-info swap set-value-info ] each ; [ out-d>> ] [ params>> return>> ] bi
[ drop ] [ c-type-class <class-info> swap first set-value-info ] if-void ;
M: #alien-indirect propagate-before M: #alien-invoke propagate-before propagate-alien-invoke ;
out-d>> [ object-info swap set-value-info ] each ;
M: #return annotate-node M: #alien-indirect propagate-before propagate-alien-invoke ;
dup in-d>> (annotate-node) ;
M: #return annotate-node dup in-d>> (annotate-node) ;