-{-# OPTIONS_GHC -fno-implicit-prelude -funbox-strict-fields #-}
+{-# OPTIONS_GHC -XNoImplicitPrelude -funbox-strict-fields #-}
{-# LANGUAGE BangPatterns #-}
-----------------------------------------------------------------------------
-- |
import GHC.Base
import GHC.Real
import GHC.Num
-import GHC.IO
+-- import GHC.IO
import GHC.IO.Exception
import GHC.IO.Buffer
import GHC.IO.Encoding.Types
import System.Posix.Internals
import Foreign.C
import GHC.Show
+import GHC.Ptr
puts :: String -> IO ()
puts s = do withCStringLen (s++"\n") $ \(p,len) ->
- c_write 1 p (fromIntegral len)
+ c_write 1 (castPtr p) (fromIntegral len)
return ()
#endif
-- The UTF-16 codec: either UTF16BE or UTF16LE with a BOM
utf16 :: TextEncoding
-utf16 = TextEncoding { mkTextDecoder = utf16_DF,
+utf16 = TextEncoding { textEncodingName = "UTF-16",
+ mkTextDecoder = utf16_DF,
mkTextEncoder = utf16_EF }
-utf16_DF :: IO TextDecoder
+utf16_DF :: IO (TextDecoder (Maybe DecodeBuffer))
utf16_DF = do
seen_bom <- newIORef Nothing
- return (BufferCodec (utf16_decode seen_bom) (return ()))
-
-utf16_EF :: IO TextEncoder
+ return (BufferCodec {
+ encode = utf16_decode seen_bom,
+ close = return (),
+ getState = readIORef seen_bom,
+ setState = writeIORef seen_bom
+ })
+
+utf16_EF :: IO (TextEncoder Bool)
utf16_EF = do
done_bom <- newIORef False
- return (BufferCodec (utf16_encode done_bom) (return ()))
+ return (BufferCodec {
+ encode = utf16_encode done_bom,
+ close = return (),
+ getState = readIORef done_bom,
+ setState = writeIORef done_bom
+ })
utf16_encode :: IORef Bool -> EncodeBuffer
utf16_encode done_bom input
-- UTF16LE and UTF16BE
utf16be :: TextEncoding
-utf16be = TextEncoding { mkTextDecoder = utf16be_DF,
+utf16be = TextEncoding { textEncodingName = "UTF-16BE",
+ mkTextDecoder = utf16be_DF,
mkTextEncoder = utf16be_EF }
-utf16be_DF :: IO TextDecoder
-utf16be_DF = return (BufferCodec utf16be_decode (return ()))
-
-utf16be_EF :: IO TextEncoder
-utf16be_EF = return (BufferCodec utf16be_encode (return ()))
-
+utf16be_DF :: IO (TextDecoder ())
+utf16be_DF =
+ return (BufferCodec {
+ encode = utf16be_decode,
+ close = return (),
+ getState = return (),
+ setState = const $ return ()
+ })
+
+utf16be_EF :: IO (TextEncoder ())
+utf16be_EF =
+ return (BufferCodec {
+ encode = utf16be_encode,
+ close = return (),
+ getState = return (),
+ setState = const $ return ()
+ })
utf16le :: TextEncoding
-utf16le = TextEncoding { mkTextDecoder = utf16le_DF,
+utf16le = TextEncoding { textEncodingName = "UTF16-LE",
+ mkTextDecoder = utf16le_DF,
mkTextEncoder = utf16le_EF }
-utf16le_DF :: IO TextDecoder
-utf16le_DF = return (BufferCodec utf16le_decode (return ()))
-
-utf16le_EF :: IO TextEncoder
-utf16le_EF = return (BufferCodec utf16le_encode (return ()))
-
+utf16le_DF :: IO (TextDecoder ())
+utf16le_DF =
+ return (BufferCodec {
+ encode = utf16le_decode,
+ close = return (),
+ getState = return (),
+ setState = const $ return ()
+ })
+
+utf16le_EF :: IO (TextEncoder ())
+utf16le_EF =
+ return (BufferCodec {
+ encode = utf16le_encode,
+ close = return (),
+ getState = return (),
+ setState = const $ return ()
+ })
utf16be_decode :: DecodeBuffer
c1 <- readWord8Buf iraw (ir+1)
let x1 = fromIntegral c0 `shiftL` 8 + fromIntegral c1
if validate1 x1
- then do writeCharBuf oraw ow (unsafeChr (fromIntegral x1))
- loop (ir+2) (ow+1)
+ then do ow' <- writeCharBuf oraw ow (unsafeChr (fromIntegral x1))
+ loop (ir+2) ow'
else if iw - ir < 4 then done ir ow else do
c2 <- readWord8Buf iraw (ir+2)
c3 <- readWord8Buf iraw (ir+3)
let x2 = fromIntegral c2 `shiftL` 8 + fromIntegral c3
if not (validate2 x1 x2) then invalid else do
- writeCharBuf oraw ow (chr2 x1 x2)
- loop (ir+4) (ow+1)
+ ow' <- writeCharBuf oraw ow (chr2 x1 x2)
+ loop (ir+4) ow'
where
invalid = if ir > ir0 then done ir ow else ioe_decodingError
c1 <- readWord8Buf iraw (ir+1)
let x1 = fromIntegral c1 `shiftL` 8 + fromIntegral c0
if validate1 x1
- then do writeCharBuf oraw ow (unsafeChr (fromIntegral x1))
- loop (ir+2) (ow+1)
+ then do ow' <- writeCharBuf oraw ow (unsafeChr (fromIntegral x1))
+ loop (ir+2) ow'
else if iw - ir < 4 then done ir ow else do
c2 <- readWord8Buf iraw (ir+2)
c3 <- readWord8Buf iraw (ir+3)
let x2 = fromIntegral c3 `shiftL` 8 + fromIntegral c2
if not (validate2 x1 x2) then invalid else do
- writeCharBuf oraw ow (chr2 x1 x2)
- loop (ir+4) (ow+1)
+ ow' <- writeCharBuf oraw ow (chr2 x1 x2)
+ loop (ir+4) ow'
where
invalid = if ir > ir0 then done ir ow else ioe_decodingError