diff --git a/core/src/Streamly/Internal/Data/Array.hs b/core/src/Streamly/Internal/Data/Array.hs index d62dc67848..edcf6295ad 100644 --- a/core/src/Streamly/Internal/Data/Array.hs +++ b/core/src/Streamly/Internal/Data/Array.hs @@ -43,7 +43,8 @@ module Streamly.Internal.Data.Array , cast , asBytes , unsafeCast - , asCStringUnsafe + , asCStringUnsafe -- XXX asCString + , asCWString -- * Subarrays -- , sliceOffLen @@ -114,8 +115,7 @@ import Control.Monad.IO.Class (MonadIO(..)) import Data.Functor.Identity (Identity(..)) import Data.Proxy (Proxy(..)) import Data.Word (Word8) -import Foreign.C.String (CString) -import Foreign.Ptr (castPtr) +import Foreign.C.String (CString, CWString) import GHC.Types (SPEC(..)) import Streamly.Internal.Data.Unbox (Unbox(..)) import Prelude hiding (length, null, last, map, (!!), read, concat) @@ -424,9 +424,8 @@ cast arr = then Nothing else Just $ unsafeCast arr --- | Convert an array of any type into a null terminated CString Ptr. If the --- array is unpinned it is first converted to a pinned array which requires a --- copy. +-- | Convert an array of any element type into a null terminated CString Ptr. +-- The array is copied to pinned memory. -- -- /Unsafe/ -- @@ -435,10 +434,19 @@ cast arr = -- /Pre-release/ -- asCStringUnsafe :: Array a -> (CString -> IO b) -> IO b -asCStringUnsafe arr act = do - let arr1 = asBytes arr <> fromList [0] - -- unsafePinnedAsPtr makes sure the array is pinned - unsafePinnedAsPtr arr1 $ \ptr _ -> act (castPtr ptr) +asCStringUnsafe arr = MA.asCString (unsafeThaw arr) + +-- | Convert an array of any element type into a null terminated CWString Ptr. +-- The array is copied to pinned memory. +-- +-- /Unsafe/ +-- +-- /O(n) Time: (creates a copy of the array)/ +-- +-- /Pre-release/ +-- +asCWString :: Array a -> (CWString -> IO b) -> IO b +asCWString arr = MA.asCWString (unsafeThaw arr) ------------------------------------------------------------------------------- -- Folds diff --git a/core/src/Streamly/Internal/Data/MutArray/Type.hs b/core/src/Streamly/Internal/Data/MutArray/Type.hs index 6701cfe75c..8aca1a466a 100644 --- a/core/src/Streamly/Internal/Data/MutArray/Type.hs +++ b/core/src/Streamly/Internal/Data/MutArray/Type.hs @@ -44,7 +44,9 @@ module Streamly.Internal.Data.MutArray.Type , cast , unsafeCast , asBytes - , unsafeAsPtr + , unsafeAsPtr -- XXX asPtr + , asCString + , asCWString -- ** Construction , empty @@ -466,8 +468,9 @@ import Data.Char (ord) import Data.Functor.Identity (Identity(..)) import Data.Proxy (Proxy(..)) import Data.Word (Word8, Word16) -import Foreign.C.Types (CSize(..)) -import Foreign.Ptr (plusPtr) +import Foreign.C.String (CString, CWString) +import Foreign.C.Types (CSize(..), CChar, CWchar) +import Foreign.Ptr (plusPtr, castPtr) import Streamly.Internal.Data.MutByteArray.Type ( MutByteArray(..) , PinnedState(..) @@ -3569,6 +3572,28 @@ unsafeCreateWithPtr' cap pop = do ++ "length = " ++ show len ++ ", " ++ "capacity = " ++ show cap +asCString :: MutArray a -> (CString -> IO b) -> IO b +asCString arr act = do + let pinned = isPinned arr + req = byteLength arr + SIZE_OF(CChar) + arr1 <- + if byteCapacity arr < req || not pinned + then reallocExplicitAs Pinned 1 req arr + else return arr + arr2 :: MutArray CChar <- snocUnsafe (unsafeCast arr1) (0 :: CChar) + unsafeAsPtr arr2 $ \ptr _ -> act (castPtr ptr) + +asCWString :: MutArray a -> (CWString -> IO b) -> IO b +asCWString arr act = do + let pinned = isPinned arr + req = byteLength arr + SIZE_OF(CWchar) + arr1 <- + if byteCapacity arr < req || not pinned + then reallocExplicitAs Pinned 1 req arr + else return arr + arr2 :: MutArray CWchar <- snocUnsafe (unsafeCast arr1) (0 :: CWchar) + unsafeAsPtr arr2 $ \ptr _ -> act (castPtr ptr) + ------------------------------------------------------------------------------- -- Equality ------------------------------------------------------------------------------- diff --git a/core/src/Streamly/Internal/Data/Unbox.hs b/core/src/Streamly/Internal/Data/Unbox.hs index dbf3ee2347..c1755a624e 100644 --- a/core/src/Streamly/Internal/Data/Unbox.hs +++ b/core/src/Streamly/Internal/Data/Unbox.hs @@ -42,6 +42,7 @@ module Streamly.Internal.Data.Unbox ) where #include "MachDeps.h" +#include "HsBaseConfig.h" #include "ArrayMacros.h" import Control.Monad (void, when) @@ -51,6 +52,7 @@ import Data.Functor.Const (Const(..)) import Data.Functor.Identity (Identity(..)) import Data.Kind (Type) import Data.Proxy (Proxy (..)) +import Foreign.C.Types (CChar(..), CWchar(..)) import Foreign.Ptr (IntPtr(..), WordPtr(..)) import GHC.Base (IO(..)) import GHC.Fingerprint.Type (Fingerprint(..)) @@ -445,6 +447,11 @@ DERIVE_WRAPPED_UNBOX(Unbox a =>,(Identity a),Identity,a) DERIVE_WRAPPED_UNBOX(Unbox a =>,(Down a),Down,a) #endif DERIVE_WRAPPED_UNBOX(Unbox a =>,(Const a b),Const,a) + +-- XXX Add more CTypes +DERIVE_WRAPPED_UNBOX(,CChar,CChar,HTYPE_CHAR) +DERIVE_WRAPPED_UNBOX(,CWchar,CWchar,HTYPE_WCHAR_T) + DERIVE_BINARY_UNBOX(forall a. Unbox a =>,(Complex a),(:+),a) DERIVE_BINARY_UNBOX(forall a. Unbox a =>,(Ratio a),(:%),a) DERIVE_BINARY_UNBOX(,Fingerprint,Fingerprint,Word64) diff --git a/core/src/Streamly/Internal/FileSystem/Posix/File.hs b/core/src/Streamly/Internal/FileSystem/Posix/File.hs index 43a3ee96b5..9ca6a6a491 100644 --- a/core/src/Streamly/Internal/FileSystem/Posix/File.hs +++ b/core/src/Streamly/Internal/FileSystem/Posix/File.hs @@ -33,7 +33,6 @@ import GHC.IO.Handle.FD (fdToHandle) import System.Posix.Types (Fd(..), CMode(..), FileMode) import Streamly.Internal.FileSystem.Posix.Errno (throwErrnoPathIfMinus1Retry) -import qualified Streamly.Internal.Data.Array as Array import qualified Streamly.Internal.FileSystem.PosixPath as Path -- import qualified GHC.IO.FD as FD @@ -124,9 +123,6 @@ openFdAtWith_ OpenFlags{..} fdMay path how = all_flags = creat_f .|. flags .|. open_mode -withFilePath :: PosixPath -> (CString -> IO a) -> IO a -withFilePath p = Array.asCStringUnsafe (Path.toChunk p) - -- | Open a file relative to an optional directory file descriptor. -- -- {-# INLINE openFdAtWith #-} @@ -137,7 +133,7 @@ openFdAtWith :: -> OpenMode -- ^ Read-only, read-write or write-only -> IO Fd openFdAtWith flags fdMay name how = - withFilePath name $ \str -> do + Path.asCString name $ \str -> do throwErrnoPathIfMinus1Retry "openFdAt" name $ openFdAtWith_ flags fdMay str how diff --git a/core/src/Streamly/Internal/FileSystem/PosixPath.hs b/core/src/Streamly/Internal/FileSystem/PosixPath.hs index 71c3696b32..9c6629659b 100644 --- a/core/src/Streamly/Internal/FileSystem/PosixPath.hs +++ b/core/src/Streamly/Internal/FileSystem/PosixPath.hs @@ -76,8 +76,11 @@ module Streamly.Internal.FileSystem.OS_PATH , toChars , toChars_ , toString - -- , toCString - -- , toW16CString +#ifndef IS_WINDOWS + , asCString +#else + , asCWString +#endif , toString_ , showRaw @@ -128,12 +131,15 @@ import Data.Word (Word16) #endif #ifndef IS_WINDOWS import Foreign.C (CString) +#else +import Foreign.C (CWString) #endif import Language.Haskell.TH.Syntax (lift) import Streamly.Internal.Data.Array (Array(..)) import Streamly.Internal.Data.Stream (Stream) import Streamly.Internal.FileSystem.Path.Common (mkQ, EqCfg(..), eqCfg) +import qualified Streamly.Internal.Data.Array as Array import qualified Streamly.Internal.Data.Stream as Stream import qualified Streamly.Internal.FileSystem.Path.Common as Common import qualified Streamly.Internal.Unicode.Stream as Unicode @@ -382,6 +388,16 @@ instance Show OS_PATH where show (OS_PATH x) = show x -} +#ifndef IS_WINDOWS +{-# INLINE asCString #-} +asCString :: OS_PATH -> (CString -> IO a) -> IO a +asCString p = Array.asCStringUnsafe (toChunk p) +#else +{-# INLINE asCWString #-} +asCWString :: OS_PATH -> (CWString -> IO a) -> IO a +asCWString p = Array.asCWString (toChunk p) +#endif + ------------------------------------------------------------------------------ -- Operations on Path ------------------------------------------------------------------------------