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

diff --git a/basis/compiler/tree/propagation/known-words/known-words.factor b/basis/compiler/tree/propagation/known-words/known-words.factor
index baa241f9c589f612f0b311a9f54fc68df182f46a..78307887b7c135b15777f6bf4f299ad783ea0d85 100644 (file)
--- a/basis/compiler/tree/propagation/known-words/known-words.factor
+++ b/basis/compiler/tree/propagation/known-words/known-words.factor
@@ -1,13 +1,14 @@
 ! Copyright (C) 2008, 2010 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel effects accessors math math.private
-math.integers.private math.floats.private math.partial-dispatch
-math.intervals math.parser math.order math.functions math.libm
-layouts words sequences sequences.private arrays assocs classes
-classes.algebra combinators generic.math splitting fry locals
-classes.tuple alien.accessors classes.tuple.private
-slots.private definitions strings.private vectors hashtables
-generic quotations alien alien.data alien.data.private
+USING: effects accessors kernel kernel.private layouts math
+math.private math.integers.private math.floats.private
+math.partial-dispatch math.intervals math.parser math.order
+math.functions math.libm namespaces words sequences
+sequences.private arrays assocs classes classes.algebra
+combinators generic.math splitting fry locals classes.tuple
+alien.accessors classes.tuple.private slots.private definitions
+strings.private vectors hashtables generic quotations alien
+alien.data alien.data.private
 stack-checker.dependencies
 compiler.tree.comparisons
 compiler.tree.propagation.info
@@ -337,3 +338,7 @@ generic-comparison-ops [
 \ fixnum-max [ interval-max ] [ fixnum-valued ] binary-op
 
 \ (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

diff --git a/basis/compiler/tree/propagation/propagation-tests.factor b/basis/compiler/tree/propagation/propagation-tests.factor
index 55d13da3fa9c33613137643feb1be7e9a49b40ed..91706e53d405b083fc107597a2882a5988ca8391 100644 (file)
--- a/basis/compiler/tree/propagation/propagation-tests.factor
+++ b/basis/compiler/tree/propagation/propagation-tests.factor
@@ -1001,3 +1001,8 @@ M: tuple-with-read-only-slot clone
 [ V{ alien } ] [
     [ { byte-array } declare [ 10 bitand 2 + ] dip <displaced-alien> ] final-classes
 ] unit-test
+
+! 'tag' should have a declared output interval
+[ V{ t } ] [
+    [ tag 0 15 between? ] final-literals
+] unit-test