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

basis/compiler/cfg/builder/builder-tests.factor

@@ -4,7 +4,7 @@ compiler.tree.optimizer compiler.cfg.builder compiler.cfg.debugger
 compiler.cfg.optimizer compiler.cfg.predecessors compiler.cfg.checker
 compiler.cfg arrays locals byte-arrays kernel.private math
 slots.private vectors sbufs strings math.partial-dispatch
-strings.private ;
+strings.private accessors compiler.cfg.instructions ;
 IN: compiler.cfg.builder.tests
 
 ! Just ensure that various CFGs build correctly.
@@ -157,3 +157,26 @@ IN: compiler.cfg.builder.tests
     { pinned-c-ptr class } \ set-alien-cell '[ _ declare 10 _ execute ] unit-test-cfg
     { pinned-c-ptr class fixnum } \ set-alien-cell '[ _ declare _ execute ] unit-test-cfg
 ] each
+
+: contains-insn? ( quot insn-check -- ? )
+    [ test-mr [ instructions>> ] map ] dip
+    '[ _ any? ] any? ; inline
+
+[ t ] [ [ swap ] [ ##replace? ] contains-insn? ] unit-test
+
+[ f ] [ [ swap swap ] [ ##replace? ] contains-insn? ] unit-test
+
+[ t ] [
+    [ { fixnum byte-array fixnum } declare set-alien-unsigned-1 ]
+    [ ##set-alien-integer-1? ] contains-insn?
+] unit-test
+
+[ t ] [
+    [ { fixnum byte-array fixnum } declare [ dup * dup * ] 2dip set-alien-unsigned-1 ]
+    [ ##set-alien-integer-1? ] contains-insn?
+] unit-test
+
+[ f ] [
+    [ { byte-array fixnum } declare set-alien-unsigned-1 ]
+    [ ##set-alien-integer-1? ] contains-insn?
+] unit-test

basis/compiler/tests/optimizer.factor

@@ -4,7 +4,7 @@ sbufs strings tools.test vectors words sequences.private
 quotations classes classes.algebra classes.tuple.private
 continuations growable namespaces hints alien.accessors
 compiler.tree.builder compiler.tree.optimizer sequences.deep
-compiler definitions ;
+compiler definitions generic.single ;
 IN: compiler.tests.optimizer
 
 GENERIC: xyz ( obj -- obj )
@@ -423,3 +423,5 @@ M: object bad-dispatch-position-test* ;
         \ bad-dispatch-position-test* forget
     ] with-compilation-unit
 ] unit-test
+
+[ t [ [ f ] [ 3 ] if >fixnum ] compile-call ] [ no-method? ] must-fail-with

basis/compiler/tree/propagation/known-words/known-words.factor

@@ -32,16 +32,20 @@ IN: compiler.tree.propagation.known-words
 
 \ bitnot { integer } "input-classes" set-word-prop
 
-: ?change-interval ( info quot -- quot' )
+: real-op ( info quot -- quot' )
-    over interval>> [ [ clone ] dip change-interval ] [ 2drop ] if ; inline
+    [
+        dup class>> real classes-intersect?
+        [ clone ] [ drop real <class-info> ] if
+    ] dip
+    change-interval ; inline
 
 { bitnot fixnum-bitnot bignum-bitnot } [
-    [ [ interval-bitnot ] ?change-interval ] "outputs" set-word-prop
+    [ [ interval-bitnot ] real-op ] "outputs" set-word-prop
 ] each
 
-\ abs [ [ interval-abs ] ?change-interval ] "outputs" set-word-prop
+\ abs [ [ interval-abs ] real-op ] "outputs" set-word-prop
 
-\ absq [ [ interval-absq ] ?change-interval ] "outputs" set-word-prop
+\ absq [ [ interval-absq ] real-op ] "outputs" set-word-prop
 
 : math-closure ( class -- newclass )
     { fixnum bignum integer rational float real number object }

basis/compiler/tree/propagation/propagation-tests.factor

@@ -165,6 +165,10 @@ IN: compiler.tree.propagation.tests
 
 [ t ] [ [ { float } declare absq ] final-info first interval>> [0,inf] = ] unit-test
 
+[ t ] [ [ { complex } declare abs ] final-info first interval>> [0,inf] = ] unit-test
+
+[ t ] [ [ { complex } declare absq ] final-info first interval>> [0,inf] = ] 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

basis/math/intervals/intervals-docs.factor

@@ -253,7 +253,7 @@ HELP: interval-bitnot
 { $description "Computes the bitwise complement of the interval." } ;
 
 HELP: points>interval
-{ $values { "seq" "a sequence of " { $snippet "{ point included? }" } " pairs" } { "interval" interval } }
+{ $values { "seq" "a sequence of " { $snippet "{ point included? }" } " pairs" } { "interval" interval } { "nan?" "true if the computation produced NaNs" } }
 { $description "Outputs the smallest interval containing all of the endpoints." }
 ;