Fix bug, better tests

db4
Slava Pestov 2008-08-15 21:45:05 -05:00
parent fcfd6caa21
commit 2fa08c75b9
2 changed files with 6 additions and 3 deletions

View File

@ -5,7 +5,8 @@ accessors sequences arrays kernel.private vectors
alien.accessors alien.c-types sequences.private alien.accessors alien.c-types sequences.private
byte-arrays classes.algebra classes.tuple.private byte-arrays classes.algebra classes.tuple.private
math.functions math.private strings layouts math.functions math.private strings layouts
compiler.tree.propagation.info slots.private words hashtables compiler.tree.propagation.info compiler.tree.def-use
compiler.tree.checker slots.private words hashtables
classes assocs ; classes assocs ;
IN: compiler.tree.propagation.tests IN: compiler.tree.propagation.tests
@ -15,6 +16,8 @@ IN: compiler.tree.propagation.tests
build-tree build-tree
normalize normalize
propagate propagate
compute-def-use
dup check-nodes
peek node-input-infos ; peek node-input-infos ;
: final-classes ( quot -- seq ) : final-classes ( quot -- seq )

View File

@ -41,7 +41,7 @@ M: inline-recursive hashcode* id>> hashcode* ;
: make-copies ( values effect-in -- values' ) : make-copies ( values effect-in -- values' )
[ length cut* ] keep [ length cut* ] keep
[ quotation-param? [ copy-value ] [ drop <value> ] if ] 2map [ quotation-param? [ copy-value ] [ drop <value> ] if ] 2map
append ; [ make-values ] dip append ;
SYMBOL: enter-in SYMBOL: enter-in
SYMBOL: enter-out SYMBOL: enter-out
@ -125,7 +125,7 @@ SYMBOL: enter-out
: adjust-stack-effect ( effect -- effect' ) : adjust-stack-effect ( effect -- effect' )
[ in>> ] [ out>> ] bi [ in>> ] [ out>> ] bi
meta-d get length pick length - 0 max meta-d get length pick length [-]
object <repetition> '[ , prepend ] bi@ object <repetition> '[ , prepend ] bi@
<effect> ; <effect> ;