step and cond CInt

4 files changed, 56 insertions, 53 deletions

diff --git a/packages/base/src/C/lapack-aux.c b/packages/base/src/C/lapack-aux.c
index c2cdc62..72f2382 100644
--- a/packages/base/src/C/lapack-aux.c
+++ b/packages/base/src/C/lapack-aux.c
@@ -1535,24 +1535,24 @@ int conjugateC(KCVEC(x),CVEC(t)) {
 
 //////////////////// step /////////////////////////
 
-int stepF(FVEC(x),FVEC(y)) {
-    DEBUGMSG("stepF")
-    int k;
-    for(k=0;k<xn;k++) {
-        yp[k]=xp[k]>0;
-    }
+#define STEP_IMP         \
+    int k;               \
+    for(k=0;k<xn;k++) {  \
+        yp[k]=xp[k]>0;   \
+    }                    \
     OK
+
+int stepF(KFVEC(x),FVEC(y)) {
+    STEP_IMP
 }
 
-int stepD(DVEC(x),DVEC(y)) {
-    DEBUGMSG("stepD")
-    int k;
-    for(k=0;k<xn;k++) {
-        yp[k]=xp[k]>0;
-    }
-    OK
+int stepD(KDVEC(x),DVEC(y)) {
+    STEP_IMP
 }
 
+int stepI(KIVEC(x),IVEC(y)) {
+    STEP_IMP
+}
 
 //////////////////// cond /////////////////////////
 
@@ -1576,25 +1576,24 @@ int compareD(KDVEC(x),KDVEC(y),IVEC(r)) {
     OK
 }
 
+#define COND_IMP                                                            \
+    REQUIRES(xn==yn && xn==ltn && xn==eqn && xn==gtn && xn==rn ,BAD_SIZE);  \
+    int k;                                                                  \
+    for(k=0;k<xn;k++) {                                                     \
+        rp[k] = xp[k]<yp[k]?ltp[k]:(xp[k]>yp[k]?gtp[k]:eqp[k]);             \
+    }                                                                       \
+    OK
 
 int condF(FVEC(x),FVEC(y),FVEC(lt),FVEC(eq),FVEC(gt),FVEC(r)) {
-    REQUIRES(xn==yn && xn==ltn && xn==eqn && xn==gtn && xn==rn ,BAD_SIZE);
-    DEBUGMSG("condF")
-    int k;
-    for(k=0;k<xn;k++) {
-        rp[k] = xp[k]<yp[k]?ltp[k]:(xp[k]>yp[k]?gtp[k]:eqp[k]);
-    }
-    OK
+    COND_IMP
 }
 
 int condD(DVEC(x),DVEC(y),DVEC(lt),DVEC(eq),DVEC(gt),DVEC(r)) {
-    REQUIRES(xn==yn && xn==ltn && xn==eqn && xn==gtn && xn==rn ,BAD_SIZE);
-    DEBUGMSG("condD")
-    int k;
-    for(k=0;k<xn;k++) {
-        rp[k] = xp[k]<yp[k]?ltp[k]:(xp[k]>yp[k]?gtp[k]:eqp[k]);
-    }
-    OK
+    COND_IMP
+}
+
+int condI(KIVEC(x),KIVEC(y),KIVEC(lt),KIVEC(eq),KIVEC(gt),IVEC(r)) {
+    COND_IMP
 }
 
 
diff --git a/packages/base/src/Data/Packed/Internal/Numeric.hs b/packages/base/src/Data/Packed/Internal/Numeric.hs
index 353877a..e6fcd31 100644
--- a/packages/base/src/Data/Packed/Internal/Numeric.hs
+++ b/packages/base/src/Data/Packed/Internal/Numeric.hs
@@ -49,10 +49,8 @@ import Numeric.Conversion
 import Data.Packed.Development
 import Numeric.Vectorized
 import Data.Complex
-
 import Numeric.LinearAlgebra.LAPACK(multiplyR,multiplyC,multiplyF,multiplyQ,multiplyI)
 import Data.Packed.Internal
-import Foreign.C.Types(CInt)
 import Text.Printf(printf)
 
 -------------------------------------------------------------------
@@ -153,8 +151,8 @@ class Element e => Container c e
     maxElement'  :: c e -> e
     sumElements' :: c e -> e
     prodElements' :: c e -> e
-    step' :: RealElement e => c e -> c e
-    cond' :: RealElement e
+    step' :: Ord e => c e -> c e
+    cond' :: Ord e
          => c e -- ^ a
          -> c e -- ^ b
          -> c e -- ^ l
@@ -205,11 +203,11 @@ instance Container Vector CInt
 --    maxElement'   = emptyErrorV "maxElement" (toScalarF Max)
 --    sumElements'  = sumF
 --    prodElements' = prodF
---    step' = stepF
+    step' = stepI
     find' = findV
     assoc' = assocV
     accum' = accumV
---    cond' = condV condI
+    cond' = condV condI
     scaleRecip = undefined -- cannot match
     divide = undefined
     arctan2' = undefined
@@ -443,7 +441,7 @@ prodElements = prodElements'
 -- 5 |> [0.0,0.0,0.0,1.0,1.0]
 --
 step
-  :: (RealElement e, Container c e)
+  :: (Ord e, Container c e)
     => c e
     -> c e
 step = step'
@@ -460,7 +458,7 @@ step = step'
 -- ,   0.0,   0.0, 100.0, 12.0 ]
 --
 cond
-    :: (RealElement e, Container c e)
+    :: (Ord e, Container c e)
     => c e -- ^ a
     -> c e -- ^ b
     -> c e -- ^ l
diff --git a/packages/base/src/Data/Packed/Internal/Vector.hs b/packages/base/src/Data/Packed/Internal/Vector.hs
index 2a6ed2c..7b0df64 100644
--- a/packages/base/src/Data/Packed/Internal/Vector.hs
+++ b/packages/base/src/Data/Packed/Internal/Vector.hs
@@ -19,13 +19,13 @@ module Data.Packed.Internal.Vector (
     foldVector, foldVectorG, foldLoop, foldVectorWithIndex,
     createVector, vec,
     asComplex, asReal, float2DoubleV, double2FloatV,
-    stepF, stepD, condF, condD,
+    stepF, stepD, stepI, condF, condD, condI,
     conjugateQ, conjugateC,
     cloneVector,
     unsafeToForeignPtr,
     unsafeFromForeignPtr,
     unsafeWith,
-    Idxs
+    CInt,Idxs
 ) where
 
 import Data.Packed.Internal.Common
@@ -249,37 +249,45 @@ foreign import ccall unsafe "double2float" c_double2float:: TVF
 
 ---------------------------------------------------------------
 
-stepF :: Vector Float -> Vector Float
-stepF v = unsafePerformIO $ do
+step f v = unsafePerformIO $ do
     r <- createVector (dim v)
-    app2 c_stepF vec v vec r "stepF"
+    app2 f vec v vec r "step"
     return r
 
 stepD :: Vector Double -> Vector Double
-stepD v = unsafePerformIO $ do
-    r <- createVector (dim v)
-    app2 c_stepD vec v vec r "stepD"
-    return r
+stepD = step c_stepD
+
+stepF :: Vector Float -> Vector Float
+stepF = step c_stepF
+
+stepI :: Vector CInt -> Vector CInt
+stepI = step c_stepI
 
 foreign import ccall unsafe "stepF" c_stepF :: TFF
 foreign import ccall unsafe "stepD" c_stepD :: TVV
+foreign import ccall unsafe "stepI" c_stepI :: CV CInt (CV CInt (IO CInt))
 
 ---------------------------------------------------------------
 
 condF :: Vector Float -> Vector Float -> Vector Float -> Vector Float -> Vector Float -> Vector Float
-condF x y l e g = unsafePerformIO $ do
-    r <- createVector (dim x)
-    app6 c_condF vec x vec y vec l vec e vec g vec r "condF"
-    return r
+condF = condg c_condF
 
 condD :: Vector Double -> Vector Double -> Vector Double -> Vector Double -> Vector Double -> Vector Double
-condD x y l e g = unsafePerformIO $ do
+condD = condg c_condD
+
+condI :: Vector CInt -> Vector CInt -> Vector CInt -> Vector CInt -> Vector CInt -> Vector CInt
+condI = condg c_condI
+
+
+condg f x y l e g = unsafePerformIO $ do
     r <- createVector (dim x)
-    app6 c_condD vec x vec y vec l vec e vec g vec r "condD"
+    app6 f vec x vec y vec l vec e vec g vec r "cond"
     return r
 
+
 foreign import ccall unsafe "condF" c_condF :: CInt -> PF -> CInt -> PF -> CInt -> PF -> TFFF
 foreign import ccall unsafe "condD" c_condD :: CInt -> PD -> CInt -> PD -> CInt -> PD -> TVVV
+foreign import ccall unsafe "condI" c_condI :: CV CInt (CV CInt (CV CInt (CV CInt (CV CInt (CV CInt (IO CInt))))))
 
 --------------------------------------------------------------------------------
 
diff --git a/packages/base/src/Numeric/Conversion.hs b/packages/base/src/Numeric/Conversion.hs
index a1f9385..2334e9d 100644
--- a/packages/base/src/Numeric/Conversion.hs
+++ b/packages/base/src/Numeric/Conversion.hs
@@ -45,9 +45,7 @@ instance Precision (Complex Float) (Complex Double) where
     float2DoubleG = asComplex . float2DoubleV . asReal
 
 -- | Supported real types
-class (Element t, Element (Complex t), RealFloat t
---       , RealOf t ~ t, RealOf (Complex t) ~ t
-       )
+class (Element t, Element (Complex t), RealFloat t)
     => RealElement t
 
 instance RealElement Double