-hPutFS handle (FastString _ l# ba#) =
- if l# ==# 0# then
- return ()
- else
- _readHandle handle >>= \ htype ->
- case htype of
- _ErrorHandle ioError ->
- _writeHandle handle htype >>
- failWith ioError
- _ClosedHandle ->
- _writeHandle handle htype >>
- failWith MkIOError(handle,IllegalOperation,"handle is closed")
- _SemiClosedHandle _ _ ->
- _writeHandle handle htype >>
- failWith MkIOError(handle,IllegalOperation,"handle is closed")
- _ReadHandle _ _ _ ->
- _writeHandle handle htype >>
- failWith MkIOError(handle,IllegalOperation,"handle is not open for writing")
- other ->
- let fp = _filePtr htype in
- -- here we go..
- _ccall_ writeFile (_ByteArray ((error "")::(Int,Int)) ba#) fp (I# l#) `CCALL_THEN` \rc ->
- if rc==0 then
- return ()
- else
- _constructError "hPutFS" `CCALL_THEN` \ err ->
- failWith err
-hPutFS handle (CharStr a# l#) =
- if l# ==# 0# then
- return ()
- else
- _readHandle handle >>= \ htype ->
- case htype of
- _ErrorHandle ioError ->
- _writeHandle handle htype >>
- failWith ioError
- _ClosedHandle ->
- _writeHandle handle htype >>
- failWith MkIOError(handle,IllegalOperation,"handle is closed")
- _SemiClosedHandle _ _ ->
- _writeHandle handle htype >>
- failWith MkIOError(handle,IllegalOperation,"handle is closed")
- _ReadHandle _ _ _ ->
- _writeHandle handle htype >>
- failWith MkIOError(handle,IllegalOperation,"handle is not open for writing")
- other ->
- let fp = _filePtr htype in
- -- here we go..
- _ccall_ writeFile (A# a#) fp (I# l#) `CCALL_THEN` \rc ->
- if rc==0 then
- return ()
- else
- _constructError "hPutFS" `CCALL_THEN` \ err ->
- failWith err
-
---ToDo: avoid silly code duplic.
+hPutFS handle (FastString _ l# ba#)
+ | l# ==# 0# = return ()
+ | otherwise = do mba <- stToIO $ unsafeThawByteArray (ByteArray (bot::Int) bot ba#)
+ hPutBufBAFull handle mba (I# l#)
+ where
+ bot = error "hPutFS.ba"
+
+#endif
+
+-- ONLY here for debugging the NCG (so -ddump-stix works for string
+-- literals); no idea if this is really necessary. JRS, 010131
+hPutFS handle (UnicodeStr _ is)
+ = hPutStr handle ("(UnicodeStr " ++ show is ++ ")")
+
+-- -----------------------------------------------------------------------------
+-- LitStrings, here for convenience only.
+
+type LitString = Ptr ()
+
+mkLitString# :: Addr# -> LitString
+mkLitString# a# = Ptr a#