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

basis/math/floats/env/env-tests.factor

@@ -1,5 +1,5 @@
 USING: kernel math math.floats.env math.floats.env.private
-math.functions math.libm sets sequences tools.test ;
+math.functions math.libm sequences tools.test ;
 IN: math.floats.env.tests
 
 : set-default-fp-env ( -- )
@@ -10,12 +10,12 @@ set-default-fp-env
 
 [ t ] [
     [ 1.0 0.0 / drop ] collect-fp-exceptions
-    { +fp-zero-divide+ } set= 
+    +fp-zero-divide+ swap member?
 ] unit-test
 
 [ t ] [
     [ 1.0 3.0 / drop ] collect-fp-exceptions
-    { +fp-inexact+ } set= 
+    +fp-inexact+ swap member?
 ] unit-test
 
 [ t ] [
@@ -28,9 +28,24 @@ set-default-fp-env
     +fp-underflow+ swap member?
 ] unit-test
 
+[ t ] [
+    [ 2.0 100,000.0 ^ drop ] collect-fp-exceptions
+    +fp-overflow+ swap member?
+] unit-test
+
+[ t ] [
+    [ 2.0 -100,000.0 ^ drop ] collect-fp-exceptions
+    +fp-underflow+ swap member?
+] unit-test
+
 [ t ] [
     [ 0.0 0.0 /f drop ] collect-fp-exceptions
-    { +fp-invalid-operation+ } set= 
+    +fp-invalid-operation+ swap member?
+] unit-test
+
+[ t ] [
+    [ -1.0 fsqrt drop ] collect-fp-exceptions
+    +fp-invalid-operation+ swap member?
 ] unit-test
 
 [

basis/math/floats/env/env.factor

@@ -1,7 +1,7 @@
 ! (c)Joe Groff bsd license
-USING: alien.syntax assocs biassocs combinators continuations
+USING: alien.syntax arrays assocs biassocs combinators continuations
 generalizations kernel literals locals math math.bitwise
-sequences system vocabs.loader ;
+sequences sets system vocabs.loader ;
 IN: math.floats.env
 
 SINGLETONS:
@@ -95,8 +95,10 @@ GENERIC# (set-denormal-mode) 1 ( fp-env mode -- fp-env )
 
 PRIVATE>
 
-: fp-exception-flags ( -- exceptions ) fp-env-register (get-exception-flags) ;
-: set-fp-exception-flags ( exceptions -- ) [ (set-exception-flags) ] curry change-fp-env-registers ;
+: fp-exception-flags ( -- exceptions )
+    (fp-env-registers) [ (get-exception-flags) ] [ union ] map-reduce >array ; inline
+: set-fp-exception-flags ( exceptions -- )
+    [ (set-exception-flags) ] curry change-fp-env-registers ; inline
 : clear-fp-exception-flags ( -- ) { } set-fp-exception-flags ; inline
 
 : collect-fp-exceptions ( quot -- exceptions )
@@ -116,7 +118,8 @@ PRIVATE>
     mode set-rounding-mode
     quot [ orig set-rounding-mode ] [ ] cleanup ; inline
 
-: fp-traps ( -- exceptions ) fp-env-register (get-fp-traps) ;
+: fp-traps ( -- exceptions )
+    (fp-env-registers) [ (get-fp-traps) ] [ union ] map-reduce >array ; inline
 
 :: with-fp-traps ( exceptions quot -- )
     fp-traps :> orig