FastString.lhs 17.6 KB
Newer Older
1
2
3
4
5
6
%
% (c) The GRASP/AQUA Project, Glasgow University, 1997
%
\section{Fast strings}

Compact representations of character strings with
sof's avatar
sof committed
7
unique identifiers (hash-cons'ish).
8
9
10
11
12
13
14
15

\begin{code}
module FastString
       (
	FastString(..),     -- not abstract, for now.

         --names?
        mkFastString,       -- :: String -> FastString
16
        mkFastSubString,    -- :: Addr -> Int -> Int -> FastString
17
18
        mkFastSubStringFO,  -- :: ForeignObj -> Int -> Int -> FastString

19
20
21
22
23
24
	-- These ones hold on to the Addr after they return, and aren't hashed; 
	-- they are used for literals
	mkFastCharString,   -- :: Addr -> FastString
	mkFastCharString#,  -- :: Addr# -> FastString
	mkFastCharString2,  -- :: Addr -> Int -> FastString

25
26
27
28
29
	mkFastString#,      -- :: Addr# -> Int# -> FastString
        mkFastSubStringBA#, -- :: ByteArray# -> Int# -> Int# -> FastString
        mkFastSubString#,   -- :: Addr# -> Int# -> Int# -> FastString
        mkFastSubStringFO#, -- :: ForeignObj# -> Int# -> Int# -> FastString
       
30
        uniqueOfFS,	    -- :: FastString -> Int#
31
32
33
34
35
36
37
38
39
40
41
42
	lengthFS,	    -- :: FastString -> Int
	nullFastString,     -- :: FastString -> Bool

	getByteArray#,	    -- :: FastString -> ByteArray#
        getByteArray,       -- :: FastString -> _ByteArray Int
	unpackFS,	    -- :: FastString -> String
	appendFS,	    -- :: FastString -> FastString -> FastString
        headFS,		    -- :: FastString -> Char
        tailFS,		    -- :: FastString -> FastString
	concatFS,	    -- :: [FastString] -> FastString
        consFS,             -- :: Char -> FastString -> FastString

43
        hPutFS		    -- :: Handle -> FastString -> IO ()
44
45
       ) where

46
47
48
49
-- This #define suppresses the "import FastString" that
-- HsVersions otherwise produces
#define COMPILING_FAST_STRING
#include "HsVersions.h"
50

sof's avatar
sof committed
51
#if 0 && __GLASGOW_HASKELL__ < 301
52
import PackBase
53
54
55
56
57
58
59
60
61
import STBase		( StateAndPtr#(..) )
import IOHandle		( filePtr, readHandle, writeHandle )
import IOBase		( Handle__(..), IOError(..), IOErrorType(..),
		  	  IOResult(..), IO(..),
		  	  constructError
			)
#else
import PrelPack
import PrelST		( StateAndPtr#(..) )
sof's avatar
sof committed
62
63
import PrelHandle	( readHandle, 
#if __GLASGOW_HASKELL__ < 303
sof's avatar
sof committed
64
			  filePtr,
sof's avatar
sof committed
65
66
67
#endif
			  writeHandle
			)
68
69
import PrelIOBase	( Handle__(..), IOError(..), IOErrorType(..),
		  	  IOResult(..), IO(..),
sof's avatar
sof committed
70
71
72
#if __GLASGOW_HASKELL__ >= 303
			  Handle__Type(..),
#endif
73
74
75
76
		  	  constructError
			)
#endif

77
import PrimPacked
78
import GlaExts
79
80
import Addr		( Addr(..) )
import MutableArray	( MutableArray(..) )
sof's avatar
sof committed
81
82
83
84
85

-- ForeignObj is now exported abstractly.
#if __GLASGOW_HASKELL__ >= 303
import qualified PrelForeign as Foreign  ( ForeignObj(..) )
#else
86
import Foreign		( ForeignObj(..) )
sof's avatar
sof committed
87
88
#endif

89
import IOExts		( IORef, newIORef, readIORef, writeIORef )
90
import IO
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114

#define hASH_TBL_SIZE 993
\end{code} 

@FastString@s are packed representations of strings
with a unique id for fast comparisons. The unique id
is assigned when creating the @FastString@, using
a hash table to map from the character string representation
to the unique ID.

\begin{code}
data FastString
  = FastString   -- packed repr. on the heap.
      Int#       -- unique id
		 --  0 => string literal, comparison
		 --  will
      Int#       -- length
      ByteArray# -- stuff

  | CharStr      -- external C string
      Addr#      -- pointer to the (null-terminated) bytes in C land.
      Int#       -- length  (cached)

instance Eq FastString where
115
116
  a == b = case cmpFS a b of { LT -> False; EQ -> True;  GT -> False }
  a /= b = case cmpFS a b of { LT -> True;  EQ -> False; GT -> True  }
117

118
119
120
121
122
123
124
125
126
127
instance Ord FastString where
    a <= b = case cmpFS a b of { LT -> True;  EQ -> True;  GT -> False }
    a <	 b = case cmpFS a b of { LT -> True;  EQ -> False; GT -> False }
    a >= b = case cmpFS a b of { LT -> False; EQ -> True;  GT -> True  }
    a >	 b = case cmpFS a b of { LT -> False; EQ -> False; GT -> True  }
    max x y | x >= y	=  x
            | otherwise	=  y
    min x y | x <= y	=  x
            | otherwise	=  y
    compare a b = cmpFS a b
128
129
130
131
132
133
134
135

instance Text FastString  where
    showsPrec p ps@(FastString u# _ _) r = showsPrec p (unpackFS ps) r
    showsPrec p ps r = showsPrec p (unpackFS ps) r

getByteArray# :: FastString -> ByteArray#
getByteArray# (FastString _ _ ba#) = ba#

136
137
getByteArray :: FastString -> ByteArray Int
getByteArray (FastString _ l# ba#) = ByteArray (0,I# l#) ba#
138
139
140
141
142
143
144
145
146
147

lengthFS :: FastString -> Int
lengthFS (FastString _ l# _) = I# l#
lengthFS (CharStr a# l#) = I# l#

nullFastString :: FastString -> Bool
nullFastString (FastString _ l# _) = l# ==# 0#
nullFastString (CharStr _ l#) = l# ==# 0#

unpackFS :: FastString -> String
sof's avatar
sof committed
148
unpackFS (FastString _ l# ba#) = unpackCStringBA# ba# l#
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
unpackFS (CharStr addr len#) =
 unpack 0#
 where
    unpack nh
      | nh ==# len# = []
      | otherwise   = C# ch : unpack (nh +# 1#)
      where
	ch = indexCharOffAddr# addr nh

appendFS :: FastString -> FastString -> FastString
appendFS fs1 fs2 = mkFastString (unpackFS fs1 ++ unpackFS fs2)

concatFS :: [FastString] -> FastString
concatFS ls = mkFastString (concat (map (unpackFS) ls)) -- ToDo: do better

headFS :: FastString -> Char
165
166
167
168
headFS f@(FastString _ l# ba#) = 
 if l# ># 0# then C# (indexCharArray# ba# 0#) else error ("headFS: empty FS: " ++ unpackFS f)
headFS f@(CharStr a# l#) = 
 if l# ># 0# then C# (indexCharOffAddr# a# 0#) else error ("headFS: empty FS: " ++ unpackFS f)
169
170
171
172
173
174
175

tailFS :: FastString -> FastString
tailFS (FastString _ l# ba#) = mkFastSubStringBA# ba# 1# (l# -# 1#)

consFS :: Char -> FastString -> FastString
consFS c fs = mkFastString (c:unpackFS fs)

176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
uniqueOfFS :: FastString -> Int#
uniqueOfFS (FastString u# _ _) = u#
uniqueOfFS (CharStr a# l#)     = case mkFastString# a# l# of { FastString u# _ _ -> u#} -- Ugh!
   {-
     [A somewhat moby hack]: to avoid entering all sorts
     of junk into the hash table, all C char strings
     are by default left out. The benefit of being in
     the table is that string comparisons are lightning fast,
     just an Int# comparison.
   
     But, if you want to get the Unique of a CharStr, we 
     enter it into the table and return that unique. This
     works, but causes the CharStr to be looked up in the hash
     table each time it is accessed..
   -}
191
192
193
194
195
196
197
198
199
200
201
\end{code}

Internally, the compiler will maintain a fast string symbol
table, providing sharing and fast comparison. Creation of
new @FastString@s then covertly does a lookup, re-using the
@FastString@ if there was a hit.

\begin{code}
data FastStringTable = 
 FastStringTable
    Int#
202
    (MutableArray# RealWorld [FastString])
203

sof's avatar
sof committed
204
type FastStringTableVar = IORef FastStringTable
205
206
207

string_table :: FastStringTableVar
string_table = 
208
209
210
 unsafePerformIO (
   stToIO (newArray (0::Int,hASH_TBL_SIZE) [])		>>= \ (MutableArray _ arr#) ->
   newIORef (FastStringTable 0# arr#))
211

212
lookupTbl :: FastStringTable -> Int# -> IO [FastString]
213
lookupTbl (FastStringTable _ arr#) i# =
214
  IO ( \ s# ->
sof's avatar
sof committed
215
  case readArray# arr# i# s# of { StateAndPtr# s2# r ->
216
  IOok s2# r })
217

218
219
220
221
updTbl :: FastStringTableVar -> FastStringTable -> Int# -> [FastString] -> IO ()
updTbl fs_table_var (FastStringTable uid# arr#) i# ls =
 IO (\ s# -> case writeArray# arr# i# ls s# of { s2# -> IOok s2# () })	>>
 writeIORef fs_table_var (FastStringTable (uid# +# 1#) arr#)
222
223
224

mkFastString# :: Addr# -> Int# -> FastString
mkFastString# a# len# =
225
226
 unsafePerformIO  (
  readIORef string_table	>>= \ ft@(FastStringTable uid# tbl#) ->
227
228
229
230
  let
   h = hashStr a# len#
  in
--  _trace ("hashed: "++show (I# h)) $
231
  lookupTbl ft h	>>= \ lookup_result ->
sof's avatar
sof committed
232
  case lookup_result of
233
234
235
    [] -> 
       -- no match, add it to table by copying out the
       -- the string into a ByteArray
sof's avatar
sof committed
236
       -- _trace "empty bucket" $
237
       case copyPrefixStr (A# a#) (I# len#) of
238
	 (ByteArray _ barr#) ->  
239
	   let f_str = FastString uid# len# barr# in
240
241
           updTbl string_table ft h [f_str] >>
           ({- _trace ("new: " ++ show f_str)   $ -} return f_str)
242
243
244
    ls -> 
       -- non-empty `bucket', scan the list looking
       -- entry with same length and compare byte by byte.
sof's avatar
sof committed
245
       -- _trace ("non-empty bucket"++show ls) $
246
247
248
       case bucket_match ls len# a# of
	 Nothing -> 
           case copyPrefixStr (A# a#) (I# len#) of
249
  	    (ByteArray _ barr#) ->  
250
              let f_str = FastString uid# len# barr# in
251
252
253
              updTbl string_table ft h (f_str:ls) >>
	      ( {- _trace ("new: " ++ show f_str)  $ -} return f_str)
	 Just v  -> {- _trace ("re-use: "++show v) $ -} return v)
254
255
256
257
258
259
260
261
262
263
264
265
266
  where
   bucket_match [] _ _ = Nothing
   bucket_match (v@(FastString _ l# ba#):ls) len# a# =
      if len# ==# l# && eqStrPrefix a# ba# l# then
	 Just v
      else
	 bucket_match ls len# a#

mkFastSubString# :: Addr# -> Int# -> Int# -> FastString
mkFastSubString# a# start# len# = mkFastCharString2 (A# (addrOffset# a# start#)) (I# len#)

mkFastSubStringFO# :: ForeignObj# -> Int# -> Int# -> FastString
mkFastSubStringFO# fo# start# len# =
267
268
 unsafePerformIO  (
  readIORef string_table >>= \ ft@(FastStringTable uid# tbl#) ->
sof's avatar
sof committed
269
270
271
  let
   h = hashSubStrFO fo# start# len#
  in
272
  lookupTbl ft h	>>= \ lookup_result ->
sof's avatar
sof committed
273
  case lookup_result of
274
275
276
277
    [] -> 
       -- no match, add it to table by copying out the
       -- the string into a ByteArray
       case copySubStrFO (_ForeignObj fo#) (I# start#) (I# len#) of
278
	 (ByteArray _ barr#) ->  
279
	   let f_str = FastString uid# len# barr# in
280
281
           updTbl string_table ft h [f_str]       >>
	   return f_str
282
283
284
285
286
287
    ls -> 
       -- non-empty `bucket', scan the list looking
       -- entry with same length and compare byte by byte.
       case bucket_match ls start# len# fo# of
	 Nothing -> 
           case copySubStrFO (_ForeignObj fo#) (I# start#) (I# len#) of
288
   	     (ByteArray _ barr#) ->  
289
              let f_str = FastString uid# len# barr# in
290
291
292
              updTbl string_table ft  h (f_str:ls) >>
	      ( {- _trace ("new: " ++ show f_str) $ -} return f_str)
	 Just v  -> {- _trace ("re-use: "++show v) $ -} return v)
293
294
295
296
297
298
299
300
301
302
303
  where
   bucket_match [] _ _ _ = Nothing
   bucket_match (v@(FastString _ l# barr#):ls) start# len# fo# =
      if len# ==# l# && eqStrPrefixFO fo# barr# start# len# then
	 Just v
      else
	 bucket_match ls start# len# fo#


mkFastSubStringBA# :: ByteArray# -> Int# -> Int# -> FastString
mkFastSubStringBA# barr# start# len# =
304
305
 unsafePerformIO  (
  readIORef string_table	>>= \ ft@(FastStringTable uid# tbl#) ->
sof's avatar
sof committed
306
307
308
309
  let
   h = hashSubStrBA barr# start# len#
  in
--  _trace ("hashed(b): "++show (I# h)) $
310
  lookupTbl ft h		>>= \ lookup_result ->
sof's avatar
sof committed
311
  case lookup_result of
312
313
314
    [] -> 
       -- no match, add it to table by copying out the
       -- the string into a ByteArray
sof's avatar
sof committed
315
       -- _trace "empty bucket(b)" $
316
317
       case copySubStrBA (ByteArray btm barr#) (I# start#) (I# len#) of
         (ByteArray _ ba#) ->  
318
          let f_str = FastString uid# len# ba# in
319
          updTbl string_table ft h [f_str]     >>
sof's avatar
sof committed
320
          -- _trace ("new(b): " ++ show f_str)   $
321
	  return f_str
322
323
    ls -> 
       -- non-empty `bucket', scan the list looking
sof's avatar
sof committed
324
325
       -- entry with same length and compare byte by byte. 
       -- _trace ("non-empty bucket(b)"++show ls) $
326
327
       case bucket_match ls start# len# barr# of
	 Nothing -> 
328
329
          case copySubStrBA (ByteArray (error "") barr#) (I# start#) (I# len#) of
            (ByteArray _ ba#) ->  
330
              let f_str = FastString uid# len# ba# in
331
              updTbl string_table ft h (f_str:ls) >>
sof's avatar
sof committed
332
	      -- _trace ("new(b): " ++ show f_str)   $
333
	      return f_str
sof's avatar
sof committed
334
335
	 Just v  -> 
              -- _trace ("re-use(b): "++show v) $
336
	      return v
sof's avatar
sof committed
337
338
339
340
  )
 where
   btm = error ""

341
342
343
344
345
346
347
   bucket_match [] _ _ _ = Nothing
   bucket_match (v:ls) start# len# ba# =
    case v of
     FastString _ l# barr# ->
      if len# ==# l# && eqStrPrefixBA barr# ba# start# len# then
	 Just v
      else
sof's avatar
sof committed
348
	 bucket_match ls start# len# ba#
349

350
mkFastCharString :: Addr -> FastString
351
352
353
mkFastCharString a@(A# a#) = 
 case strLength a of{ (I# len#) -> CharStr a# len# }

354
355
356
357
358
mkFastCharString# :: Addr# -> FastString
mkFastCharString# a# = 
 case strLength (A# a#) of { (I# len#) -> CharStr a# len# }

mkFastCharString2 :: Addr -> Int -> FastString
359
360
361
362
mkFastCharString2 a@(A# a#) (I# len#) = CharStr a# len#

mkFastString :: String -> FastString
mkFastString str = 
sof's avatar
sof committed
363
 case packString str of
364
  (ByteArray (_,I# len#) frozen#) -> 
sof's avatar
sof committed
365
366
367
    mkFastSubStringBA# frozen# 0# len#
    {- 0-indexed array, len# == index to one beyond end of string,
       i.e., (0,1) => empty string.    -}
368

369
mkFastSubString :: Addr -> Int -> Int -> FastString
sof's avatar
sof committed
370
371
mkFastSubString (A# a#) (I# start#) (I# len#) =
 mkFastString# (addrOffset# a# start#) len#
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388

mkFastSubStringFO :: _ForeignObj -> Int -> Int -> FastString
mkFastSubStringFO (_ForeignObj fo#) (I# start#) (I# len#) =
 mkFastSubStringFO# fo# start# len#
\end{code}

\begin{code}
hashStr  :: Addr# -> Int# -> Int#
 -- use the Addr to produce a hash value between 0 & m (inclusive)
hashStr a# len# =
  case len# of
   0# -> 0#
   1# -> ((ord# c0 *# 631#) +# len#) `remInt#` hASH_TBL_SIZE#
   2# -> ((ord# c0 *# 631#) +# (ord# c1 *# 217#) +# len#) `remInt#` hASH_TBL_SIZE#
   _  -> ((ord# c0 *# 631#) +# (ord# c1 *# 217#) +# (ord# c2 *# 43#) +# len#) `remInt#` hASH_TBL_SIZE#
  where
    c0 = indexCharOffAddr# a# 0#
sof's avatar
sof committed
389
390
391
392
393
394
    c1 = indexCharOffAddr# a# (len# `quotInt#` 2# -# 1#)
    c2 = indexCharOffAddr# a# (len# -# 1#)
{-
    c1 = indexCharOffAddr# a# 1#
    c2 = indexCharOffAddr# a# 2#
-}
395
396

hashSubStrFO  :: ForeignObj# -> Int# -> Int# -> Int#
sof's avatar
sof committed
397
 -- use the FO to produce a hash value between 0 & m (inclusive)
398
399
400
401
402
403
404
hashSubStrFO fo# start# len# =
  case len# of
   0# -> 0#
   1# -> ((ord# c0 *# 631#) +# len#) `remInt#` hASH_TBL_SIZE#
   2# -> ((ord# c0 *# 631#) +# (ord# c1 *# 217#) +# len#) `remInt#` hASH_TBL_SIZE#
   _  -> ((ord# c0 *# 631#) +# (ord# c1 *# 217#) +# (ord# c2 *# 43#) +# len#) `remInt#` hASH_TBL_SIZE#
  where
sof's avatar
sof committed
405
406
407
    c0 = indexCharOffForeignObj# fo# 0#
    c1 = indexCharOffForeignObj# fo# (len# `quotInt#` 2# -# 1#)
    c2 = indexCharOffForeignObj# fo# (len# -# 1#)
sof's avatar
sof committed
408
409
410

--    c1 = indexCharOffFO# fo# 1#
--    c2 = indexCharOffFO# fo# 2#
411
412
413


hashSubStrBA  :: ByteArray# -> Int# -> Int# -> Int#
sof's avatar
sof committed
414
 -- use the byte array to produce a hash value between 0 & m (inclusive)
415
416
417
418
419
420
421
422
hashSubStrBA ba# start# len# =
  case len# of
   0# -> 0#
   1# -> ((ord# c0 *# 631#) +# len#) `remInt#` hASH_TBL_SIZE#
   2# -> ((ord# c0 *# 631#) +# (ord# c1 *# 217#) +# len#) `remInt#` hASH_TBL_SIZE#
   _  -> ((ord# c0 *# 631#) +# (ord# c1 *# 217#) +# (ord# c2 *# 43#) +# len#) `remInt#` hASH_TBL_SIZE#
  where
    c0 = indexCharArray# ba# 0#
sof's avatar
sof committed
423
424
425
426
427
    c1 = indexCharArray# ba# (len# `quotInt#` 2# -# 1#)
    c2 = indexCharArray# ba# (len# -# 1#)

--    c1 = indexCharArray# ba# 1#
--    c2 = indexCharArray# ba# 2#
428
429
430
431

\end{code}

\begin{code}
432
433
cmpFS :: FastString -> FastString -> Ordering
cmpFS (FastString u1# _ b1#) (FastString u2# _ b2#) = -- assume non-null chars
434
  if u1# ==# u2# then
435
     EQ
436
  else
437
438
439
440
441
442
   unsafePerformIO (
    _ccall_ strcmp (ByteArray bottom b1#) (ByteArray bottom b2#)	>>= \ (I# res) ->
    return (
    if      res <#  0# then LT
    else if res ==# 0# then EQ
    else		    GT
443
444
    ))
  where
sof's avatar
sof committed
445
   bottom :: (Int,Int)
446
   bottom = error "tagCmp"
447
448
449
450
451
452
453
cmpFS (CharStr bs1 len1) (CharStr bs2 len2)
  = unsafePerformIO (
    _ccall_ strcmp ba1 ba2	>>= \ (I# res) ->
    return (
    if      res <#  0# then LT
    else if res ==# 0# then EQ
    else		    GT
454
455
456
457
    ))
  where
    ba1 = A# bs1
    ba2 = A# bs2
458
459
460
461
462
463
464
cmpFS (FastString _ len1 bs1) (CharStr bs2 len2)
 = unsafePerformIO (
    _ccall_ strcmp ba1 ba2	>>= \ (I# res) ->
    return (
     if      res <#  0# then LT
     else if res ==# 0# then EQ
     else		     GT
465
466
    ))
  where
467
    ba1 = ByteArray ((error "")::(Int,Int)) bs1
468
469
    ba2 = A# bs2

470
cmpFS a@(CharStr _ _) b@(FastString _ _ _)
471
  = -- try them the other way 'round
472
    case (cmpFS b a) of { LT -> GT; EQ -> EQ; GT -> LT }
473
474
475
476
477
478
479
480

\end{code}

Outputting @FastString@s is quick, just block copying the chunk (using
@fwrite@).

\begin{code}
hPutFS :: Handle -> FastString -> IO ()
sof's avatar
sof committed
481
#if __GLASGOW_HASKELL__ <= 302
482
483
484
485
hPutFS handle (FastString _ l# ba#) =
 if l# ==# 0# then
    return ()
 else
486
    readHandle handle				    >>= \ htype ->
487
    case htype of 
488
      ErrorHandle ioError ->
489
	  writeHandle handle htype		    >>
490
491
          fail ioError
      ClosedHandle ->
492
	  writeHandle handle htype		    >>
493
494
	  fail MkIOError(handle,IllegalOperation,"handle is closed")
      SemiClosedHandle _ _ ->
495
	  writeHandle handle htype		    >>
496
497
	  fail MkIOError(handle,IllegalOperation,"handle is closed")
      ReadHandle _ _ _ ->
498
	  writeHandle handle htype		    >>
499
	  fail MkIOError(handle,IllegalOperation,"handle is not open for writing")
500
      other -> 
501
          let fp = filePtr htype in
502
	   -- here we go..
503
          _ccall_ writeFile (ByteArray ((error "")::(Int,Int)) ba#) fp (I# l#) >>= \rc ->
504
505
506
          if rc==0 then
              return ()
          else
507
508
              constructError "hPutFS"   >>= \ err ->
	      fail err
509
510
511
512
hPutFS handle (CharStr a# l#) =
 if l# ==# 0# then
    return ()
 else
513
    readHandle handle				    >>= \ htype ->
514
    case htype of 
515
      ErrorHandle ioError ->
516
	  writeHandle handle htype		    >>
517
518
          fail ioError
      ClosedHandle ->
519
	  writeHandle handle htype		    >>
520
521
	  fail MkIOError(handle,IllegalOperation,"handle is closed")
      SemiClosedHandle _ _ ->
522
	  writeHandle handle htype		    >>
523
524
	  fail MkIOError(handle,IllegalOperation,"handle is closed")
      ReadHandle _ _ _ ->
525
	  writeHandle handle htype		    >>
526
	  fail MkIOError(handle,IllegalOperation,"handle is not open for writing")
527
      other -> 
528
          let fp = filePtr htype in
529
	   -- here we go..
530
          _ccall_ writeFile (A# a#) fp (I# l#)	>>= \rc ->
531
532
533
          if rc==0 then
              return ()
          else
534
535
              constructError "hPutFS"   	>>= \ err ->
	      fail err
sof's avatar
sof committed
536
537
538
539
540
541
542
543
544
545
#else
hPutFS handle (FastString _ l# ba#)
  | l# ==# 0#  = return ()
  | otherwise  = hPutBufBA handle (ByteArray bottom ba#) (I# l#)
 where
  bottom = error "hPutFS.ba"

hPutFS handle (CharStr a# l#)
  | l# ==# 0#  = return ()
  | otherwise  = hPutBuf handle (A# a#) (I# l#)
546

sof's avatar
sof committed
547
#endif
548
\end{code}