ghc/compiler/utils/FastString.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1997-1998
   3 %
   4 \section{Fast strings}
   5
   6 Compact representations of character strings with
   7 unique identifiers (hash-cons'ish).
   8
   9 \begin{code}
  10 module FastString
  11        (
  12         FastString(..),     -- not abstract, for now.
  13
  14          --names?
  15         mkFastString,       -- :: String -> FastString
  16         mkFastSubString,    -- :: Addr -> Int -> Int -> FastString
  17         mkFastSubStringFO,  -- :: ForeignObj -> Int -> Int -> FastString
  18
  19         -- These ones hold on to the Addr after they return, and aren't hashed;
  20         -- they are used for literals
  21         mkFastCharString,   -- :: Addr -> FastString
  22         mkFastCharString#,  -- :: Addr# -> FastString
  23         mkFastCharString2,  -- :: Addr -> Int -> FastString
  24
  25         mkFastString#,      -- :: Addr# -> Int# -> FastString
  26         mkFastSubStringBA#, -- :: ByteArray# -> Int# -> Int# -> FastString
  27         mkFastSubString#,   -- :: Addr# -> Int# -> Int# -> FastString
  28         mkFastSubStringFO#, -- :: ForeignObj# -> Int# -> Int# -> FastString
  29
  30         uniqueOfFS,         -- :: FastString -> Int#
  31         lengthFS,           -- :: FastString -> Int
  32         nullFastString,     -- :: FastString -> Bool
  33
  34         getByteArray#,      -- :: FastString -> ByteArray#
  35         getByteArray,       -- :: FastString -> _ByteArray Int
  36         unpackFS,           -- :: FastString -> String
  37         appendFS,           -- :: FastString -> FastString -> FastString
  38         headFS,             -- :: FastString -> Char
  39         tailFS,             -- :: FastString -> FastString
  40         concatFS,           -- :: [FastString] -> FastString
  41         consFS,             -- :: Char -> FastString -> FastString
  42
  43         hPutFS              -- :: Handle -> FastString -> IO ()
  44        ) where
  45
  46 -- This #define suppresses the "import FastString" that
  47 -- HsVersions otherwise produces
  48 #define COMPILING_FAST_STRING
  49 #include "HsVersions.h"
  50
  51 #if __GLASGOW_HASKELL__ < 301
  52 import PackBase
  53 import STBase           ( StateAndPtr#(..) )
  54 import IOHandle         ( filePtr, readHandle, writeHandle )
  55 import IOBase           ( Handle__(..), IOError(..), IOErrorType(..),
  56                           IOResult(..), IO(..),
  57                           constructError
  58                         )
  59 #else
  60 import PrelPack
  61 #if __GLASGOW_HASKELL__ < 400
  62 import PrelST           ( StateAndPtr#(..) )
  63 #endif
  64
  65 #if __GLASGOW_HASKELL__ <= 303
  66 import PrelHandle       ( readHandle,
  67 # if __GLASGOW_HASKELL__ < 303
  68                           filePtr,
  69 # endif
  70                           writeHandle
  71                         )
  72 #endif
  73
  74 import PrelIOBase       ( Handle__(..), IOError(..), IOErrorType(..),
  75 #if __GLASGOW_HASKELL__ < 400
  76                           IOResult(..),
  77 #endif
  78                           IO(..),
  79 #if __GLASGOW_HASKELL__ >= 303
  80                           Handle__Type(..),
  81 #endif
  82                           constructError
  83                         )
  84 #endif
  85
  86 import PrimPacked
  87 import GlaExts
  88 import Addr             ( Addr(..) )
  89 import MutableArray     ( MutableArray(..) )
  90
  91 -- ForeignObj is now exported abstractly.
  92 #if __GLASGOW_HASKELL__ >= 303
  93 import qualified PrelForeign as Foreign  ( ForeignObj(..) )
  94 #else
  95 import Foreign          ( ForeignObj(..) )
  96 #endif
  97
  98 import IOExts           ( IORef, newIORef, readIORef, writeIORef )
  99 import IO
 100
 101 #define hASH_TBL_SIZE 993
 102
 103 #if __GLASGOW_HASKELL__ >= 400
 104 #define IOok STret
 105 #endif
 106 \end{code}
 107
 108 @FastString@s are packed representations of strings
 109 with a unique id for fast comparisons. The unique id
 110 is assigned when creating the @FastString@, using
 111 a hash table to map from the character string representation
 112 to the unique ID.
 113
 114 \begin{code}
 115 data FastString
 116   = FastString   -- packed repr. on the heap.
 117       Int#       -- unique id
 118                  --  0 => string literal, comparison
 119                  --  will
 120       Int#       -- length
 121       ByteArray# -- stuff
 122
 123   | CharStr      -- external C string
 124       Addr#      -- pointer to the (null-terminated) bytes in C land.
 125       Int#       -- length  (cached)
 126
 127 instance Eq FastString where
 128   a == b = case cmpFS a b of { LT -> False; EQ -> True;  GT -> False }
 129   a /= b = case cmpFS a b of { LT -> True;  EQ -> False; GT -> True  }
 130
 131 instance Ord FastString where
 132     a <= b = case cmpFS a b of { LT -> True;  EQ -> True;  GT -> False }
 133     a <  b = case cmpFS a b of { LT -> True;  EQ -> False; GT -> False }
 134     a >= b = case cmpFS a b of { LT -> False; EQ -> True;  GT -> True  }
 135     a >  b = case cmpFS a b of { LT -> False; EQ -> False; GT -> True  }
 136     max x y | x >= y    =  x
 137             | otherwise =  y
 138     min x y | x <= y    =  x
 139             | otherwise =  y
 140     compare a b = cmpFS a b
 141
 142 getByteArray# :: FastString -> ByteArray#
 143 getByteArray# (FastString _ _ ba#) = ba#
 144
 145 getByteArray :: FastString -> ByteArray Int
 146 getByteArray (FastString _ l# ba#) = ByteArray (0,I# l#) ba#
 147
 148 lengthFS :: FastString -> Int
 149 lengthFS (FastString _ l# _) = I# l#
 150 lengthFS (CharStr a# l#) = I# l#
 151
 152 nullFastString :: FastString -> Bool
 153 nullFastString (FastString _ l# _) = l# ==# 0#
 154 nullFastString (CharStr _ l#) = l# ==# 0#
 155
 156 unpackFS :: FastString -> String
 157 unpackFS (FastString _ l# ba#) = unpackCStringBA# ba# l#
 158 unpackFS (CharStr addr len#) =
 159  unpack 0#
 160  where
 161     unpack nh
 162       | nh ==# len# = []
 163       | otherwise   = C# ch : unpack (nh +# 1#)
 164       where
 165         ch = indexCharOffAddr# addr nh
 166
 167 appendFS :: FastString -> FastString -> FastString
 168 appendFS fs1 fs2 = mkFastString (unpackFS fs1 ++ unpackFS fs2)
 169
 170 concatFS :: [FastString] -> FastString
 171 concatFS ls = mkFastString (concat (map (unpackFS) ls)) -- ToDo: do better
 172
 173 headFS :: FastString -> Char
 174 headFS f@(FastString _ l# ba#) =
 175  if l# ># 0# then C# (indexCharArray# ba# 0#) else error ("headFS: empty FS: " ++ unpackFS f)
 176 headFS f@(CharStr a# l#) =
 177  if l# ># 0# then C# (indexCharOffAddr# a# 0#) else error ("headFS: empty FS: " ++ unpackFS f)
 178
 179 tailFS :: FastString -> FastString
 180 tailFS (FastString _ l# ba#) = mkFastSubStringBA# ba# 1# (l# -# 1#)
 181
 182 consFS :: Char -> FastString -> FastString
 183 consFS c fs = mkFastString (c:unpackFS fs)
 184
 185 uniqueOfFS :: FastString -> Int#
 186 uniqueOfFS (FastString u# _ _) = u#
 187 uniqueOfFS (CharStr a# l#)     = case mkFastString# a# l# of { FastString u# _ _ -> u#} -- Ugh!
 188    {-
 189      [A somewhat moby hack]: to avoid entering all sorts
 190      of junk into the hash table, all C char strings
 191      are by default left out. The benefit of being in
 192      the table is that string comparisons are lightning fast,
 193      just an Int# comparison.
 194
 195      But, if you want to get the Unique of a CharStr, we
 196      enter it into the table and return that unique. This
 197      works, but causes the CharStr to be looked up in the hash
 198      table each time it is accessed..
 199    -}
 200 \end{code}
 201
 202 Internally, the compiler will maintain a fast string symbol
 203 table, providing sharing and fast comparison. Creation of
 204 new @FastString@s then covertly does a lookup, re-using the
 205 @FastString@ if there was a hit.
 206
 207 \begin{code}
 208 data FastStringTable =
 209  FastStringTable
 210     Int#
 211     (MutableArray# RealWorld [FastString])
 212
 213 type FastStringTableVar = IORef FastStringTable
 214
 215 string_table :: FastStringTableVar
 216 string_table =
 217  unsafePerformIO (
 218    stToIO (newArray (0::Int,hASH_TBL_SIZE) [])          >>= \ (MutableArray _ arr#) ->
 219    newIORef (FastStringTable 0# arr#))
 220
 221 lookupTbl :: FastStringTable -> Int# -> IO [FastString]
 222 lookupTbl (FastStringTable _ arr#) i# =
 223   IO ( \ s# ->
 224 #if __GLASGOW_HASKELL__ < 400
 225   case readArray# arr# i# s# of { StateAndPtr# s2# r ->
 226   IOok s2# r })
 227 #else
 228   readArray# arr# i# s#)
 229 #endif
 230
 231 updTbl :: FastStringTableVar -> FastStringTable -> Int# -> [FastString] -> IO ()
 232 updTbl fs_table_var (FastStringTable uid# arr#) i# ls =
 233  IO (\ s# -> case writeArray# arr# i# ls s# of { s2# ->
 234 #if __GLASGOW_HASKELL__ < 400
 235         IOok s2# () })  >>
 236 #else
 237         (# s2#, () #) }) >>
 238 #endif
 239  writeIORef fs_table_var (FastStringTable (uid# +# 1#) arr#)
 240
 241 mkFastString# :: Addr# -> Int# -> FastString
 242 mkFastString# a# len# =
 243  unsafePerformIO  (
 244   readIORef string_table        >>= \ ft@(FastStringTable uid# tbl#) ->
 245   let
 246    h = hashStr a# len#
 247   in
 248 --  _trace ("hashed: "++show (I# h)) $
 249   lookupTbl ft h        >>= \ lookup_result ->
 250   case lookup_result of
 251     [] ->
 252        -- no match, add it to table by copying out the
 253        -- the string into a ByteArray
 254        -- _trace "empty bucket" $
 255        case copyPrefixStr (A# a#) (I# len#) of
 256          (ByteArray _ barr#) ->
 257            let f_str = FastString uid# len# barr# in
 258            updTbl string_table ft h [f_str] >>
 259            ({- _trace ("new: " ++ show f_str)   $ -} return f_str)
 260     ls ->
 261        -- non-empty `bucket', scan the list looking
 262        -- entry with same length and compare byte by byte.
 263        -- _trace ("non-empty bucket"++show ls) $
 264        case bucket_match ls len# a# of
 265          Nothing ->
 266            case copyPrefixStr (A# a#) (I# len#) of
 267             (ByteArray _ barr#) ->
 268               let f_str = FastString uid# len# barr# in
 269               updTbl string_table ft h (f_str:ls) >>
 270               ( {- _trace ("new: " ++ show f_str)  $ -} return f_str)
 271          Just v  -> {- _trace ("re-use: "++show v) $ -} return v)
 272   where
 273    bucket_match [] _ _ = Nothing
 274    bucket_match (v@(FastString _ l# ba#):ls) len# a# =
 275       if len# ==# l# && eqStrPrefix a# ba# l# then
 276          Just v
 277       else
 278          bucket_match ls len# a#
 279
 280 mkFastSubString# :: Addr# -> Int# -> Int# -> FastString
 281 mkFastSubString# a# start# len# = mkFastCharString2 (A# (addrOffset# a# start#)) (I# len#)
 282
 283 mkFastSubStringFO# :: ForeignObj# -> Int# -> Int# -> FastString
 284 mkFastSubStringFO# fo# start# len# =
 285  unsafePerformIO  (
 286   readIORef string_table >>= \ ft@(FastStringTable uid# tbl#) ->
 287   let
 288    h = hashSubStrFO fo# start# len#
 289   in
 290   lookupTbl ft h        >>= \ lookup_result ->
 291   case lookup_result of
 292     [] ->
 293        -- no match, add it to table by copying out the
 294        -- the string into a ByteArray
 295        case copySubStrFO (_ForeignObj fo#) (I# start#) (I# len#) of
 296          (ByteArray _ barr#) ->
 297            let f_str = FastString uid# len# barr# in
 298            updTbl string_table ft h [f_str]       >>
 299            return f_str
 300     ls ->
 301        -- non-empty `bucket', scan the list looking
 302        -- entry with same length and compare byte by byte.
 303        case bucket_match ls start# len# fo# of
 304          Nothing ->
 305            case copySubStrFO (_ForeignObj fo#) (I# start#) (I# len#) of
 306              (ByteArray _ barr#) ->
 307               let f_str = FastString uid# len# barr# in
 308               updTbl string_table ft  h (f_str:ls) >>
 309               ( {- _trace ("new: " ++ show f_str) $ -} return f_str)
 310          Just v  -> {- _trace ("re-use: "++show v) $ -} return v)
 311   where
 312    bucket_match [] _ _ _ = Nothing
 313    bucket_match (v@(FastString _ l# barr#):ls) start# len# fo# =
 314       if len# ==# l# && eqStrPrefixFO fo# barr# start# len# then
 315          Just v
 316       else
 317          bucket_match ls start# len# fo#
 318
 319
 320 mkFastSubStringBA# :: ByteArray# -> Int# -> Int# -> FastString
 321 mkFastSubStringBA# barr# start# len# =
 322  unsafePerformIO  (
 323   readIORef string_table        >>= \ ft@(FastStringTable uid# tbl#) ->
 324   let
 325    h = hashSubStrBA barr# start# len#
 326   in
 327 --  _trace ("hashed(b): "++show (I# h)) $
 328   lookupTbl ft h                >>= \ lookup_result ->
 329   case lookup_result of
 330     [] ->
 331        -- no match, add it to table by copying out the
 332        -- the string into a ByteArray
 333        -- _trace "empty bucket(b)" $
 334        case copySubStrBA (ByteArray btm barr#) (I# start#) (I# len#) of
 335          (ByteArray _ ba#) ->
 336           let f_str = FastString uid# len# ba# in
 337           updTbl string_table ft h [f_str]     >>
 338           -- _trace ("new(b): " ++ show f_str)   $
 339           return f_str
 340     ls ->
 341        -- non-empty `bucket', scan the list looking
 342        -- entry with same length and compare byte by byte.
 343        -- _trace ("non-empty bucket(b)"++show ls) $
 344        case bucket_match ls start# len# barr# of
 345          Nothing ->
 346           case copySubStrBA (ByteArray (error "") barr#) (I# start#) (I# len#) of
 347             (ByteArray _ ba#) ->
 348               let f_str = FastString uid# len# ba# in
 349               updTbl string_table ft h (f_str:ls) >>
 350               -- _trace ("new(b): " ++ show f_str)   $
 351               return f_str
 352          Just v  ->
 353               -- _trace ("re-use(b): "++show v) $
 354               return v
 355   )
 356  where
 357    btm = error ""
 358
 359    bucket_match [] _ _ _ = Nothing
 360    bucket_match (v:ls) start# len# ba# =
 361     case v of
 362      FastString _ l# barr# ->
 363       if len# ==# l# && eqStrPrefixBA barr# ba# start# len# then
 364          Just v
 365       else
 366          bucket_match ls start# len# ba#
 367
 368 mkFastCharString :: Addr -> FastString
 369 mkFastCharString a@(A# a#) =
 370  case strLength a of{ (I# len#) -> CharStr a# len# }
 371
 372 mkFastCharString# :: Addr# -> FastString
 373 mkFastCharString# a# =
 374  case strLength (A# a#) of { (I# len#) -> CharStr a# len# }
 375
 376 mkFastCharString2 :: Addr -> Int -> FastString
 377 mkFastCharString2 a@(A# a#) (I# len#) = CharStr a# len#
 378
 379 mkFastString :: String -> FastString
 380 mkFastString str =
 381  case packString str of
 382   (ByteArray (_,I# len#) frozen#) ->
 383     mkFastSubStringBA# frozen# 0# len#
 384     {- 0-indexed array, len# == index to one beyond end of string,
 385        i.e., (0,1) => empty string.    -}
 386
 387 mkFastSubString :: Addr -> Int -> Int -> FastString
 388 mkFastSubString (A# a#) (I# start#) (I# len#) =
 389  mkFastString# (addrOffset# a# start#) len#
 390
 391 mkFastSubStringFO :: _ForeignObj -> Int -> Int -> FastString
 392 mkFastSubStringFO (_ForeignObj fo#) (I# start#) (I# len#) =
 393  mkFastSubStringFO# fo# start# len#
 394 \end{code}
 395
 396 \begin{code}
 397 hashStr  :: Addr# -> Int# -> Int#
 398  -- use the Addr to produce a hash value between 0 & m (inclusive)
 399 hashStr a# len# =
 400   case len# of
 401    0# -> 0#
 402    1# -> ((ord# c0 *# 631#) +# len#) `remInt#` hASH_TBL_SIZE#
 403    2# -> ((ord# c0 *# 631#) +# (ord# c1 *# 217#) +# len#) `remInt#` hASH_TBL_SIZE#
 404    _  -> ((ord# c0 *# 631#) +# (ord# c1 *# 217#) +# (ord# c2 *# 43#) +# len#) `remInt#` hASH_TBL_SIZE#
 405   where
 406     c0 = indexCharOffAddr# a# 0#
 407     c1 = indexCharOffAddr# a# (len# `quotInt#` 2# -# 1#)
 408     c2 = indexCharOffAddr# a# (len# -# 1#)
 409 {-
 410     c1 = indexCharOffAddr# a# 1#
 411     c2 = indexCharOffAddr# a# 2#
 412 -}
 413
 414 hashSubStrFO  :: ForeignObj# -> Int# -> Int# -> Int#
 415  -- use the FO to produce a hash value between 0 & m (inclusive)
 416 hashSubStrFO fo# start# len# =
 417   case len# of
 418    0# -> 0#
 419    1# -> ((ord# c0 *# 631#) +# len#) `remInt#` hASH_TBL_SIZE#
 420    2# -> ((ord# c0 *# 631#) +# (ord# c1 *# 217#) +# len#) `remInt#` hASH_TBL_SIZE#
 421    _  -> ((ord# c0 *# 631#) +# (ord# c1 *# 217#) +# (ord# c2 *# 43#) +# len#) `remInt#` hASH_TBL_SIZE#
 422   where
 423     c0 = indexCharOffForeignObj# fo# 0#
 424     c1 = indexCharOffForeignObj# fo# (len# `quotInt#` 2# -# 1#)
 425     c2 = indexCharOffForeignObj# fo# (len# -# 1#)
 426
 427 --    c1 = indexCharOffFO# fo# 1#
 428 --    c2 = indexCharOffFO# fo# 2#
 429
 430
 431 hashSubStrBA  :: ByteArray# -> Int# -> Int# -> Int#
 432  -- use the byte array to produce a hash value between 0 & m (inclusive)
 433 hashSubStrBA ba# start# len# =
 434   case len# of
 435    0# -> 0#
 436    1# -> ((ord# c0 *# 631#) +# len#) `remInt#` hASH_TBL_SIZE#
 437    2# -> ((ord# c0 *# 631#) +# (ord# c1 *# 217#) +# len#) `remInt#` hASH_TBL_SIZE#
 438    _  -> ((ord# c0 *# 631#) +# (ord# c1 *# 217#) +# (ord# c2 *# 43#) +# len#) `remInt#` hASH_TBL_SIZE#
 439   where
 440     c0 = indexCharArray# ba# 0#
 441     c1 = indexCharArray# ba# (len# `quotInt#` 2# -# 1#)
 442     c2 = indexCharArray# ba# (len# -# 1#)
 443
 444 --    c1 = indexCharArray# ba# 1#
 445 --    c2 = indexCharArray# ba# 2#
 446
 447 \end{code}
 448
 449 \begin{code}
 450 cmpFS :: FastString -> FastString -> Ordering
 451 cmpFS (FastString u1# _ b1#) (FastString u2# _ b2#) = -- assume non-null chars
 452   if u1# ==# u2# then
 453      EQ
 454   else
 455    unsafePerformIO (
 456     _ccall_ strcmp (ByteArray bottom b1#) (ByteArray bottom b2#)        >>= \ (I# res) ->
 457     return (
 458     if      res <#  0# then LT
 459     else if res ==# 0# then EQ
 460     else                    GT
 461     ))
 462   where
 463    bottom :: (Int,Int)
 464    bottom = error "tagCmp"
 465 cmpFS (CharStr bs1 len1) (CharStr bs2 len2)
 466   = unsafePerformIO (
 467     _ccall_ strcmp ba1 ba2      >>= \ (I# res) ->
 468     return (
 469     if      res <#  0# then LT
 470     else if res ==# 0# then EQ
 471     else                    GT
 472     ))
 473   where
 474     ba1 = A# bs1
 475     ba2 = A# bs2
 476 cmpFS (FastString _ len1 bs1) (CharStr bs2 len2)
 477  = unsafePerformIO (
 478     _ccall_ strcmp ba1 ba2      >>= \ (I# res) ->
 479     return (
 480      if      res <#  0# then LT
 481      else if res ==# 0# then EQ
 482      else                    GT
 483     ))
 484   where
 485     ba1 = ByteArray ((error "")::(Int,Int)) bs1
 486     ba2 = A# bs2
 487
 488 cmpFS a@(CharStr _ _) b@(FastString _ _ _)
 489   = -- try them the other way 'round
 490     case (cmpFS b a) of { LT -> GT; EQ -> EQ; GT -> LT }
 491
 492 \end{code}
 493
 494 Outputting @FastString@s is quick, just block copying the chunk (using
 495 @fwrite@).
 496
 497 \begin{code}
 498 hPutFS :: Handle -> FastString -> IO ()
 499 #if __GLASGOW_HASKELL__ <= 302
 500 hPutFS handle (FastString _ l# ba#) =
 501  if l# ==# 0# then
 502     return ()
 503  else
 504     readHandle handle                               >>= \ htype ->
 505     case htype of
 506       ErrorHandle ioError ->
 507           writeHandle handle htype                  >>
 508           fail ioError
 509       ClosedHandle ->
 510           writeHandle handle htype                  >>
 511           fail MkIOError(handle,IllegalOperation,"handle is closed")
 512       SemiClosedHandle _ _ ->
 513           writeHandle handle htype                  >>
 514           fail MkIOError(handle,IllegalOperation,"handle is closed")
 515       ReadHandle _ _ _ ->
 516           writeHandle handle htype                  >>
 517           fail MkIOError(handle,IllegalOperation,"handle is not open for writing")
 518       other ->
 519           let fp = filePtr htype in
 520            -- here we go..
 521           _ccall_ writeFile (ByteArray ((error "")::(Int,Int)) ba#) fp (I# l#) >>= \rc ->
 522           if rc==0 then
 523               return ()
 524           else
 525               constructError "hPutFS"   >>= \ err ->
 526               fail err
 527 hPutFS handle (CharStr a# l#) =
 528  if l# ==# 0# then
 529     return ()
 530  else
 531     readHandle handle                               >>= \ htype ->
 532     case htype of
 533       ErrorHandle ioError ->
 534           writeHandle handle htype                  >>
 535           fail ioError
 536       ClosedHandle ->
 537           writeHandle handle htype                  >>
 538           fail MkIOError(handle,IllegalOperation,"handle is closed")
 539       SemiClosedHandle _ _ ->
 540           writeHandle handle htype                  >>
 541           fail MkIOError(handle,IllegalOperation,"handle is closed")
 542       ReadHandle _ _ _ ->
 543           writeHandle handle htype                  >>
 544           fail MkIOError(handle,IllegalOperation,"handle is not open for writing")
 545       other ->
 546           let fp = filePtr htype in
 547            -- here we go..
 548           _ccall_ writeFile (A# a#) fp (I# l#)  >>= \rc ->
 549           if rc==0 then
 550               return ()
 551           else
 552               constructError "hPutFS"           >>= \ err ->
 553               fail err
 554
 555
 556 #else
 557 hPutFS handle (FastString _ l# ba#)
 558   | l# ==# 0#  = return ()
 559   | otherwise  = hPutBufBA handle (ByteArray bottom ba#) (I# l#)
 560  where
 561   bottom = error "hPutFS.ba"
 562
 563 --ToDo: avoid silly code duplic.
 564
 565 hPutFS handle (CharStr a# l#)
 566   | l# ==# 0#  = return ()
 567   | otherwise  = hPutBuf handle (A# a#) (I# l#)
 568
 569
 570 #endif
 571 \end{code}