compiler.tree.propagation: more accurate output type for 'tag' primitive

db4
Slava Pestov 2011-10-29 17:10:27 -07:00
parent c14f0ef698
commit 5a46b45312
2 changed files with 18 additions and 8 deletions

View File

@ -1,13 +1,14 @@
! Copyright (C) 2008, 2010 Slava Pestov. ! Copyright (C) 2008, 2010 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: kernel effects accessors math math.private USING: effects accessors kernel kernel.private layouts math
math.integers.private math.floats.private math.partial-dispatch math.private math.integers.private math.floats.private
math.intervals math.parser math.order math.functions math.libm math.partial-dispatch math.intervals math.parser math.order
layouts words sequences sequences.private arrays assocs classes math.functions math.libm namespaces words sequences
classes.algebra combinators generic.math splitting fry locals sequences.private arrays assocs classes classes.algebra
classes.tuple alien.accessors classes.tuple.private combinators generic.math splitting fry locals classes.tuple
slots.private definitions strings.private vectors hashtables alien.accessors classes.tuple.private slots.private definitions
generic quotations alien alien.data alien.data.private strings.private vectors hashtables generic quotations alien
alien.data alien.data.private
stack-checker.dependencies stack-checker.dependencies
compiler.tree.comparisons compiler.tree.comparisons
compiler.tree.propagation.info compiler.tree.propagation.info
@ -337,3 +338,7 @@ generic-comparison-ops [
\ fixnum-max [ interval-max ] [ fixnum-valued ] binary-op \ fixnum-max [ interval-max ] [ fixnum-valued ] binary-op
\ (local-allot) { alien } "default-output-classes" set-word-prop \ (local-allot) { alien } "default-output-classes" set-word-prop
\ tag [
drop fixnum 0 num-types get [a,b) <class/interval-info>
] "outputs" set-word-prop

View File

@ -1001,3 +1001,8 @@ M: tuple-with-read-only-slot clone
[ V{ alien } ] [ [ V{ alien } ] [
[ { byte-array } declare [ 10 bitand 2 + ] dip <displaced-alien> ] final-classes [ { byte-array } declare [ 10 bitand 2 + ] dip <displaced-alien> ] final-classes
] unit-test ] unit-test
! 'tag' should have a declared output interval
[ V{ t } ] [
[ tag 0 15 between? ] final-literals
] unit-test