Merge pull request #224 from mikusp/master

add isNaN function

Data/Array/Accelerate.hs

@@ -158,7 +158,7 @@ module Data.Array.Accelerate (
   L.mapSeq, L.zipWithSeq, L.scanSeq,
 
   -- ** Sequence consumers
-  L.foldSeq, L.foldSeqFlatten, P.fromSeq, P.fromSeqElems, P.fromSeqShapes, 
+  L.foldSeq, L.foldSeqFlatten, P.fromSeq, P.fromSeqElems, P.fromSeqShapes,
   P.toSeqInner, P.toSeqOuter2, P.toSeqOuter3,
 
   -- *** Specification
@@ -246,6 +246,7 @@ module Data.Array.Accelerate (
 
   -- *** Numeric functions
   L.truncate, L.round, L.floor, L.ceiling, L.even, L.odd,
+  L.isNaN,
 
   -- *** Bitwise functions
   L.bit, L.setBit, L.clearBit, L.complementBit, L.testBit,

Data/Array/Accelerate/AST.hs

@@ -1023,10 +1023,16 @@ data PrimFun sig where
   PrimFPow        :: FloatingType a -> PrimFun ((a, a) -> a)
   PrimLogBase     :: FloatingType a -> PrimFun ((a, a) -> a)
   PrimAtan2       :: FloatingType a -> PrimFun ((a, a) -> a)
-  PrimTruncate    :: FloatingType a -> IntegralType b -> PrimFun (a -> b)
-  PrimRound       :: FloatingType a -> IntegralType b -> PrimFun (a -> b)
-  PrimFloor       :: FloatingType a -> IntegralType b -> PrimFun (a -> b)
-  PrimCeiling     :: FloatingType a -> IntegralType b -> PrimFun (a -> b)
+
+  -- RealFrac
+  PrimTruncate :: FloatingType a -> IntegralType b -> PrimFun (a -> b)
+  PrimRound    :: FloatingType a -> IntegralType b -> PrimFun (a -> b)
+  PrimFloor    :: FloatingType a -> IntegralType b -> PrimFun (a -> b)
+  PrimCeiling  :: FloatingType a -> IntegralType b -> PrimFun (a -> b)
+
+  -- RealFloat
+  PrimIsNaN :: FloatingType a -> PrimFun (a -> Bool)
+
   -- FIXME: add missing operations from RealFrac & RealFloat
 
   -- relational and equality operators

Data/Array/Accelerate/Analysis/Match.hs

@@ -727,6 +727,7 @@ matchPrimFun (PrimTruncate _ s)     (PrimTruncate _ t)     = matchIntegralType s
 matchPrimFun (PrimRound _ s)        (PrimRound _ t)        = matchIntegralType s t
 matchPrimFun (PrimFloor _ s)        (PrimFloor _ t)        = matchIntegralType s t
 matchPrimFun (PrimCeiling _ s)      (PrimCeiling _ t)      = matchIntegralType s t
+matchPrimFun (PrimIsNaN _)          (PrimIsNaN _)          = Just REFL
 matchPrimFun (PrimLt _)             (PrimLt _)             = Just REFL
 matchPrimFun (PrimGt _)             (PrimGt _)             = Just REFL
 matchPrimFun (PrimLtEq _)           (PrimLtEq _)           = Just REFL
@@ -789,6 +790,7 @@ matchPrimFun' (PrimTruncate s _)     (PrimTruncate t _)     = matchFloatingType
 matchPrimFun' (PrimRound s _)        (PrimRound t _)        = matchFloatingType s t
 matchPrimFun' (PrimFloor s _)        (PrimFloor t _)        = matchFloatingType s t
 matchPrimFun' (PrimCeiling s _)      (PrimCeiling t _)      = matchFloatingType s t
+matchPrimFun' (PrimIsNaN s)          (PrimIsNaN t)          = matchFloatingType s t
 matchPrimFun' (PrimMax _)            (PrimMax _)            = Just REFL
 matchPrimFun' (PrimMin _)            (PrimMin _)            = Just REFL
 matchPrimFun' (PrimFromIntegral s _) (PrimFromIntegral t _) = matchIntegralType s t
@@ -1157,6 +1159,7 @@ hashPrimFun (PrimTruncate _ _)          = hash "PrimTruncate"
 hashPrimFun (PrimRound _ _)             = hash "PrimRound"
 hashPrimFun (PrimFloor _ _)             = hash "PrimFloor"
 hashPrimFun (PrimCeiling _ _)           = hash "PrimCeiling"
+hashPrimFun (PrimIsNaN _)               = hash "PrimIsNaN"
 hashPrimFun (PrimLt _)                  = hash "PrimLt"
 hashPrimFun (PrimGt _)                  = hash "PrimGt"
 hashPrimFun (PrimLtEq _)                = hash "PrimLtEq"

Data/Array/Accelerate/Interpreter.hs

@@ -789,6 +789,7 @@ evalPrim (PrimRound        ta tb) = evalRound ta tb
 evalPrim (PrimFloor        ta tb) = evalFloor ta tb
 evalPrim (PrimCeiling      ta tb) = evalCeiling ta tb
 evalPrim (PrimAtan2           ty) = evalAtan2 ty
+evalPrim (PrimIsNaN           ty) = evalIsNaN ty
 evalPrim (PrimLt              ty) = evalLt ty
 evalPrim (PrimGt              ty) = evalGt ty
 evalPrim (PrimLtEq            ty) = evalLtEq ty
@@ -954,6 +955,9 @@ evalCeiling ta tb
 evalAtan2 :: FloatingType a -> ((a, a) -> a)
 evalAtan2 ty | FloatingDict <- floatingDict ty = uncurry atan2
 
+evalIsNaN :: FloatingType a -> (a -> Bool)
+evalIsNaN ty | FloatingDict <- floatingDict ty = isNaN
+
 
 -- Methods of Num
 --

Data/Array/Accelerate/Language.hs

@@ -101,7 +101,7 @@ module Data.Array.Accelerate.Language (
   shift,  shiftL,  shiftR,
   rotate, rotateL, rotateR,
   truncate, round, floor, ceiling,
-  even, odd,
+  even, odd, isNaN,
 
   -- * Standard functions that we need to redefine as their signatures change
   (&&*), (||*), not,
@@ -1004,6 +1004,11 @@ even x = x .&. 1 ==* 0
 odd :: (Elt a, IsIntegral a) => Exp a -> Exp Bool
 odd x = x .&. 1 ==* 1
 
+-- | return if the argument is an IEEE "not-a-number" (NaN) value
+--
+isNaN :: (Elt a, IsFloating a) => Exp a -> Exp Bool
+isNaN = mkIsNaN
+
 
 -- Non-overloaded standard functions, where we need other signatures
 -- -----------------------------------------------------------------

Data/Array/Accelerate/Pretty/Print.hs

@@ -416,6 +416,7 @@ prettyPrim (PrimRound _ _)        = (False, text "round")
 prettyPrim (PrimFloor _ _)        = (False, text "floor")
 prettyPrim (PrimCeiling _ _)      = (False, text "ceiling")
 prettyPrim (PrimAtan2 _)          = (False, text "atan2")
+prettyPrim (PrimIsNaN _)          = (False, text "isNaN")
 prettyPrim (PrimLt _)             = (True,  text "<*")
 prettyPrim (PrimGt _)             = (True,  text ">*")
 prettyPrim (PrimLtEq _)           = (True,  text "<=*")

Data/Array/Accelerate/Pretty/Traverse.hs

@@ -268,6 +268,7 @@ labelForPrimFun (PrimRound _ _)        = "PrimRound"
 labelForPrimFun (PrimFloor _ _)        = "PrimFloor"
 labelForPrimFun (PrimCeiling _ _)      = "PrimCeiling"
 labelForPrimFun (PrimAtan2 _)          = "PrimAtan2"
+labelForPrimFun (PrimIsNaN _)          = "PrimIsNaN"
 labelForPrimFun (PrimLt _)             = "PrimLt"
 labelForPrimFun (PrimGt _)             = "PrimGt"
 labelForPrimFun (PrimLtEq _)           = "PrimLtEq"

Data/Array/Accelerate/Smart.hs

@@ -58,7 +58,7 @@ module Data.Array.Accelerate.Smart (
   mkAdd, mkSub, mkMul, mkNeg, mkAbs, mkSig, mkQuot, mkRem, mkQuotRem, mkIDiv, mkMod, mkDivMod,
   mkBAnd, mkBOr, mkBXor, mkBNot, mkBShiftL, mkBShiftR, mkBRotateL, mkBRotateR,
   mkFDiv, mkRecip, mkLt, mkGt, mkLtEq, mkGtEq, mkEq, mkNEq, mkMax, mkMin,
-  mkLAnd, mkLOr, mkLNot,
+  mkLAnd, mkLOr, mkLNot, mkIsNaN,
 
   -- * Smart constructors for type coercion functions
   mkOrd, mkChr, mkBoolToInt, mkFromIntegral,
@@ -1130,6 +1130,9 @@ mkCeiling x = Exp $ PrimCeiling floatingType integralType `PrimApp` x
 mkAtan2 :: (Elt t, IsFloating t) => Exp t -> Exp t -> Exp t
 mkAtan2 x y = Exp $ PrimAtan2 floatingType `PrimApp` tup2 (x, y)
 
+mkIsNaN :: (Elt t, IsFloating t) => Exp t -> Exp Bool
+mkIsNaN x = Exp $ PrimIsNaN floatingType `PrimApp` x
+
 -- FIXME: add missing operations from Floating, RealFrac & RealFloat
 
 -- Relational and equality operators

Data/Array/Accelerate/Trafo/Algebra.hs

@@ -132,6 +132,7 @@ evalPrimApp env f x
       PrimRound ta tb           -> evalRound ta tb x env
       PrimFloor ta tb           -> evalFloor ta tb x env
       PrimCeiling ta tb         -> evalCeiling ta tb x env
+      PrimIsNaN ty              -> evalIsNaN ty x env
       PrimLt ty                 -> evalLt ty x env
       PrimGt ty                 -> evalGt ty x env
       PrimLtEq ty               -> evalLtEq ty x env
@@ -524,6 +525,9 @@ evalCeiling ta tb
   | FloatingDict <- floatingDict ta
   , IntegralDict <- integralDict tb = eval1 ceiling
 
+evalIsNaN :: Elt a => FloatingType a -> a :-> Bool
+evalIsNaN ty | FloatingDict <- floatingDict ty = eval1 isNaN
+
 
 -- Relational & Equality
 -- ---------------------