diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,9 @@ # j +## 0.2.1.0 + + * Add support for J's complex type + ## 0.2.0.0 * Fix bug in integer arrays passed to J diff --git a/j.cabal b/j.cabal --- a/j.cabal +++ b/j.cabal @@ -1,6 +1,6 @@ cabal-version: 1.18 name: j -version: 0.2.0.0 +version: 0.2.1.0 license: BSD3 license-file: LICENSE copyright: Copyright: (c) 2020 Vanessa McHale diff --git a/src/Language/J.hs b/src/Language/J.hs --- a/src/Language/J.hs +++ b/src/Language/J.hs @@ -105,6 +105,7 @@ import qualified Data.ByteString as BS import qualified Data.ByteString.Char8 as ASCII import qualified Data.ByteString.Internal as BS +import Data.Complex (Complex (..)) import Data.Functor (void) import Data.Semigroup ((<>)) import Foreign.C.String (CString) @@ -267,11 +268,7 @@ rank' <- peek r let intRank = fromIntegral rank' shape' <- peekArray intRank =<< peek s - let mult = case ty' of - JBool -> sizeOf (undefined :: CChar) - JChar -> sizeOf (undefined :: CChar) - JInteger -> sizeOf (undefined :: CLLong) - JDouble -> sizeOf (undefined :: CDouble) + let mult = jTypeWidth ty' let resBytes = mult * intRank res <- mallocForeignPtrBytes resBytes let arrSz = mult * fromIntegral (product shape') @@ -285,6 +282,7 @@ -- | J data backed by repa array data JData sh = JIntArr !(R.Array RF.F sh CLLong) | JDoubleArr !(R.Array RF.F sh CDouble) + | JComplexArr !(R.Array RF.F sh (Complex CDouble)) | JBoolArr !(R.Array RF.F sh CChar) | JString !BS.ByteString @@ -297,6 +295,9 @@ setJData (JEnv ctx _ _ _ jset) name (JDoubleArr iarr) = BS.useAsCStringLen name $ \(n, sz) -> do (ds, d) <- repaArr JDouble iarr jset ctx (fromIntegral sz) n ds d +setJData (JEnv ctx _ _ _ jset) name (JComplexArr iarr) = BS.useAsCStringLen name $ \(n, sz) -> do + (ds, d) <- repaArr JComplex iarr + jset ctx (fromIntegral sz) n ds d setJData (JEnv ctx _ _ _ jset) name (JBoolArr iarr) = BS.useAsCStringLen name $ \(n, sz) -> do (ds, d) <- repaArr JBool iarr jset ctx (fromIntegral sz) n ds d @@ -306,12 +307,12 @@ -- | Return a @'Ptr' ()@ suitable to be passed to @JSetA@ -- --- To be used on integer and double arrays +-- To be used on integer, double, and complex arrays repaArr :: (R.Shape sh, Storable e) => JType -> R.Array RF.F sh e -> IO (CLLong, Ptr ()) repaArr jty arr = do let (rank', sh) = repaSize arr sz = product sh - let wid = 32 + 8 * (rank' + sz) + let wid = 32 + (fromIntegral $ jTypeWidth jty) * (rank' + sz) ptr <- mallocBytes (fromIntegral wid) pokeByteOff ptr 0 (227 :: CLLong) -- I think this is because it's non-boxed pokeByteOff ptr (sizeOf (undefined :: CLLong)) (jTypeToInt jty) @@ -348,23 +349,34 @@ | JChar | JInteger | JDouble + | JComplex intToJType :: CLLong -> JType -intToJType 1 = JBool -intToJType 2 = JChar -intToJType 4 = JInteger -intToJType 8 = JDouble -intToJType _ = error "Unsupported type!" +intToJType 1 = JBool +intToJType 2 = JChar +intToJType 4 = JInteger +intToJType 8 = JDouble +intToJType 16 = JComplex +intToJType _ = error "Unsupported type!" jTypeToInt :: JType -> CLLong jTypeToInt JBool = 1 jTypeToInt JChar = 2 jTypeToInt JInteger = 4 jTypeToInt JDouble = 8 +jTypeToInt JComplex = 16 +jTypeWidth :: JType -> Int +jTypeWidth JBool = sizeOf (undefined :: CChar) +jTypeWidth JChar = sizeOf (undefined :: CChar) +jTypeWidth JInteger = sizeOf (undefined :: CLLong) +jTypeWidth JDouble = sizeOf (undefined :: CDouble) +jTypeWidth JComplex = sizeOf (undefined :: Complex CDouble) + jData :: R.Shape sh => JAtom -> JData sh jData (JAtom JInteger sh fp) = JIntArr $ RF.fromForeignPtr (R.shapeOfList $ fmap fromIntegral sh) (castForeignPtr fp) jData (JAtom JDouble sh fp) = JDoubleArr $ RF.fromForeignPtr (R.shapeOfList $ fmap fromIntegral sh) (castForeignPtr fp) +jData (JAtom JComplex sh fp) = JComplexArr $ RF.fromForeignPtr (R.shapeOfList $ fmap fromIntegral sh) (castForeignPtr fp) jData (JAtom JBool sh fp) = JBoolArr $ RF.fromForeignPtr (R.shapeOfList $ fmap fromIntegral sh) (castForeignPtr fp) jData (JAtom JChar [l] fp) = JString $ BS.fromForeignPtr (castForeignPtr fp) 0 (fromIntegral l) jData (JAtom JChar _ _) = error "Not supported." diff --git a/test/Spec.hs b/test/Spec.hs --- a/test/Spec.hs +++ b/test/Spec.hs @@ -6,6 +6,7 @@ import Control.Applicative ((<$>)) import qualified Data.Array.Repa as R import qualified Data.ByteString as BS +import Data.Complex (Complex (..)) import Foreign.C.Types (CDouble, CLLong) import Language.J import Test.Tasty @@ -29,7 +30,9 @@ [ testCase "Performs calculation and has sensible output" (jComp jenv) , testCase "Reads back type in the environment" (jType jenv) , testCase "Reads a string" (jStr jenv) + , testCase "Reads a complex array" (jGetC jenv) , testCase "Sends an array to J" (jSetA jenv) + , testCase "Sends a complex array to J" (jSetC jenv) , testCase "Uses J to perform a complex calculation" (regress jenv) , testCase "Writes strings to J values" (stringRoundtrip jenv) -- , testCase "Uses J for something Haskell would have a hard time with" (fill jenv) @@ -93,12 +96,26 @@ res <- getJData jenv "b" intList res @?= [1,3,6] +jSetC :: JEnv -> Assertion +jSetC jenv = do + let hsArr = R.fromListUnboxed (R.ix1 2) [0.0:+0.0,1.0:+1.0 :: Complex Double] + let conv = fmap realToFrac :: Complex Double -> Complex CDouble + setJData jenv "c" (JComplexArr $ R.copyS $ R.map conv hsArr) + res <- getJData jenv "c" + complexVect res @?= [0.0:+0.0,1.0:+1.0] + jStr :: JEnv -> Assertion jStr jenv = do bsDispatch jenv "str =: 'hello'" res <- getJData jenv "str" unwrapStr res @?= "hello" +jGetC :: JEnv -> Assertion +jGetC jenv = do + bsDispatch jenv "c =: j./~ i.2" + res <- getJData jenv "c" + complexVect2 res @?= [0.0:+0.0, 0.0:+1.0, 1.0:+0.0, 1.0:+1.0] + jComp :: JEnv -> Assertion jComp jenv = do bsDispatch jenv "harmonic =: (+/ % #) &.: %" @@ -114,6 +131,12 @@ doubleScalar :: JData R.Z -> [CDouble] doubleScalar (JDoubleArr arr) = R.toList arr + +complexVect2 :: JData R.DIM2 -> [Complex CDouble] +complexVect2 (JComplexArr arr) = R.toList arr + +complexVect :: JData R.DIM1 -> [Complex CDouble] +complexVect (JComplexArr arr) = R.toList arr intList :: JData R.DIM1 -> [CLLong] intList (JIntArr arr) = R.toList arr