diff --git a/benchmarks/Benchmarks.hs b/benchmarks/Benchmarks.hs --- a/benchmarks/Benchmarks.hs +++ b/benchmarks/Benchmarks.hs @@ -1,6 +1,6 @@ {-# LANGUAGE ScopedTypeVariables #-} -import Control.Monad.Primitive +import Control.Monad.Primitive import Control.Monad import Foreign.C.Types import Foreign.Ptr @@ -53,7 +53,7 @@ inBufConv = VG.fromList $ take size $ concat $ repeat [0 .. 255] duplicate :: [a] -> [a] - duplicate = concat . map func + duplicate = concatMap func where func x = [x, x] coeffs2 :: VS.Vector Float diff --git a/hs_sources/SDR/FFT.hs b/hs_sources/SDR/FFT.hs --- a/hs_sources/SDR/FFT.hs +++ b/hs_sources/SDR/FFT.hs @@ -8,7 +8,9 @@ blackman, -- * FFTs + fftw', fftw, + fftwReal', fftwReal, fftwParallel ) where @@ -37,11 +39,11 @@ ptr <- fftwMalloc $ fromIntegral $ elems * sizeOf (undefined :: a) newForeignPtr fftwFreePtr ptr --- | Creates a Pipe that performs a complex to complex DFT. -fftw :: (VG.Vector v (Complex CDouble)) +-- | Creates a function that performs a complex to complex DFT. +fftw' :: (VG.Vector v (Complex CDouble)) => Int -- ^ The size of the input and output buffers - -> IO (Pipe (v (Complex CDouble)) (VS.Vector (Complex CDouble)) IO ()) -fftw samples = do + -> IO (v (Complex CDouble) -> IO (VS.Vector (Complex CDouble))) +fftw' samples = do ina <- mallocForeignBufferAligned samples out <- mallocForeignBufferAligned samples @@ -49,26 +51,34 @@ withForeignPtr out $ \op -> planDFT1d samples ip op Forward fftwEstimate - return $ for cat $ \inv' -> do - out <- lift $ mallocForeignBufferAligned samples - ina <- lift $ mallocForeignBufferAligned samples + return $ \inv' -> do + out <- mallocForeignBufferAligned samples + ina <- mallocForeignBufferAligned samples let inv = VSM.unsafeFromForeignPtr0 ina samples - lift $ copyInto inv inv' + copyInto inv inv' let (fp, offset, length) = VSM.unsafeToForeignPtr inv - lift $ withForeignPtr fp $ \fpp -> + withForeignPtr fp $ \fpp -> withForeignPtr out $ \op -> executeDFT plan fpp op - yield $ VS.unsafeFromForeignPtr0 out samples + return $ VS.unsafeFromForeignPtr0 out samples --- | Creates a pipe that performs a real to complex DFT. -fftwReal :: (VG.Vector v CDouble) +-- | Creates a Pipe that performs a complex to complex DFT. +fftw :: (VG.Vector v (Complex CDouble)) + => Int -- ^ The size of the input and output buffers + -> IO (Pipe (v (Complex CDouble)) (VS.Vector (Complex CDouble)) IO ()) +fftw samples = do + func <- fftw' samples + return $ for cat $ \dat -> lift (func dat) >>= yield + +-- | Creates a function that performs a real to complex DFT. +fftwReal' :: (VG.Vector v CDouble) => Int -- ^ The size of the input Vector - -> IO (Pipe (v CDouble) (VS.Vector (Complex CDouble)) IO ()) -fftwReal samples = do + -> IO (v CDouble -> IO (VS.Vector (Complex CDouble))) +fftwReal' samples = do --Allocate in and out buffers that wont be used because there doesnt seem to be a way to create a plan without them ina <- mallocForeignBufferAligned samples out <- mallocForeignBufferAligned samples @@ -77,19 +87,27 @@ withForeignPtr out $ \op -> planDFTR2C1d samples ip op fftwEstimate - return $ for cat $ \inv' -> do - out <- lift $ mallocForeignBufferAligned ((samples `quot` 2) + 1) - ina <- lift $ mallocForeignBufferAligned samples + return $ \inv' -> do + out <- mallocForeignBufferAligned ((samples `quot` 2) + 1) + ina <- mallocForeignBufferAligned samples let inv = VSM.unsafeFromForeignPtr0 ina samples - lift $ copyInto inv inv' + copyInto inv inv' let (fp, offset, length) = VSM.unsafeToForeignPtr inv - lift $ withForeignPtr fp $ \fpp -> + withForeignPtr fp $ \fpp -> withForeignPtr out $ \op -> executeDFTR2C plan fpp op - yield $ VS.unsafeFromForeignPtr0 out samples + return $ VS.unsafeFromForeignPtr0 out samples + +-- | Creates a pipe that performs a real to complex DFT. +fftwReal :: (VG.Vector v CDouble) + => Int -- ^ The size of the input Vector + -> IO (Pipe (v CDouble) (VS.Vector (Complex CDouble)) IO ()) +fftwReal samples = do + func <- fftwReal' samples + return $ for cat $ \dat -> lift (func dat) >>= yield {-| Creates a pipe that uses multiple threads to perform complex to complex DFTs in a pipelined fashion. Each time a buffer is consumed, it is given to diff --git a/hs_sources/SDR/Filter.hs b/hs_sources/SDR/Filter.hs --- a/hs_sources/SDR/Filter.hs +++ b/hs_sources/SDR/Filter.hs @@ -144,7 +144,7 @@ } duplicate :: [a] -> [a] -duplicate = concat . map func +duplicate = concatMap func where func x = [x, x] {-# INLINE haskellFilter #-} @@ -158,7 +158,7 @@ let filterOne = filterHighLevel vCoeffs filterCross = filterCrossHighLevel vCoeffs numCoeffsF = length coeffs - return $ Filter {..} + return Filter {..} mkFilter :: Int -> FilterRR @@ -172,7 +172,7 @@ evaluate vCoeffs let filterOne = filterFunc vCoeffs filterCross = filterCrossHighLevel vCoeffs - return $ Filter {..} + return Filter {..} -- | Returns a fast Filter data structure implemented in C. For filtering real data with real coefficients. fastFilterCR :: [Float] -- ^ The filter coefficients @@ -208,7 +208,7 @@ evaluate vCoeffs let filterOne = filterFunc vCoeffs filterCross = filterCrossHighLevel vCoeffs2 - return $ Filter {..} + return Filter {..} -- | Returns a fast Filter data structure implemented in C For filtering complex data with real coefficients. fastFilterCC :: [Float] -- ^ The filter coefficients @@ -242,7 +242,7 @@ let filterOne = filterFunc vCoeffs filterCross = filterCrossHighLevel vCoeffs2 numCoeffsF = length coeffs * 2 - return $ Filter {..} + return Filter {..} -- | Returns a fast Filter data structure implemented in C using SSE instructions. For filtering real data with real coefficients. For filters with symmetric coefficients, i.e. 'linear phase'. Coefficient length must be a multiple of 4. fastFilterSymSSER :: [Float] -- ^ The first half of the filter coefficients @@ -287,7 +287,7 @@ evaluate vCoeffs let decimateOne = filterFunc decimationD vCoeffs decimateCross = decimateCrossHighLevel decimationD vCoeffs - return $ Decimator {..} + return Decimator {..} -- | Returns a fast Decimator data structure implemented in C. For decimating real data with real coefficients. fastDecimatorCR :: Int -- ^ The decimation factor @@ -328,7 +328,7 @@ evaluate vCoeffs let decimateOne = filterFunc decimationD vCoeffs decimateCross = decimateCrossHighLevel decimationD vCoeffs2 - return $ Decimator {..} + return Decimator {..} -- | Returns a fast Decimator data structure implemented in C. For decimating complex data with real coefficients. fastDecimatorCC :: Int -- ^ The decimation factor @@ -367,8 +367,8 @@ let decimateOne = filterFunc decimationD vCoeffs decimateCross = decimateCrossHighLevel decimationD vCoeffs2 numCoeffsD = length coeffs * 2 - return $ Decimator {..} + return Decimator {..} -- | Returns a fast Decimator data structure implemented in C using SSE instructions. For decimating real data with real coefficients. For decimators with symmetric coefficients, i.e. 'linear phase'. Coefficient length must be a multiple of 4. fastDecimatorSymSSER :: Int -- ^ The decimation factor -> [Float] -- ^ The first half of the filter coefficients @@ -403,7 +403,7 @@ numCoeffsR = length coeffs func x = (x, x) startDat = 0 - return $ Resampler {..} + return Resampler {..} mkResampler :: Int -> ResampleRR @@ -422,7 +422,7 @@ numCoeffsR = roundUp (length coeffs) (interpolationR * sizeMultiple) func1 group = let offset = interpolationR - 1 - ((interpolationR + group * decimationR - 1) `mod` interpolationR) in ((group, offset), offset) startDat = (0, 0) - return $ Resampler {..} + return Resampler {..} mkResamplerC :: Int -> ResampleRC @@ -441,7 +441,7 @@ numCoeffsR = roundUp (length coeffs) (interpolationR * sizeMultiple) func1 group = let offset = interpolationR - 1 - ((interpolationR + group * decimationR - 1) `mod` interpolationR) in ((group, offset), offset) startDat = (0, 0) - return $ Resampler {..} + return Resampler {..} -- | Returns a fast Resampler data structure implemented in C. For filtering real data with real coefficients. fastResamplerCR :: Int -- ^ The interpolation factor diff --git a/hs_sources/SDR/FilterDesign.hs b/hs_sources/SDR/FilterDesign.hs --- a/hs_sources/SDR/FilterDesign.hs +++ b/hs_sources/SDR/FilterDesign.hs @@ -59,6 +59,7 @@ where func idx = 0.42 - 0.5 * cos((2 * pi * fromIntegral idx) / (fromIntegral size - 1)) + 0.08 * cos((4 * pi * fromIntegral idx) / (fromIntegral size - 1)) +-- | Compute a windowed sinc function windowedSinc :: (Floating n, VG.Vector v n) => Int -- ^ The length -> n -- ^ The cutoff frequency (from 0 to 1) diff --git a/hs_sources/SDR/Util.hs b/hs_sources/SDR/Util.hs --- a/hs_sources/SDR/Util.hs +++ b/hs_sources/SDR/Util.hs @@ -45,7 +45,11 @@ -- * Automatic gain control agc, - agcPipe + agcPipe, + + -- * Squashing initialization into the Pipe + combineInit, + combineInitTrans ) where import Foreign.C.Types @@ -342,4 +346,12 @@ -> a -- ^ reference -> Pipe (VS.Vector (Complex a)) (VS.Vector (Complex a)) m () agcPipe mu reference = pMapAccum (agc mu reference) 1 + +-- | Specializes to combineInit :: IO (Pipe a b IO ()) -> Pipe a b IO () +combineInit :: (Monad m, MonadTrans t, Monad (t m)) => m (t m a) -> t m a +combineInit = join . lift + +-- | Specializes to combineInitTrans :: EitherT String IO (Pipe a b IO ()) -> Pipe a b (EitherT String IO) () +combineInitTrans :: (Monad (t1 m), Monad (t (t1 m)), MonadTrans t, Monad m, MFunctor t, MonadTrans t1) => (t1 m) ((t m) a) -> t (t1 m) a +combineInitTrans = combineInit . fmap (hoist lift) diff --git a/sdr.cabal b/sdr.cabal --- a/sdr.cabal +++ b/sdr.cabal @@ -1,5 +1,5 @@ name: sdr -version: 0.1.0.6 +version: 0.1.0.8 synopsis: A software defined radio library description: Write software defined radio applications in Haskell. @@ -67,23 +67,23 @@ -- other-modules: other-extensions: ScopedTypeVariables, GADTs build-depends: - base >=4.7 && <4.9, + base >=4.7 && <5, fftwRaw >=0.1 && <0.2, bytestring >=0.10 && <0.11, pulse-simple >=0.1 && <0.2, - pipes >=4.1 && <4.2, + pipes >=4.1 && <4.3, pipes-concurrency >=2.0 && <2.1, - either >=4.1 && <4.4, - time >=1.4 && <1.6, + either >=4.1 && <4.5, + time >=1.4 && <1.7, rtlsdr >=0.1 && <0.2, storable-complex >=0.2 && <0.3, pipes-bytestring >=2.0 && <2.2, - dynamic-graph ==0.1.0.8, + dynamic-graph ==0.1.0.9, array >=0.4 && <0.6, vector >=0.11 && <0.12, tuple >=0.2 && <0.4, - OpenGL >=2.11 && <2.13, - GLFW-b >=1.4.7 && <1.4.8, + OpenGL >=2.11 && <3.1, + GLFW-b >=1.4.8 && <1.4.9, primitive >=0.5 && <0.7, colour >=2.3 && <2.4, pango >=0.13 && <0.14, @@ -91,9 +91,9 @@ cairo >=0.13 && <0.14, cereal >=0.4 && <0.6, optparse-applicative >=0.11 && <0.13, - Decimal >=0.4 && <0.5, - Chart >=1.3 && <1.6, - Chart-cairo >=1.3 && <1.6, + Decimal >=0.4 && <0.5, + Chart >=1.3 && <1.9, + Chart-cairo >=1.3 && <1.9, mwc-random -- hs-source-dirs: default-language: Haskell2010 @@ -114,10 +114,10 @@ type: exitcode-stdio-1.0 main-is: TestSuite.hs build-depends: - base >=4.6 && <4.9, - QuickCheck >=2.8 && <2.9, + base >=4.6 && <5, + QuickCheck >=2.8 && <2.10, vector >=0.11 && <0.12, - sdr ==0.1.0.6, + sdr ==0.1.0.8, primitive >=0.5 && <0.7, storable-complex >=0.2 && <0.3, test-framework >=0.8 && <0.9, @@ -130,10 +130,10 @@ type: exitcode-stdio-1.0 main-is: Benchmarks.hs build-depends: - base >=4.6 && <4.9, + base >=4.6 && <5, criterion >=1.0 && <1.2, vector >=0.11 && <0.12, - sdr ==0.1.0.6, + sdr ==0.1.0.8, primitive >=0.5 && <0.7, storable-complex >=0.2 && <0.3 hs-source-dirs: benchmarks diff --git a/tests/TestSuite.hs b/tests/TestSuite.hs --- a/tests/TestSuite.hs +++ b/tests/TestSuite.hs @@ -23,11 +23,11 @@ sameResultM eq (x:xs) = do res <- x ress <- sequence xs - return $ and $ map (eq res) ress + return $ all (eq res) ress sameResult :: (a -> a -> Bool) -> [a] -> Bool sameResult _ [] = True -sameResult eq (x:xs) = and $ map (eq x) xs +sameResult eq (x:xs) = all (eq x) xs tests info = [ testGroup "filters" [ @@ -71,7 +71,7 @@ vInput = VS.fromList inBuf num = size - numCoeffs*2 + 1 - res <- run $ sameResultM eqDelta $ map (getResult num $) $ hasFeatures [ + res <- run $ sameResultM eqDelta $ map (getResult num) $ hasFeatures [ (const True, filterHighLevel vCoeffs num vInput), (const True, filterImperative1 vCoeffs num vInput), (const True, filterImperative2 vCoeffs num vInput), @@ -99,7 +99,7 @@ num = size - numCoeffs*2 + 1 vCoeffs2 = VG.fromList $ duplicate $ coeffs ++ reverse coeffs - res <- run $ sameResultM eqDeltaC $ map (getResult num $) $ hasFeatures [ + res <- run $ sameResultM eqDeltaC $ map (getResult num) $ hasFeatures [ (const True, filterHighLevel vCoeffs num vInput), (const True, filterCRC vCoeffs num vInput), (hasSSE42, filterCSSERC vCoeffs2 num vInput), @@ -125,7 +125,7 @@ vInput = VS.fromList inBuf num = (size - numCoeffs*2 + 1) `quot` factor - res <- run $ sameResultM eqDelta $ map (getResult num $) $ hasFeatures [ + res <- run $ sameResultM eqDelta $ map (getResult num) $ hasFeatures [ (const True, decimateHighLevel factor vCoeffs num vInput), (const True, decimateCRR factor vCoeffs num vInput), (hasSSE42, decimateCSSERR factor vCoeffs num vInput), @@ -152,7 +152,7 @@ num = (size - numCoeffs*2 + 1) `quot` factor vCoeffs2 = VG.fromList $ duplicate $ coeffs ++ reverse coeffs - res <- run $ sameResultM eqDeltaC $ map (getResult num $) $ hasFeatures [ + res <- run $ sameResultM eqDeltaC $ map (getResult num) $ hasFeatures [ (const True, decimateHighLevel factor vCoeffs num vInput), (const True, decimateCRC factor vCoeffs num vInput), (hasSSE42, decimateCSSERC factor vCoeffs2 num vInput), @@ -186,7 +186,7 @@ resampler4 <- run $ resampleCSSERR interpolation decimation (coeffs ++ reverse coeffs) resampler5 <- run $ resampleCAVXRR interpolation decimation (coeffs ++ reverse coeffs) - res <- run $ sameResultM eqDelta $ map (getResult num $) $ hasFeatures [ + res <- run $ sameResultM eqDelta $ map (getResult num) $ hasFeatures [ (const True, void . resampleHighLevel interpolation decimation vCoeffs offset num vInput), (const True, void . resampleCRR num interpolation decimation offset vCoeffs vInput), (const True, void . resampler3 group num vInput), @@ -218,7 +218,7 @@ resampler4 <- run $ resampleCSSERC interpolation decimation (coeffs ++ reverse coeffs) resampler5 <- run $ resampleCAVXRC interpolation decimation (coeffs ++ reverse coeffs) - res <- run $ sameResultM eqDeltaC $ map (getResult num $) $ hasFeatures [ + res <- run $ sameResultM eqDeltaC $ map (getResult num) $ hasFeatures [ (const True, void . resampleHighLevel interpolation decimation vCoeffs offset num vInput), (const True, void . resampler3 group num vInput), (hasSSE42, void . resampler4 group num vInput), @@ -234,7 +234,7 @@ testConversionRTLSDR size inBuf = monadicIO $ do let vInput = VS.fromList $ map fromIntegral inBuf - let res = sameResult eqDeltaC $ map (VG.toList $) $ hasFeatures [ + let res = sameResult eqDeltaC $ map VG.toList $ hasFeatures [ (const True, (interleavedIQUnsigned256ToFloat vInput :: VS.Vector (Complex Float))), (const True, interleavedIQUnsignedByteToFloat vInput), (hasSSE42, interleavedIQUnsignedByteToFloatSSE vInput), @@ -250,7 +250,7 @@ testConversionBladeRF size inBuf = monadicIO $ do let vInput = VS.fromList $ map fromIntegral inBuf - let res = sameResult eqDeltaC $ map (VG.toList $) $ hasFeatures [ + let res = sameResult eqDeltaC $ map VG.toList $ hasFeatures [ (const True, (interleavedIQSigned2048ToFloat vInput :: VS.Vector (Complex Float))), (const True, interleavedIQSignedWordToFloat vInput), (hasSSE42, interleavedIQSignedWordToFloatSSE vInput), @@ -268,7 +268,7 @@ testScaleReal size inBuf factor = monadicIO $ do let vInput = VS.fromList inBuf - res <- run $ sameResultM eqDelta $ map (getResult size $) $ hasFeatures [ + res <- run $ sameResultM eqDelta $ map (getResult size) $ hasFeatures [ (const True, scaleC factor vInput), (hasSSE42, scaleCSSE factor vInput), (hasAVX, scaleCAVX factor vInput) @@ -281,14 +281,14 @@ func outBuf out :: VS.Vector a <- VG.freeze outBuf return $ VG.toList out - eqDelta x y = and $ map (uncurry eqDelta') $ zip x y + eqDelta x y = all (uncurry eqDelta') $ zip x y where eqDelta' x y = abs (x - y) < 0.01 - eqDeltaC x y = and $ map (uncurry eqDelta') $ zip x y + eqDeltaC x y = all (uncurry eqDelta') $ zip x y where eqDelta' x y = magnitude (x - y) < 0.01 duplicate :: [a] -> [a] - duplicate = concat . map func + duplicate = concatMap func where func x = [x, x] main = do