diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,10 @@ # j +## 0.1.1.0 + + * Add `libWindows` + * Support for Windows + ## 0.1.0.0 Initial release 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.1.0.0 +version: 0.1.1.0 license: BSD3 license-file: LICENSE copyright: Copyright: (c) 2020 Vanessa McHale @@ -22,14 +22,19 @@ exposed-modules: Language.J hs-source-dirs: src default-language: Haskell2010 - other-extensions: FlexibleContexts OverloadedStrings CPP + other-extensions: FlexibleContexts OverloadedStrings ghc-options: -Wall build-depends: base >=4.7 && <5, - unix -any, - bytestring -any, - repa -any + bytestring >=0.10, + repa >=3.2.5.0 + if !os(windows) + build-depends: unix >=2.7.0.0 + + else + build-depends: Win32 -any + if !impl(ghc >=8.0) build-depends: semigroups -any @@ -52,6 +57,7 @@ main-is: Spec.hs hs-source-dirs: test default-language: Haskell2010 + other-extensions: CPP OverloadedStrings ghc-options: "-with-rtsopts -K1K" -Wall build-depends: base -any, diff --git a/src/Language/J.hs b/src/Language/J.hs --- a/src/Language/J.hs +++ b/src/Language/J.hs @@ -46,7 +46,7 @@ -- 3. Perform calculations within the J environment. Here, we use -- 'bsDispatch' to compute some results and assign them within J -- --- 4. Marshal J values back to Haskell. We use 'getJData' again. +-- 4. Marshal J values back to Haskell. We use 'getJData'. -- -- -- Since marshaling data between J and Haskell is expensive, it's best to do as @@ -58,8 +58,12 @@ module Language.J ( -- * Environment JEnv (..) , jinit +#ifndef mingw32_HOST_OS , libLinux , libMac +#else + , libWindows +#endif , bsDispatch , bsOut , JVersion @@ -87,9 +91,14 @@ import Foreign.C.Types (CChar, CDouble, CInt (..), CLLong (..)) import Foreign.ForeignPtr (ForeignPtr, castForeignPtr, mallocForeignPtrBytes, withForeignPtr) import Foreign.Marshal (alloca, copyArray, mallocBytes, peekArray, pokeArray) -import Foreign.Ptr (FunPtr, Ptr, plusPtr) +import Foreign.Ptr (FunPtr, Ptr, castPtrToFunPtr, plusPtr) import Foreign.Storable (Storable, peek, pokeByteOff, sizeOf) +import System.Info (arch) +#ifndef mingw32_HOST_OS import System.Posix.ByteString (RTLDFlags (RTLD_LAZY), RawFilePath, dlopen, dlsym) +#else +import System.Win32.DLL (getProcAddress, loadLibrary) +#endif -- Upstream reference -- https://github.com/jsoftware/stats_jserver4r/blob/4c94fc6df351fab34791aa9d78d158eaefd33b17/source/lib/j2r.c @@ -116,21 +125,29 @@ foreign import ccall "dynamic" mkJGetR :: FunPtr JGetRType -> JGetRType foreign import ccall "dynamic" mkJSetA :: FunPtr JSetAType -> JSetAType +type JVersion = [Int] + +squashVersion :: JVersion -> String +squashVersion = concatMap show + +#ifndef mingw32_HOST_OS -- | Expected 'RawFilePath' to the library on a Linux machine. libLinux :: RawFilePath -libLinux = "/usr/lib/x86_64-linux-gnu/libj.so" - -type JVersion = [Int] +libLinux = "/usr/lib/" <> ASCII.pack arch <> "-linux-gnu/libj.so" -- | Expected 'RawFilePath' to the library on Mac. libMac :: JVersion -> RawFilePath -libMac v = "/Applications/j64-" <> ASCII.pack (concatMap show v) <> "/bin/libj.dylib" - --- process address +libMac v = "/Applications/j64-" <> ASCII.pack (squashVersion v) <> "/bin/libj.dylib" +#else +-- | @since 0.1.1.0 +libWindows :: JVersion -> FilePath +libWindows v = "C:\\Program Files\\J" <> squashVersion v <> "\\bin\\j.dll" +#endif -- | Get a J environment -- -- Passing the resultant 'JEnv' between threads can cause unexpected bugs. +#ifndef mingw32_HOST_OS jinit :: RawFilePath -- ^ Path to J library -> IO JEnv jinit libFp = do @@ -141,6 +158,19 @@ let jOut = mkJGetR <$> dlsym libj "JGetR" let jSet = mkJSetA <$> dlsym libj "JSetA" JEnv jt <$> jeval <*> jread <*> jOut <*> jSet +#else +jinit :: FilePath + -> IO JEnv +jinit libFp = do + libj <- loadLibrary libFp + jt <- mkJInit . castPtrToFunPtr =<< getProcAddress libj "JInit" + let jeval = mkJDo . castPtrToFunPtr <$> getProcAddress libj "JDo" + let jread = mkJGetM . castPtrToFunPtr <$> getProcAddress libj "JGetM" + let jOut = mkJGetR . castPtrToFunPtr <$> getProcAddress libj "JGetR" + let jSet = mkJSetA . castPtrToFunPtr <$> getProcAddress libj "JSetA" + JEnv jt <$> jeval <*> jread <*> jOut <*> jSet +#endif + -- | Send some J code to the environment. bsDispatch :: JEnv -> BS.ByteString -> IO () diff --git a/test/Spec.hs b/test/Spec.hs --- a/test/Spec.hs +++ b/test/Spec.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} module Main ( main ) where @@ -12,7 +13,17 @@ main :: IO () main = do +#ifdef linux_HOST_OS jenv <- jinit libLinux +#else +#ifdef darwin_HOST_OS + jenv <- jinit (libMac [8,0,7]) +#else +#ifdef mingw32_HOST_OS + jenv <- jinit (libWindows [9,0,1]) +#endif +#endif +#endif defaultMain $ testGroup "J dl" [ testCase "Performs calculation and has sensible output" (jComp jenv) @@ -20,9 +31,19 @@ , testCase "Reads a string" (jStr jenv) , testCase "Sends an array to J" (jSetA jenv) , testCase "Uses J to perform a complex calculation" (regress jenv) - , testCase "Writes strigns to J values" (stringRoundtrip jenv) + , testCase "Writes strings to J values" (stringRoundtrip jenv) + -- , testCase "Uses J for something Haskell would have a hard time with" (fill jenv) ] + +fill :: JEnv -> Assertion +fill jenv = do + bsDispatch jenv "random_res =: ? 70 70 $ 1e10" + res <- getJData jenv "random_res" + extrExtent res @?= [70, 70] + where extrExtent :: JData R.DIM2 -> [Int] + extrExtent (JIntArr res) = R.listOfShape $ R.extent res + regress :: JEnv -> Assertion regress jenv = do let hsArr0 = R.fromListUnboxed (R.ix1 3) [1.0,2.0,3.0] @@ -61,19 +82,15 @@ unwrapStr :: JData R.Z -> BS.ByteString unwrapStr (JString bs) = bs -unwrapStr _ = error "Test suite error." doubleVect :: JData R.DIM1 -> [CDouble] doubleVect (JDoubleArr arr) = R.toList arr -doubleVect _ = error "Test suite failure!" doubleScalar :: JData R.Z -> [CDouble] doubleScalar (JDoubleArr arr) = R.toList arr -doubleScalar _ = error "Test suite failure!" intList :: JData R.DIM1 -> [CInt] intList (JIntArr arr) = R.toList arr -intList _ = error "Test suite failure!" jType :: JEnv -> Assertion jType jenv = do