Merge branch 'master' of git://factorcode.org/git/factor into constraints

diff --combined basis/compiler/tree/propagation/propagation-tests.factor
index e7cb1b270ac7af755d65979eaf9b10e3de382968,0da234791b8d707a6c769b28a435f086829d225f..b436b21329f84fc4e02accee8f3f76343fd849cc
--- 1/basis/compiler/tree/propagation/propagation-tests.factor
--- 2/basis/compiler/tree/propagation/propagation-tests.factor
+++ b/basis/compiler/tree/propagation/propagation-tests.factor
@@@ -10,6 -10,7 +10,7 @@@ compiler.tree.debugger compiler.tree.ch
  slots.private words hashtables classes assocs locals
  specialized-arrays system sorting math.libm
  math.intervals quotations effects alien ;
+ FROM: math => float ;
  SPECIALIZED-ARRAY: double
  IN: compiler.tree.propagation.tests
  
@@@ -31,6 -32,8 +32,8 @@@
  
  [ V{ 69 } ] [ [ [ 69 ] [ 69 ] if ] final-literals ] unit-test
  
+ [ V{ integer } ] [ [ bitnot ] final-classes ] unit-test
+ 
  [ V{ fixnum } ] [ [ { fixnum } declare bitnot ] final-classes ] unit-test
  
  ! Test type propagation for math ops
@@@ -164,6 -167,18 +167,18 @@@
  
  [ t ] [ [ absq ] final-info first interval>> [0,inf] = ] unit-test
  
+ [ t ] [ [ { fixnum } declare abs ] final-info first interval>> [0,inf] interval-subset? ] unit-test
+ 
+ [ t ] [ [ { fixnum } declare absq ] final-info first interval>> [0,inf] interval-subset? ] unit-test
+ 
+ [ V{ integer } ] [ [ { fixnum } declare abs ] final-classes ] unit-test
+ 
+ [ V{ integer } ] [ [ { fixnum } declare absq ] final-classes ] unit-test
+ 
+ [ t ] [ [ { bignum } declare abs ] final-info first interval>> [0,inf] interval-subset? ] unit-test
+ 
+ [ t ] [ [ { bignum } declare absq ] final-info first interval>> [0,inf] interval-subset? ] unit-test
+ 
  [ t ] [ [ { float } declare abs ] final-info first interval>> [0,inf] = ] unit-test
  
  [ t ] [ [ { float } declare absq ] final-info first interval>> [0,inf] = ] unit-test
@@@ -172,6 -187,10 +187,10 @@@
  
  [ t ] [ [ { complex } declare absq ] final-info first interval>> [0,inf] = ] unit-test
  
+ [ t ] [ [ { float float } declare rect> C{ 0.0 0.0 } + absq ] final-info first interval>> [0,inf] = ] unit-test
+ 
+ [ V{ float } ] [ [ { float float } declare rect> C{ 0.0 0.0 } + absq ] final-classes ] unit-test
+ 
  [ t ] [ [ [ - absq ] [ + ] 2map-reduce ] final-info first interval>> [0,inf] = ] unit-test
  
  [ t ] [ [ { double-array double-array } declare [ - absq ] [ + ] 2map-reduce ] final-info first interval>> [0,inf] = ] unit-test
@@@ -247,6 -266,13 +266,13 @@@
      ] final-literals
  ] unit-test
  
+ [ V{ 1.5 } ] [
+     [
+         /f
+         dup 1.5 u<= [ dup 1.5 u>= [ ] [ drop 1.5 ] if ] [ drop 1.5 ] if
+     ] final-literals
+ ] unit-test
+ 
  [ V{ 1.5 } ] [
      [
          /f
@@@ -254,6 -280,13 +280,13 @@@
      ] final-literals
  ] unit-test
  
+ [ V{ 1.5 } ] [
+     [
+         /f
+         dup 1.5 u<= [ dup 10 u>= [ ] [ drop 1.5 ] if ] [ drop 1.5 ] if
+     ] final-literals
+ ] unit-test
+ 
  [ V{ f } ] [
      [
          /f
@@@ -261,6 -294,13 +294,13 @@@
      ] final-literals
  ] unit-test
  
+ [ V{ f } ] [
+     [
+         /f
+         dup 0.0 u<= [ dup 0.0 u>= [ drop 0.0 ] unless ] [ drop 0.0 ] if
+     ] final-literals
+ ] unit-test
+ 
  [ V{ fixnum } ] [
      [ 0 dup 10 > [ 100 * ] when ] final-classes
  ] unit-test
@@@ -269,6 -309,14 +309,14 @@@
      [ 0 dup 10 > [ drop "foo" ] when ] final-classes
  ] unit-test
  
+ [ V{ fixnum } ] [
+     [ 0 dup 10 u> [ 100 * ] when ] final-classes
+ ] unit-test
+ 
+ [ V{ fixnum } ] [
+     [ 0 dup 10 u> [ drop "foo" ] when ] final-classes
+ ] unit-test
+ 
  [ V{ fixnum } ] [
      [ { fixnum } declare 3 3 - + ] final-classes
  ] unit-test
@@@ -277,6 -325,10 +325,10 @@@
      [ dup 10 < [ 3 * 30 < ] [ drop t ] if ] final-literals
  ] unit-test
  
+ [ V{ t } ] [
+     [ dup 10 u< [ 3 * 30 u< ] [ drop t ] if ] final-literals
+ ] unit-test
+ 
  [ V{ "d" } ] [
      [
          3 {
@@@ -300,10 -352,18 +352,18 @@@
      [ >fixnum dup 100 < [ 1 + ] [ "Oops" throw ] if ] final-classes
  ] unit-test
  
+ [ V{ fixnum } ] [
+     [ >fixnum dup 100 u< [ 1 + ] [ "Oops" throw ] if ] final-classes
+ ] unit-test
+ 
  [ V{ -1 } ] [
      [ 0 dup 100 < not [ 1 + ] [ 1 - ] if ] final-literals
  ] unit-test
  
+ [ V{ -1 } ] [
+     [ 0 dup 100 u< not [ 1 + ] [ 1 - ] if ] final-literals
+ ] unit-test
+ 
  [ V{ 2 } ] [
      [ [ 1 ] [ 1 ] if 1 + ] final-literals
  ] unit-test
@@@ -312,12 -372,22 +372,22 @@@
      [ 0 * 10 < ] final-classes
  ] unit-test
  
+ [ V{ object } ] [
+     [ 0 * 10 u< ] final-classes
+ ] unit-test
+ 
  [ V{ 27 } ] [
      [
          123 bitand dup 10 < over 8 > and [ 3 * ] [ "B" throw ] if
      ] final-literals
  ] unit-test
  
+ [ V{ 27 } ] [
+     [
+         123 bitand dup 10 u< over 8 u> and [ 3 * ] [ "B" throw ] if
+     ] final-literals
+ ] unit-test
+ 
  [ V{ 27 } ] [
      [
          dup number? over sequence? and [
@@@ -694,17 -764,17 +764,17 @@@ MIXIN: empty-mixi
      [ { word object } declare equal? ] final-classes
  ] unit-test
  
 -! [ V{ string } ] [
 -!     [ dup string? t xor [ "A" throw ] [ ] if ] final-classes
 -! ] unit-test
 +[ V{ string } ] [
 +    [ dup string? t xor [ "A" throw ] [ ] if ] final-classes
 +] unit-test
  
 -! [ t ] [ [ dup t xor or ] final-classes first true-class? ] unit-test
 +[ t ] [ [ dup t xor or ] final-classes first true-class? ] unit-test
  
 -! [ t ] [ [ dup t xor swap or ] final-classes first true-class? ] unit-test
 +[ t ] [ [ dup t xor swap or ] final-classes first true-class? ] unit-test
  
 -! [ t ] [ [ dup t xor and ] final-classes first false-class? ] unit-test
 +[ t ] [ [ dup t xor and ] final-classes first false-class? ] unit-test
  
 -! [ t ] [ [ dup t xor swap and ] final-classes first false-class? ] unit-test
 +[ t ] [ [ dup t xor swap and ] final-classes first false-class? ] unit-test
  
  ! generalize-counter-interval wasn't being called in all the right places.
  ! bug found by littledan