From 5a46b45312459cd3af186e355b82cc3c738df23b Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@factorcode.org>
Date: Sat, 29 Oct 2011 17:10:27 -0700
Subject: [PATCH] compiler.tree.propagation: more accurate output type for
 'tag' primitive

---
 .../known-words/known-words.factor            | 21 ++++++++++++-------
 .../tree/propagation/propagation-tests.factor |  5 +++++
 2 files changed, 18 insertions(+), 8 deletions(-)

diff --git a/basis/compiler/tree/propagation/known-words/known-words.factor b/basis/compiler/tree/propagation/known-words/known-words.factor
index baa241f9c5..78307887b7 100644
--- 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 55d13da3fa..91706e53d4 100644
--- 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