diff options
| -rw-r--r-- | compiler/GHC/Data/StringBuffer.hs | 30 |
1 files changed, 18 insertions, 12 deletions
diff --git a/compiler/GHC/Data/StringBuffer.hs b/compiler/GHC/Data/StringBuffer.hs index 42ab89f8cc..891598d683 100644 --- a/compiler/GHC/Data/StringBuffer.hs +++ b/compiler/GHC/Data/StringBuffer.hs @@ -68,6 +68,12 @@ import GHC.IO.Encoding.Failure ( CodingFailureMode(IgnoreCodingFailure) ) import GHC.Exts import Foreign +#if MIN_VERSION_base(4,15,0) +import GHC.ForeignPtr (unsafeWithForeignPtr) +#else +unsafeWithForeignPtr :: ForeignPtr a -> (Ptr a -> IO b) -> IO b +unsafeWithForeignPtr = withForeignPtr +#endif -- ----------------------------------------------------------------------------- -- The StringBuffer type @@ -107,7 +113,7 @@ hGetStringBuffer fname = do offset_i <- skipBOM h size_i 0 -- offset is 0 initially let size = fromIntegral $ size_i - offset_i buf <- mallocForeignPtrArray (size+3) - withForeignPtr buf $ \ptr -> do + unsafeWithForeignPtr buf $ \ptr -> do r <- if size == 0 then return 0 else hGetBuf h ptr size hClose h if (r /= size) @@ -120,7 +126,7 @@ hGetStringBufferBlock handle wanted offset_i <- hTell handle >>= skipBOM handle size_i let size = min wanted (fromIntegral $ size_i-offset_i) buf <- mallocForeignPtrArray (size+3) - withForeignPtr buf $ \ptr -> + unsafeWithForeignPtr buf $ \ptr -> do r <- if size == 0 then return 0 else hGetBuf handle ptr size if r /= size then ioError (userError $ "short read of file: "++show(r,size,size_i,handle)) @@ -128,7 +134,7 @@ hGetStringBufferBlock handle wanted hPutStringBuffer :: Handle -> StringBuffer -> IO () hPutStringBuffer hdl (StringBuffer buf len cur) - = withForeignPtr (plusForeignPtr buf cur) $ \ptr -> + = unsafeWithForeignPtr (plusForeignPtr buf cur) $ \ptr -> hPutBuf hdl ptr len -- | Skip the byte-order mark if there is one (see #1744 and #6016), @@ -165,9 +171,9 @@ newUTF8StringBuffer buf ptr size = do appendStringBuffers :: StringBuffer -> StringBuffer -> IO StringBuffer appendStringBuffers sb1 sb2 = do newBuf <- mallocForeignPtrArray (size+3) - withForeignPtr newBuf $ \ptr -> - withForeignPtr (buf sb1) $ \sb1Ptr -> - withForeignPtr (buf sb2) $ \sb2Ptr -> + unsafeWithForeignPtr newBuf $ \ptr -> + unsafeWithForeignPtr (buf sb1) $ \sb1Ptr -> + unsafeWithForeignPtr (buf sb2) $ \sb2Ptr -> do copyArray ptr (sb1Ptr `advancePtr` cur sb1) sb1_len copyArray (ptr `advancePtr` sb1_len) (sb2Ptr `advancePtr` cur sb2) sb2_len pokeArray (ptr `advancePtr` size) [0,0,0] @@ -184,7 +190,7 @@ stringToStringBuffer str = unsafePerformIO $ do let size = utf8EncodedLength str buf <- mallocForeignPtrArray (size+3) - withForeignPtr buf $ \ptr -> do + unsafeWithForeignPtr buf $ \ptr -> do utf8EncodeString ptr str pokeArray (ptr `plusPtr` size :: Ptr Word8) [0,0,0] -- sentinels for UTF-8 decoding @@ -203,7 +209,7 @@ nextChar :: StringBuffer -> (Char,StringBuffer) nextChar (StringBuffer buf len (I# cur#)) = -- Getting our fingers dirty a little here, but this is performance-critical inlinePerformIO $ - withForeignPtr buf $ \(Ptr a#) -> + unsafeWithForeignPtr buf $ \(Ptr a#) -> case utf8DecodeCharAddr# (a# `plusAddr#` cur#) 0# of (# c#, nBytes# #) -> let cur' = I# (cur# +# nBytes#) in @@ -220,7 +226,7 @@ prevChar :: StringBuffer -> Char -> Char prevChar (StringBuffer _ _ 0) deflt = deflt prevChar (StringBuffer buf _ cur) _ = inlinePerformIO $ - withForeignPtr buf $ \p -> do + unsafeWithForeignPtr buf $ \p -> do p' <- utf8PrevChar (p `plusPtr` cur) return (fst (utf8DecodeChar p')) @@ -258,7 +264,7 @@ atEnd (StringBuffer _ l c) = l == c atLine :: Int -> StringBuffer -> Maybe StringBuffer atLine line sb@(StringBuffer buf len _) = inlinePerformIO $ - withForeignPtr buf $ \p -> do + unsafeWithForeignPtr buf $ \p -> do p' <- skipToLine line len p if p' == nullPtr then return Nothing @@ -309,14 +315,14 @@ lexemeToFastString :: StringBuffer lexemeToFastString _ 0 = nilFS lexemeToFastString (StringBuffer buf _ cur) len = inlinePerformIO $ - withForeignPtr buf $ \ptr -> + unsafeWithForeignPtr buf $ \ptr -> return $! mkFastStringBytes (ptr `plusPtr` cur) len -- | Return the previous @n@ characters (or fewer if we are less than @n@ -- characters into the buffer. decodePrevNChars :: Int -> StringBuffer -> String decodePrevNChars n (StringBuffer buf _ cur) = - inlinePerformIO $ withForeignPtr buf $ \p0 -> + inlinePerformIO $ unsafeWithForeignPtr buf $ \p0 -> go p0 n "" (p0 `plusPtr` (cur - 1)) where go :: Ptr Word8 -> Int -> String -> Ptr Word8 -> IO String |