Ticket #132: base.diff

File base.diff, 49.5 KB (added by igloo, 4 years ago)

Patch to change GHC's parser to support (only) the proposed replacement syntax

  • Data/HashTable.hs 

    Sat Jul 25 22:19:26 BST 2009  Ian Lynagh <igloo@earth.li>
  * Make the code compatible with the stricter labelled-field parsing rules
diff -rN -u old-base/Data/HashTable.hs new-base/Data/HashTable.hs
    old new  
    137137 
    138138recordNew :: IO () 
    139139recordNew = instrument rec 
    140   where rec hd@HD{ tables=t, totBuckets=b } = 
    141                hd{ tables=t+1, totBuckets=b+fromIntegral tABLE_MIN } 
     140  where rec hd@(HD{ tables=t, totBuckets=b }) = 
     141                hd{ tables=t+1, totBuckets=b+fromIntegral tABLE_MIN } 
    142142 
    143143recordIns :: Int32 -> Int32 -> [a] -> IO () 
    144144recordIns i sz bkt = instrument rec 
    145   where rec hd@HD{ insertions=ins, maxEntries=mx, maxChain=mc } = 
    146                hd{ insertions=ins+fromIntegral i, maxEntries=mx `max` sz, 
    147                    maxChain=mc `max` length bkt } 
     145  where rec hd@(HD{ insertions=ins, maxEntries=mx, maxChain=mc }) = 
     146                hd{ insertions=ins+fromIntegral i, maxEntries=mx `max` sz, 
     147                    maxChain=mc `max` length bkt } 
    148148 
    149149recordResize :: Int32 -> Int32 -> IO () 
    150150recordResize older newer = instrument rec 
    151   where rec hd@HD{ totBuckets=b, maxBuckets=mx } = 
    152                hd{ totBuckets=b+fromIntegral (newer-older), 
    153                    maxBuckets=mx `max` newer } 
     151  where rec hd@(HD{ totBuckets=b, maxBuckets=mx }) = 
     152                hd{ totBuckets=b+fromIntegral (newer-older), 
     153                    maxBuckets=mx `max` newer } 
    154154 
    155155recordLookup :: IO () 
    156156recordLookup = instrument lkup 
    157   where lkup hd@HD{ lookups=l } = hd{ lookups=l+1 } 
     157  where lkup hd@(HD{ lookups=l }) = hd{ lookups=l+1 } 
    158158 
    159159-- stats :: IO String 
    160160-- stats =  fmap show $ readIORef hashData 
    … …  
    323323-- from scratch. 
    324324{-# INLINE findBucket #-} 
    325325findBucket :: HashTable key val -> key -> IO (HT key val, Int32, [(key,val)]) 
    326 findBucket HashTable{ tab=ref, hash_fn=hash} key = do 
    327   table@HT{ buckets=bkts, bmask=b } <- readIORef ref 
     326findBucket (HashTable{ tab=ref, hash_fn=hash}) key = do 
     327  table@(HT{ buckets=bkts, bmask=b }) <- readIORef ref 
    328328  let indx = bucketIndex b (hash key) 
    329329  bucket <- readHTArray bkts indx 
    330330  return (table, indx, bucket) 
    … …  
    351351                  HashTable key val -> key -> 
    352352                  IO a 
    353353updatingBucket canEnlarge bucketFn 
    354                ht@HashTable{ tab=ref, hash_fn=hash } key = do 
    355   (table@HT{ kcount=k, buckets=bkts, bmask=b }, 
     354               ht@(HashTable{ tab=ref, hash_fn=hash }) key = do 
     355  (table@(HT{ kcount=k, buckets=bkts, bmask=b }), 
    356356   indx, bckt) <- findBucket ht key 
    357357  (bckt', inserts, result) <- return $ bucketFn bckt 
    358358  let k' = k + inserts 
    … …  
    368368  return result 
    369369 
    370370expandHashTable :: (key -> Int32) -> HT key val -> IO (HT key val) 
    371 expandHashTable hash table@HT{ buckets=bkts, bmask=mask } = do 
     371expandHashTable hash table@(HT{ buckets=bkts, bmask=mask }) = do 
    372372   let 
    373373      oldsize = mask + 1 
    374374      newmask = mask + mask + 1 
    … …  
    406406-- | Remove an entry from the hash table. 
    407407delete :: HashTable key val -> key -> IO () 
    408408 
    409 delete ht@HashTable{ cmp=eq } key = 
     409delete ht@(HashTable{ cmp=eq }) key = 
    410410  updatingBucket Can'tInsert (deleteBucket (eq key)) ht key 
    411411 
    412412-- ----------------------------------------------------------------------------- 
    … …  
    422422-- by 'insert'. 
    423423update :: HashTable key val -> key -> val -> IO Bool 
    424424 
    425 update ht@HashTable{ cmp=eq } key val = 
     425update ht@(HashTable{ cmp=eq }) key val = 
    426426  updatingBucket CanInsert 
    427427    (\bucket -> let (bucket', dels, _) = deleteBucket (eq key) bucket 
    428428                in  ((key,val):bucket', 1+dels, dels/=0)) 
    … …  
    434434-- | Looks up the value of a key in the hash table. 
    435435lookup :: HashTable key val -> key -> IO (Maybe val) 
    436436 
    437 lookup ht@HashTable{ cmp=eq } key = do 
     437lookup ht@(HashTable{ cmp=eq }) key = do 
    438438  recordLookup 
    439439  (_, _, bucket) <- findBucket ht key 
    440440  let firstHit (k,v) r | eq key k  = Just v 
    … …  
    460460 
    461461{-# INLINE mapReduce #-} 
    462462mapReduce :: ([(key,val)] -> r) -> ([r] -> r) -> HashTable key val -> IO r 
    463 mapReduce m r HashTable{ tab=ref } = do 
    464   HT{ buckets=bckts, bmask=b } <- readIORef ref 
     463mapReduce m r (HashTable{ tab=ref }) = do 
     464  (HT{ buckets=bckts, bmask=b }) <- readIORef ref 
    465465  fmap r (mapM (fmap m . readHTArray bckts) [0..b]) 
    466466 
    467467-- ----------------------------------------------------------------------------- 

  • Data/Version.hs 

    diff -rN -u old-base/Data/Version.hs new-base/Data/Version.hs
    old new  
    141141#endif 
    142142parseVersion = do branch <- sepBy1 (liftM read $ munch1 isDigit) (char '.') 
    143143                  tags   <- many (char '-' >> munch1 isAlphaNum) 
    144                   return Version{versionBranch=branch, versionTags=tags} 
     144                  return $ Version{versionBranch=branch, versionTags=tags} 

  • GHC/IO/Buffer.hs 

    diff -rN -u old-base/GHC/IO/Buffer.hs new-base/GHC/IO/Buffer.hs
    old new  
    191191data BufferState = ReadBuffer | WriteBuffer deriving (Eq) 
    192192 
    193193withBuffer :: Buffer e -> (Ptr e -> IO a) -> IO a 
    194 withBuffer Buffer{ bufRaw=raw } f = withForeignPtr (castForeignPtr raw) f 
     194withBuffer (Buffer{ bufRaw=raw }) f = withForeignPtr (castForeignPtr raw) f 
    195195 
    196196withRawBuffer :: RawBuffer e -> (Ptr e -> IO a) -> IO a 
    197197withRawBuffer raw f = withForeignPtr (castForeignPtr raw) f 
    198198 
    199199isEmptyBuffer :: Buffer e -> Bool 
    200 isEmptyBuffer Buffer{ bufR=w } = w == 0 
     200isEmptyBuffer (Buffer{ bufR=w }) = w == 0 
    201201 
    202202isFullBuffer :: Buffer e -> Bool 
    203 isFullBuffer Buffer{ bufR=w, bufSize=s } = s == w 
     203isFullBuffer (Buffer{ bufR=w, bufSize=s }) = s == w 
    204204 
    205205-- if a Char buffer does not have room for a surrogate pair, it is "full" 
    206206isFullCharBuffer :: Buffer e -> Bool 
    … …  
    216216                        ReadBuffer  -> False 
    217217 
    218218bufferElems :: Buffer e -> Int 
    219 bufferElems Buffer{ bufR=w, bufL=r } = w - r 
     219bufferElems (Buffer{ bufR=w, bufL=r }) = w - r 
    220220 
    221221bufferAvailable :: Buffer e -> Int 
    222 bufferAvailable Buffer{ bufR=w, bufSize=s } = s - w 
     222bufferAvailable (Buffer{ bufR=w, bufSize=s }) = s - w 
    223223 
    224224bufferRemove :: Int -> Buffer e -> Buffer e 
    225 bufferRemove i buf@Buffer{ bufL=r } = bufferAdjustL (r+i) buf 
     225bufferRemove i buf@(Buffer{ bufL=r }) = bufferAdjustL (r+i) buf 
    226226 
    227227bufferAdjustL :: Int -> Buffer e -> Buffer e 
    228 bufferAdjustL l buf@Buffer{ bufR=w } 
     228bufferAdjustL l buf@(Buffer{ bufR=w }) 
    229229  | l == w    = buf{ bufL=0, bufR=0 } 
    230230  | otherwise = buf{ bufL=l, bufR=w } 
    231231 
    232232bufferAdd :: Int -> Buffer e -> Buffer e 
    233 bufferAdd i buf@Buffer{ bufR=w } = buf{ bufR=w+i } 
     233bufferAdd i buf@(Buffer{ bufR=w }) = buf{ bufR=w+i } 
    234234 
    235235emptyBuffer :: RawBuffer e -> Int -> BufferState -> Buffer e 
    236236emptyBuffer raw sz state =  
    … …  
    249249 
    250250-- | slides the contents of the buffer to the beginning 
    251251slideContents :: Buffer Word8 -> IO (Buffer Word8) 
    252 slideContents buf@Buffer{ bufL=l, bufR=r, bufRaw=raw } = do 
     252slideContents buf@(Buffer{ bufL=l, bufR=r, bufRaw=raw }) = do 
    253253  let elems = r - l 
    254254  withRawBuffer raw $ \p -> 
    255255      do _ <- memcpy p (p `plusPtr` l) (fromIntegral elems) 
    256256         return () 
    257   return buf{ bufL=0, bufR=elems } 
     257  return $ buf{ bufL=0, bufR=elems } 
    258258 
    259259foreign import ccall unsafe "memcpy" 
    260260   memcpy :: Ptr a -> Ptr a -> CSize -> IO (Ptr ()) 
    … …  
    273273--     operation, a read buffer always has at least one character of space. 
    274274 
    275275checkBuffer :: Buffer a -> IO () 
    276 checkBuffer buf@Buffer{ bufState = state, bufL=r, bufR=w, bufSize=size } = do 
     276checkBuffer buf@(Buffer{ bufState = state, bufL=r, bufR=w, bufSize=size }) = do 
    277277     check buf ( 
    278278        size > 0 
    279279        && r <= w 

  • GHC/IO/Encoding/Iconv.hs 

    diff -rN -u old-base/GHC/IO/Encoding/Iconv.hs new-base/GHC/IO/Encoding/Iconv.hs
    old new  
    152152  withCString to   $ \ to_str -> do 
    153153    iconvt <- throwErrnoIfMinus1 "mkTextEncoding" $ hs_iconv_open to_str from_str 
    154154    let iclose = throwErrnoIfMinus1_ "Iconv.close" $ hs_iconv_close iconvt 
    155     return BufferCodec{ 
     155    return $ BufferCodec{ 
    156156                encode = fn iconvt, 
    157157                close  = iclose, 
    158158                -- iconv doesn't supply a way to save/restore the state 
    … …  
    171171iconvRecode :: IConv -> Buffer a -> Int -> Buffer b -> Int  
    172172  -> IO (Buffer a, Buffer b) 
    173173iconvRecode iconv_t 
    174   input@Buffer{  bufRaw=iraw, bufL=ir, bufR=iw, bufSize=_  }  iscale 
    175   output@Buffer{ bufRaw=oraw, bufL=_,  bufR=ow, bufSize=os }  oscale 
     174  input@(Buffer{  bufRaw=iraw, bufL=ir, bufR=iw, bufSize=_  })  iscale 
     175  output@(Buffer{ bufRaw=oraw, bufL=_,  bufR=ow, bufSize=os })  oscale 
    176176  = do 
    177177    iconv_trace ("iconvRecode before, input=" ++ show (summaryBuffer input)) 
    178178    iconv_trace ("iconvRecode before, output=" ++ show (summaryBuffer output)) 

  • GHC/IO/Encoding/Latin1.hs 

    diff -rN -u old-base/GHC/IO/Encoding/Latin1.hs new-base/GHC/IO/Encoding/Latin1.hs
    old new  
    7676 
    7777latin1_decode :: DecodeBuffer 
    7878latin1_decode  
    79   input@Buffer{  bufRaw=iraw, bufL=ir0, bufR=iw,  bufSize=_  } 
    80   output@Buffer{ bufRaw=oraw, bufL=_,   bufR=ow0, bufSize=os } 
     79  input@(Buffer{  bufRaw=iraw, bufL=ir0, bufR=iw,  bufSize=_  }) 
     80  output@(Buffer{ bufRaw=oraw, bufL=_,   bufR=ow0, bufSize=os }) 
    8181 = let  
    8282       loop !ir !ow 
    8383         | ow >= os || ir >= iw =  done ir ow 
    … …  
    9595 
    9696latin1_encode :: EncodeBuffer 
    9797latin1_encode 
    98   input@Buffer{  bufRaw=iraw, bufL=ir0, bufR=iw,  bufSize=_  } 
    99   output@Buffer{ bufRaw=oraw, bufL=_,   bufR=ow0, bufSize=os } 
     98  input@(Buffer{  bufRaw=iraw, bufL=ir0, bufR=iw,  bufSize=_  }) 
     99  output@(Buffer{ bufRaw=oraw, bufL=_,   bufR=ow0, bufSize=os }) 
    100100 = let 
    101101      done !ir !ow = return (if ir == iw then input{ bufL=0, bufR=0 } 
    102102                                         else input{ bufL=ir }, 
    … …  
    112112 
    113113latin1_checked_encode :: EncodeBuffer 
    114114latin1_checked_encode 
    115   input@Buffer{  bufRaw=iraw, bufL=ir0, bufR=iw,  bufSize=_  } 
    116   output@Buffer{ bufRaw=oraw, bufL=_,   bufR=ow0, bufSize=os } 
     115  input@(Buffer{  bufRaw=iraw, bufL=ir0, bufR=iw,  bufSize=_  }) 
     116  output@(Buffer{ bufRaw=oraw, bufL=_,   bufR=ow0, bufSize=os }) 
    117117 = let 
    118118      done !ir !ow = return (if ir == iw then input{ bufL=0, bufR=0 } 
    119119                                         else input{ bufL=ir }, 

  • GHC/IO/Encoding/UTF16.hs 

    diff -rN -u old-base/GHC/IO/Encoding/UTF16.hs new-base/GHC/IO/Encoding/UTF16.hs
    old new  
    8484 
    8585utf16_encode :: IORef Bool -> EncodeBuffer 
    8686utf16_encode done_bom input 
    87   output@Buffer{ bufRaw=oraw, bufL=_, bufR=ow, bufSize=os } 
     87  output@(Buffer{ bufRaw=oraw, bufL=_, bufR=ow, bufSize=os }) 
    8888 = do 
    8989  b <- readIORef done_bom 
    9090  if b then utf16_native_encode input output 
    … …  
    9494                    writeIORef done_bom True 
    9595                    writeWord8Buf oraw ow     bom1 
    9696                    writeWord8Buf oraw (ow+1) bom2 
    97                     utf16_native_encode input output{ bufR = ow+2 } 
     97                    utf16_native_encode input (output{ bufR = ow+2 }) 
    9898 
    9999utf16_decode :: IORef (Maybe DecodeBuffer) -> DecodeBuffer 
    100100utf16_decode seen_bom 
    101   input@Buffer{  bufRaw=iraw, bufL=ir, bufR=iw,  bufSize=_  } 
     101  input@(Buffer{  bufRaw=iraw, bufL=ir, bufR=iw,  bufSize=_  }) 
    102102  output 
    103103 = do 
    104104   mb <- readIORef seen_bom 
    … …  
    111111       case () of 
    112112        _ | c0 == bomB && c1 == bomL -> do 
    113113               writeIORef seen_bom (Just utf16be_decode) 
    114                utf16be_decode input{ bufL= ir+2 } output 
     114               utf16be_decode (input{ bufL= ir+2 }) output 
    115115          | c0 == bomL && c1 == bomB -> do 
    116116               writeIORef seen_bom (Just utf16le_decode) 
    117                utf16le_decode input{ bufL= ir+2 } output 
     117               utf16le_decode (input{ bufL= ir+2 }) output 
    118118          | otherwise -> do 
    119119               writeIORef seen_bom (Just utf16_native_decode) 
    120120               utf16_native_decode input output 
    … …  
    184184 
    185185utf16be_decode :: DecodeBuffer 
    186186utf16be_decode  
    187   input@Buffer{  bufRaw=iraw, bufL=ir0, bufR=iw,  bufSize=_  } 
    188   output@Buffer{ bufRaw=oraw, bufL=_,   bufR=ow0, bufSize=os } 
     187  input@(Buffer{  bufRaw=iraw, bufL=ir0, bufR=iw,  bufSize=_  }) 
     188  output@(Buffer{ bufRaw=oraw, bufL=_,   bufR=ow0, bufSize=os }) 
    189189 = let  
    190190       loop !ir !ow 
    191191         | ow >= os || ir >= iw  =  done ir ow 
    … …  
    216216 
    217217utf16le_decode :: DecodeBuffer 
    218218utf16le_decode  
    219   input@Buffer{  bufRaw=iraw, bufL=ir0, bufR=iw,  bufSize=_  } 
    220   output@Buffer{ bufRaw=oraw, bufL=_,   bufR=ow0, bufSize=os } 
     219  input@(Buffer{  bufRaw=iraw, bufL=ir0, bufR=iw,  bufSize=_  }) 
     220  output@(Buffer{ bufRaw=oraw, bufL=_,   bufR=ow0, bufSize=os }) 
    221221 = let  
    222222       loop !ir !ow 
    223223         | ow >= os || ir >= iw  =  done ir ow 
    … …  
    253253 
    254254utf16be_encode :: EncodeBuffer 
    255255utf16be_encode 
    256   input@Buffer{  bufRaw=iraw, bufL=ir0, bufR=iw,  bufSize=_  } 
    257   output@Buffer{ bufRaw=oraw, bufL=_,   bufR=ow0, bufSize=os } 
     256  input@(Buffer{  bufRaw=iraw, bufL=ir0, bufR=iw,  bufSize=_  }) 
     257  output@(Buffer{ bufRaw=oraw, bufL=_,   bufR=ow0, bufSize=os }) 
    258258 = let  
    259259      done !ir !ow = return (if ir == iw then input{ bufL=0, bufR=0 } 
    260260                                         else input{ bufL=ir }, 
    … …  
    289289 
    290290utf16le_encode :: EncodeBuffer 
    291291utf16le_encode 
    292   input@Buffer{  bufRaw=iraw, bufL=ir0, bufR=iw,  bufSize=_  } 
    293   output@Buffer{ bufRaw=oraw, bufL=_,   bufR=ow0, bufSize=os } 
     292  input@(Buffer{  bufRaw=iraw, bufL=ir0, bufR=iw,  bufSize=_  }) 
     293  output@(Buffer{ bufRaw=oraw, bufL=_,   bufR=ow0, bufSize=os }) 
    294294 = let 
    295295      done !ir !ow = return (if ir == iw then input{ bufL=0, bufR=0 } 
    296296                                         else input{ bufL=ir }, 

  • GHC/IO/Encoding/UTF32.hs 

    diff -rN -u old-base/GHC/IO/Encoding/UTF32.hs new-base/GHC/IO/Encoding/UTF32.hs
    old new  
    7373 
    7474utf32_encode :: IORef Bool -> EncodeBuffer 
    7575utf32_encode done_bom input 
    76   output@Buffer{ bufRaw=oraw, bufL=_, bufR=ow, bufSize=os } 
     76  output@(Buffer{ bufRaw=oraw, bufL=_, bufR=ow, bufSize=os }) 
    7777 = do 
    7878  b <- readIORef done_bom 
    7979  if b then utf32_native_encode input output 
    … …  
    8585                    writeWord8Buf oraw (ow+1) bom1 
    8686                    writeWord8Buf oraw (ow+2) bom2 
    8787                    writeWord8Buf oraw (ow+3) bom3 
    88                     utf32_native_encode input output{ bufR = ow+4 } 
     88                    utf32_native_encode input (output{ bufR = ow+4 }) 
    8989 
    9090utf32_decode :: IORef (Maybe DecodeBuffer) -> DecodeBuffer 
    9191utf32_decode seen_bom 
    92   input@Buffer{  bufRaw=iraw, bufL=ir, bufR=iw,  bufSize=_  } 
     92  input@(Buffer{  bufRaw=iraw, bufL=ir, bufR=iw,  bufSize=_  }) 
    9393  output 
    9494 = do 
    9595   mb <- readIORef seen_bom 
    … …  
    104104       case () of 
    105105        _ | c0 == bom0 && c1 == bom1 && c2 == bom2 && c3 == bom3 -> do 
    106106               writeIORef seen_bom (Just utf32be_decode) 
    107                utf32be_decode input{ bufL= ir+4 } output 
     107               utf32be_decode (input{ bufL= ir+4 }) output 
    108108        _ | c0 == bom3 && c1 == bom2 && c2 == bom1 && c3 == bom0 -> do 
    109109               writeIORef seen_bom (Just utf32le_decode) 
    110                utf32le_decode input{ bufL= ir+4 } output 
     110               utf32le_decode (input{ bufL= ir+4 }) output 
    111111          | otherwise -> do 
    112112               writeIORef seen_bom (Just utf32_native_decode) 
    113113               utf32_native_decode input output 
    … …  
    177177 
    178178utf32be_decode :: DecodeBuffer 
    179179utf32be_decode  
    180   input@Buffer{  bufRaw=iraw, bufL=ir0, bufR=iw,  bufSize=_  } 
    181   output@Buffer{ bufRaw=oraw, bufL=_,   bufR=ow0, bufSize=os } 
     180  input@(Buffer{  bufRaw=iraw, bufL=ir0, bufR=iw,  bufSize=_  }) 
     181  output@(Buffer{ bufRaw=oraw, bufL=_,   bufR=ow0, bufSize=os }) 
    182182 = let  
    183183       loop !ir !ow 
    184184         | ow >= os || iw - ir < 4 =  done ir ow 
    … …  
    203203 
    204204utf32le_decode :: DecodeBuffer 
    205205utf32le_decode  
    206   input@Buffer{  bufRaw=iraw, bufL=ir0, bufR=iw,  bufSize=_  } 
    207   output@Buffer{ bufRaw=oraw, bufL=_,   bufR=ow0, bufSize=os } 
     206  input@(Buffer{  bufRaw=iraw, bufL=ir0, bufR=iw,  bufSize=_  }) 
     207  output@(Buffer{ bufRaw=oraw, bufL=_,   bufR=ow0, bufSize=os }) 
    208208 = let  
    209209       loop !ir !ow 
    210210         | ow >= os || iw - ir < 4 =  done ir ow 
    … …  
    234234 
    235235utf32be_encode :: EncodeBuffer 
    236236utf32be_encode 
    237   input@Buffer{  bufRaw=iraw, bufL=ir0, bufR=iw,  bufSize=_  } 
    238   output@Buffer{ bufRaw=oraw, bufL=_,   bufR=ow0, bufSize=os } 
     237  input@(Buffer{  bufRaw=iraw, bufL=ir0, bufR=iw,  bufSize=_  }) 
     238  output@(Buffer{ bufRaw=oraw, bufL=_,   bufR=ow0, bufSize=os }) 
    239239 = let  
    240240      done !ir !ow = return (if ir == iw then input{ bufL=0, bufR=0 } 
    241241                                         else input{ bufL=ir }, 
    … …  
    256256 
    257257utf32le_encode :: EncodeBuffer 
    258258utf32le_encode 
    259   input@Buffer{  bufRaw=iraw, bufL=ir0, bufR=iw,  bufSize=_  } 
    260   output@Buffer{ bufRaw=oraw, bufL=_,   bufR=ow0, bufSize=os } 
     259  input@(Buffer{  bufRaw=iraw, bufL=ir0, bufR=iw,  bufSize=_  }) 
     260  output@(Buffer{ bufRaw=oraw, bufL=_,   bufR=ow0, bufSize=os }) 
    261261 = let 
    262262      done !ir !ow = return (if ir == iw then input{ bufL=0, bufR=0 } 
    263263                                         else input{ bufL=ir }, 

  • GHC/IO/Encoding/UTF8.hs 

    diff -rN -u old-base/GHC/IO/Encoding/UTF8.hs new-base/GHC/IO/Encoding/UTF8.hs
    old new  
    8383 
    8484utf8_bom_decode :: IORef Bool -> DecodeBuffer 
    8585utf8_bom_decode ref 
    86   input@Buffer{  bufRaw=iraw, bufL=ir, bufR=iw,  bufSize=_  } 
     86  input@(Buffer{  bufRaw=iraw, bufL=ir, bufR=iw,  bufSize=_  }) 
    8787  output 
    8888 = do 
    8989   first <- readIORef ref 
    … …  
    102102       if (c2 /= bom2) then no_bom else do 
    103103       -- found a BOM, ignore it and carry on 
    104104       writeIORef ref False 
    105        utf8_decode input{ bufL = ir + 3 } output 
     105       utf8_decode (input{ bufL = ir + 3 }) output 
    106106 
    107107utf8_bom_encode :: IORef Bool -> EncodeBuffer 
    108108utf8_bom_encode ref input 
    109   output@Buffer{ bufRaw=oraw, bufL=_, bufR=ow, bufSize=os } 
     109  output@(Buffer{ bufRaw=oraw, bufL=_, bufR=ow, bufSize=os }) 
    110110 = do 
    111111  b <- readIORef ref 
    112112  if not b then utf8_encode input output 
    … …  
    117117                    writeWord8Buf oraw ow     bom0 
    118118                    writeWord8Buf oraw (ow+1) bom1 
    119119                    writeWord8Buf oraw (ow+2) bom2 
    120                     utf8_encode input output{ bufR = ow+3 } 
     120                    utf8_encode input (output{ bufR = ow+3 }) 
    121121 
    122122bom0, bom1, bom2 :: Word8 
    123123bom0 = 0xef 
    … …  
    126126 
    127127utf8_decode :: DecodeBuffer 
    128128utf8_decode  
    129   input@Buffer{  bufRaw=iraw, bufL=ir0, bufR=iw,  bufSize=_  } 
    130   output@Buffer{ bufRaw=oraw, bufL=_,   bufR=ow0, bufSize=os } 
     129  input@(Buffer{  bufRaw=iraw, bufL=ir0, bufR=iw,  bufSize=_  }) 
     130  output@(Buffer{ bufRaw=oraw, bufL=_,   bufR=ow0, bufSize=os }) 
    131131 = let  
    132132       loop !ir !ow 
    133133         | ow >= os || ir >= iw = done ir ow 
    … …  
    177177 
    178178utf8_encode :: EncodeBuffer 
    179179utf8_encode 
    180   input@Buffer{  bufRaw=iraw, bufL=ir0, bufR=iw,  bufSize=_  } 
    181   output@Buffer{ bufRaw=oraw, bufL=_,   bufR=ow0, bufSize=os } 
     180  input@(Buffer{  bufRaw=iraw, bufL=ir0, bufR=iw,  bufSize=_  }) 
     181  output@(Buffer{ bufRaw=oraw, bufL=_,   bufR=ow0, bufSize=os }) 
    182182 = let  
    183183      done !ir !ow = return (if ir == iw then input{ bufL=0, bufR=0 } 
    184184                                         else input{ bufL=ir }, 

  • GHC/IO/FD.hs 

    diff -rN -u old-base/GHC/IO/FD.hs new-base/GHC/IO/FD.hs
    old new  
    341341dup :: FD -> IO FD 
    342342dup fd = do 
    343343  newfd <- throwErrnoIfMinus1 "GHC.IO.FD.dup" $ c_dup (fdFD fd) 
    344   return fd{ fdFD = newfd } 
     344  return $ fd{ fdFD = newfd } 
    345345 
    346346dup2 :: FD -> FD -> IO FD 
    347347dup2 fd fdto = do 
    348348  -- Windows' dup2 does not return the new descriptor, unlike Unix 
    349349  throwErrnoIfMinus1_ "GHC.IO.FD.dup2" $ 
    350350    c_dup2 (fdFD fd) (fdFD fdto) 
    351   return fd{ fdFD = fdFD fdto } -- original FD, with the new fdFD 
     351  return $ fd{ fdFD = fdFD fdto } -- original FD, with the new fdFD 
    352352 
    353353setNonBlockingMode :: FD -> Bool -> IO FD 
    354354setNonBlockingMode fd set = do  
    … …  
    356356#if defined(mingw32_HOST_OS) 
    357357  return fd 
    358358#else 
    359   return fd{ fdIsNonBlocking = fromEnum set } 
     359  return $ fd{ fdIsNonBlocking = fromEnum set } 
    360360#endif 
    361361 
    362362ready :: FD -> Bool -> Int -> IO Bool 

  • GHC/IO/Handle/Internals.hs 

    diff -rN -u old-base/GHC/IO/Handle/Internals.hs new-base/GHC/IO/Handle/Internals.hs
    old new  
    168168   return () 
    169169 
    170170augmentIOError :: IOException -> String -> Handle -> IOException 
    171 augmentIOError ioe@IOError{ ioe_filename = fp } fun h 
     171augmentIOError ioe@(IOError{ ioe_filename = fp }) fun h 
    172172  = ioe { ioe_handle = Just h, ioe_location = fun, ioe_filename = filepath } 
    173173  where filepath 
    174174          | Just _ <- fp = fp 
    … …  
    192192   = withHandle_' fun h m (checkWritableHandle act) 
    193193 
    194194checkWritableHandle :: (Handle__ -> IO a) -> Handle__ -> IO a 
    195 checkWritableHandle act h_@Handle__{..} 
     195checkWritableHandle act h_@(Handle__{..}) 
    196196  = case haType of 
    197197      ClosedHandle         -> ioe_closedHandle 
    198198      SemiClosedHandle     -> ioe_closedHandle 
    … …  
    203203           flushCharReadBuffer h_ 
    204204           flushByteReadBuffer h_ 
    205205           buf <- readIORef haCharBuffer 
    206            writeIORef haCharBuffer buf{ bufState = WriteBuffer } 
     206           writeIORef haCharBuffer (buf{ bufState = WriteBuffer }) 
    207207           buf <- readIORef haByteBuffer 
    208            writeIORef haByteBuffer buf{ bufState = WriteBuffer } 
     208           writeIORef haByteBuffer (buf{ bufState = WriteBuffer }) 
    209209        act h_ 
    210210      _other               -> act h_ 
    211211 
    … …  
    228228  = withHandle_' fun h m (checkReadableHandle act) 
    229229 
    230230checkReadableHandle :: (Handle__ -> IO a) -> Handle__ -> IO a 
    231 checkReadableHandle act h_@Handle__{..} = 
     231checkReadableHandle act h_@(Handle__{..}) = 
    232232    case haType of 
    233233      ClosedHandle         -> ioe_closedHandle 
    234234      SemiClosedHandle     -> ioe_closedHandle 
    … …  
    240240          cbuf <- readIORef haCharBuffer 
    241241          when (isWriteBuffer cbuf) $ do 
    242242             cbuf' <- flushWriteBuffer_ h_ cbuf 
    243              writeIORef haCharBuffer cbuf'{ bufState = ReadBuffer } 
     243             writeIORef haCharBuffer (cbuf'{ bufState = ReadBuffer }) 
    244244             bbuf <- readIORef haByteBuffer 
    245              writeIORef haByteBuffer bbuf{ bufState = ReadBuffer } 
     245             writeIORef haByteBuffer (bbuf{ bufState = ReadBuffer }) 
    246246          act h_ 
    247247      _other               -> act h_ 
    248248 
    … …  
    257257  withHandle_' fun h m (checkSeekableHandle act) 
    258258 
    259259checkSeekableHandle :: (Handle__ -> IO a) -> Handle__ -> IO a 
    260 checkSeekableHandle act handle_@Handle__{haDevice=dev} = 
     260checkSeekableHandle act handle_@(Handle__{haDevice=dev}) = 
    261261    case haType handle_ of 
    262262      ClosedHandle      -> ioe_closedHandle 
    263263      SemiClosedHandle  -> ioe_closedHandle 
    … …  
    374374-- file pointer backwards in the case of a read buffer.  This can fail 
    375375-- on a non-seekable read Handle. 
    376376flushBuffer :: Handle__ -> IO () 
    377 flushBuffer h_@Handle__{..} = do 
     377flushBuffer h_@(Handle__{..}) = do 
    378378  buf <- readIORef haCharBuffer 
    379379  case bufState buf of 
    380380    ReadBuffer  -> do 
    … …  
    387387-- | flushes at least the Char buffer, and the byte buffer for a write 
    388388-- Handle.  Works on all Handles. 
    389389flushCharBuffer :: Handle__ -> IO () 
    390 flushCharBuffer h_@Handle__{..} = do 
     390flushCharBuffer h_@(Handle__{..}) = do 
    391391  buf <- readIORef haCharBuffer 
    392392  case bufState buf of 
    393393    ReadBuffer  -> do 
    … …  
    403403-- data.  Flushes both the Char and the byte buffer, leaving both 
    404404-- empty. 
    405405flushWriteBuffer :: Handle__ -> IO () 
    406 flushWriteBuffer h_@Handle__{..} = do 
     406flushWriteBuffer h_@(Handle__{..}) = do 
    407407  buf <- readIORef haCharBuffer 
    408408  if isWriteBuffer buf 
    409409         then do buf' <- flushWriteBuffer_ h_ buf 
    … …  
    411411         else return () 
    412412 
    413413flushWriteBuffer_ :: Handle__ -> CharBuffer -> IO CharBuffer 
    414 flushWriteBuffer_ h_@Handle__{..} cbuf = do 
     414flushWriteBuffer_ h_@(Handle__{..}) cbuf = do 
    415415  bbuf <- readIORef haByteBuffer 
    416416  if not (isEmptyBuffer cbuf) || not (isEmptyBuffer bbuf) 
    417417     then do writeTextDevice h_ cbuf 
    418              return cbuf{ bufL=0, bufR=0 } 
     418             return $ cbuf{ bufL=0, bufR=0 } 
    419419     else return cbuf 
    420420 
    421421-- ----------------------------------------------------------------------------- 
    … …  
    423423 
    424424-- It is always possible to flush the Char buffer back to the byte buffer. 
    425425flushCharReadBuffer :: Handle__ -> IO () 
    426 flushCharReadBuffer Handle__{..} = do 
     426flushCharReadBuffer (Handle__{..}) = do 
    427427  cbuf <- readIORef haCharBuffer 
    428428  if isWriteBuffer cbuf || isEmptyBuffer cbuf then return () else do 
    429429 
    … …  
    433433  (codec_state, bbuf0) <- readIORef haLastDecode 
    434434 
    435435  cbuf0 <- readIORef haCharBuffer 
    436   writeIORef haCharBuffer cbuf0{ bufL=0, bufR=0 } 
     436  writeIORef haCharBuffer (cbuf0{ bufL=0, bufR=0 }) 
    437437 
    438438  -- if we haven't used any characters from the char buffer, then just 
    439439  -- re-install the old byte buffer. 
    … …  
    444444 
    445445  case haDecoder of 
    446446    Nothing -> do 
    447       writeIORef haByteBuffer bbuf0 { bufL = bufL bbuf0 + bufL cbuf0 } 
     447      writeIORef haByteBuffer (bbuf0 { bufL = bufL bbuf0 + bufL cbuf0 }) 
    448448      -- no decoder: the number of bytes to decode is the same as the 
    449449      -- number of chars we have used up. 
    450450 
    … …  
    456456      setState decoder codec_state 
    457457     
    458458      (bbuf1,cbuf1) <- (encode decoder) bbuf0 
    459                                cbuf0{ bufL=0, bufR=0, bufSize = bufL cbuf0 } 
     459                               (cbuf0{ bufL=0, bufR=0, bufSize = bufL cbuf0 }) 
    460460     
    461461      debugIO ("finished, bbuf=" ++ summaryBuffer bbuf1 ++ 
    462462               " cbuf=" ++ summaryBuffer cbuf1) 
    … …  
    470470-- handle is not allowed. 
    471471 
    472472flushByteReadBuffer :: Handle__ -> IO () 
    473 flushByteReadBuffer h_@Handle__{..} = do 
     473flushByteReadBuffer h_@(Handle__{..}) = do 
    474474  bbuf <- readIORef haByteBuffer 
    475475 
    476476  if isEmptyBuffer bbuf then return () else do 
    … …  
    483483  debugIO ("flushByteReadBuffer: new file offset = " ++ show seek) 
    484484  IODevice.seek haDevice RelativeSeek (fromIntegral seek) 
    485485 
    486   writeIORef haByteBuffer bbuf{ bufL=0, bufR=0 } 
     486  writeIORef haByteBuffer (bbuf{ bufL=0, bufR=0 }) 
    487487 
    488488-- ---------------------------------------------------------------------------- 
    489489-- Making Handles 
    … …  
    584584   -> IO a 
    585585 
    586586openTextEncoding Nothing   ha_type cont = cont Nothing Nothing 
    587 openTextEncoding (Just TextEncoding{..}) ha_type cont = do 
     587openTextEncoding (Just (TextEncoding{..})) ha_type cont = do 
    588588    mb_decoder <- if isReadableHandleType ha_type then do 
    589589                     decoder <- mkTextDecoder 
    590590                     return (Just decoder) 
    … …  
    622622trymaybe io = (do io; return Nothing) `catchException` \e -> return (Just e) 
    623623 
    624624hClose_handle_ :: Handle__ -> IO (Handle__, Maybe SomeException) 
    625 hClose_handle_ Handle__{..} = do 
     625hClose_handle_ (Handle__{..}) = do 
    626626 
    627627    -- close the file descriptor, but not when this is the read 
    628628    -- side of a duplex handle. 
    … …  
    662662-- Looking ahead 
    663663 
    664664hLookAhead_ :: Handle__ -> IO Char 
    665 hLookAhead_ handle_@Handle__{..} = do 
     665hLookAhead_ handle_@(Handle__{..}) = do 
    666666    buf <- readIORef haCharBuffer 
    667667   
    668668    -- fill up the read buffer if necessary 
    … …  
    691691-- Write the contents of the supplied Char buffer to the device, return 
    692692-- only when all the data has been written. 
    693693writeTextDevice :: Handle__ -> CharBuffer -> IO () 
    694 writeTextDevice h_@Handle__{..} cbuf = do 
     694writeTextDevice h_@(Handle__{..}) cbuf = do 
    695695  -- 
    696696  bbuf <- readIORef haByteBuffer 
    697697 
    … …  
    706706        " bbuf=" ++ summaryBuffer bbuf') 
    707707 
    708708  Buffered.flushWriteBuffer haDevice bbuf' 
    709   writeIORef haByteBuffer bbuf{bufL=0,bufR=0} 
     709  writeIORef haByteBuffer (bbuf{bufL=0,bufR=0}) 
    710710  if not (isEmptyBuffer cbuf') 
    711711     then writeTextDevice h_ cbuf' 
    712712     else return () 
    … …  
    715715-- characters are available; raise an exception if the end of  
    716716-- file is reached. 
    717717readTextDevice :: Handle__ -> CharBuffer -> IO CharBuffer 
    718 readTextDevice h_@Handle__{..} cbuf = do 
     718readTextDevice h_@(Handle__{..}) cbuf = do 
    719719  -- 
    720720  bbuf0 <- readIORef haByteBuffer 
    721721 
    … …  
    752752-- we have an incomplete byte sequence at the end of the buffer: try to 
    753753-- read more bytes. 
    754754readTextDevice' :: Handle__ -> Buffer Word8 -> CharBuffer -> IO CharBuffer 
    755 readTextDevice' h_@Handle__{..} bbuf0 cbuf = do 
     755readTextDevice' h_@(Handle__{..}) bbuf0 cbuf = do 
    756756  -- 
    757757  -- copy the partial sequence to the beginning of the buffer, so we have 
    758758  -- room to read more bytes. 
    … …  
    786786-- Read characters into the provided buffer.  Do not block; 
    787787-- return zero characters instead.  Raises an exception on end-of-file. 
    788788readTextDeviceNonBlocking :: Handle__ -> CharBuffer -> IO CharBuffer 
    789 readTextDeviceNonBlocking h_@Handle__{..} cbuf = do 
     789readTextDeviceNonBlocking h_@(Handle__{..}) cbuf = do 
    790790  -- 
    791791  bbuf0 <- readIORef haByteBuffer 
    792792  bbuf1 <- if not (isEmptyBuffer bbuf0) 

  • GHC/IO/Handle/Text.hs 

    diff -rN -u old-base/GHC/IO/Handle/Text.hs new-base/GHC/IO/Handle/Text.hs
    old new  
    7777 
    7878hWaitForInput :: Handle -> Int -> IO Bool 
    7979hWaitForInput h msecs = do 
    80   wantReadableHandle_ "hWaitForInput" h $ \ handle_@Handle__{..} -> do 
     80  wantReadableHandle_ "hWaitForInput" h $ \ handle_@(Handle__{..}) -> do 
    8181  buf <- readIORef haCharBuffer 
    8282 
    8383  if not (isEmptyBuffer buf) 
    … …  
    107107 
    108108hGetChar :: Handle -> IO Char 
    109109hGetChar handle = 
    110   wantReadableHandle_ "hGetChar" handle $ \handle_@Handle__{..} -> do 
     110  wantReadableHandle_ "hGetChar" handle $ \handle_@(Handle__{..}) -> do 
    111111 
    112112  -- buffering mode makes no difference: we just read whatever is available 
    113113  -- from the device (blocking only if there is nothing available), and then 
    … …  
    171171     hGetLineBuffered handle_ 
    172172 
    173173hGetLineBuffered :: Handle__ -> IO String 
    174 hGetLineBuffered handle_@Handle__{..} = do 
     174hGetLineBuffered handle_@(Handle__{..}) = do 
    175175  buf <- readIORef haCharBuffer 
    176176  hGetLineBufferedLoop handle_ buf [] 
    177177 
    178178hGetLineBufferedLoop :: Handle__ 
    179179                     -> CharBuffer -> [String] 
    180180                     -> IO String 
    181 hGetLineBufferedLoop handle_@Handle__{..} 
    182         buf@Buffer{ bufL=r0, bufR=w, bufRaw=raw0 } xss = 
     181hGetLineBufferedLoop handle_@(Handle__{..}) 
     182        buf@(Buffer{ bufL=r0, bufR=w, bufRaw=raw0 }) xss = 
    183183  let 
    184184        -- find the end-of-line character, if there is one 
    185185        loop raw r 
    … …  
    216216                     -- append it to the line if necessary. 
    217217                     --  
    218218                     let pre = if not (isEmptyBuffer buf1) then "\r" else "" 
    219                      writeIORef haCharBuffer buf1{ bufL=0, bufR=0 } 
     219                     writeIORef haCharBuffer (buf1{ bufL=0, bufR=0 }) 
    220220                     let str = concat (reverse (pre:xs:xss)) 
    221221                     if not (null str) 
    222222                        then return str 
    … …  
    354354                        "illegal handle type" Nothing Nothing) 
    355355 
    356356lazyReadBuffered :: Handle -> Handle__ -> IO (Handle__, [Char]) 
    357 lazyReadBuffered h handle_@Handle__{..} = do 
     357lazyReadBuffered h handle_@(Handle__{..}) = do 
    358358   buf <- readIORef haCharBuffer 
    359359   catch  
    360360        (do  
    361             buf'@Buffer{..} <- getSomeCharacters handle_ buf 
     361            buf'@(Buffer{..}) <- getSomeCharacters handle_ buf 
    362362            lazy_rest <- lazyRead h 
    363363            (s,r) <- if haInputNL == CRLF 
    364364                         then unpack_nl bufRaw bufL bufR lazy_rest 
    … …  
    379379 
    380380-- ensure we have some characters in the buffer 
    381381getSomeCharacters :: Handle__ -> CharBuffer -> IO CharBuffer 
    382 getSomeCharacters handle_@Handle__{..} buf@Buffer{..} = 
     382getSomeCharacters handle_@(Handle__{..}) buf@(Buffer{..}) = 
    383383  case bufferElems buf of 
    384384 
    385385    -- buffer empty: read some more 
    … …  
    426426        _other        -> hPutcBuffered handle_ False c 
    427427 
    428428hPutcBuffered :: Handle__ -> Bool -> Char -> IO () 
    429 hPutcBuffered handle_@Handle__{..} is_line c = do 
     429hPutcBuffered handle_@(Handle__{..}) is_line c = do 
    430430  buf <- readIORef haCharBuffer 
    431431  if c == '\n' 
    432432     then do buf1 <- if haOutputNL == CRLF 
    … …  
    445445          buf1 <- putc buf c 
    446446          writeIORef haCharBuffer buf1 
    447447  where 
    448     putc buf@Buffer{ bufRaw=raw, bufR=w } c = do 
     448    putc buf@(Buffer{ bufRaw=raw, bufR=w }) c = do 
    449449       debugIO ("putc: " ++ summaryBuffer buf) 
    450450       w'  <- writeCharBuf raw w c 
    451451       let buf' = buf{ bufR = w' } 
    … …  
    502502hPutChars handle (c:cs) = hPutChar handle c >> hPutChars handle cs 
    503503 
    504504getSpareBuffer :: Handle__ -> IO (BufferMode, CharBuffer) 
    505 getSpareBuffer Handle__{haCharBuffer=ref,  
    506                         haBuffers=spare_ref, 
    507                         haBufferMode=mode} 
     505getSpareBuffer (Handle__{haCharBuffer=ref, 
     506                         haBuffers=spare_ref, 
     507                         haBufferMode=mode}) 
    508508 = do 
    509509   case mode of 
    510510     NoBuffering -> return (mode, error "no buffer!") 
    … …  
    523523-- NB. performance-critical code: eyeball the Core. 
    524524writeBlocks :: Handle -> Bool -> Newline -> Buffer CharBufElem -> String -> IO () 
    525525writeBlocks hdl line_buffered nl 
    526             buf@Buffer{ bufRaw=raw, bufSize=len } s = 
     526            buf@(Buffer{ bufRaw=raw, bufSize=len }) s = 
    527527  let 
    528528   shoveString :: Int -> [Char] -> IO () 
    529529   shoveString !n [] = do 
    … …  
    601601commitBuffer' :: RawCharBuffer -> Int -> Int -> Bool -> Bool -> Handle__ 
    602602              -> IO CharBuffer 
    603603commitBuffer' raw sz@(I# _) count@(I# _) flush release 
    604   handle_@Handle__{ haCharBuffer=ref, haBuffers=spare_buf_ref } = do 
     604  handle_@(Handle__{ haCharBuffer=ref, haBuffers=spare_buf_ref }) = do 
    605605 
    606606      debugIO ("commitBuffer: sz=" ++ show sz ++ ", count=" ++ show count 
    607607            ++ ", flush=" ++ show flush ++ ", release=" ++ show release) 
    608608 
    609       old_buf@Buffer{ bufRaw=old_raw, bufR=w, bufSize=size } 
     609      old_buf@(Buffer{ bufRaw=old_raw, bufR=w, bufSize=size }) 
    610610          <- readIORef ref 
    611611 
    612612      buf_ret <- 
    … …  
    624624            then do withRawBuffer raw     $ \praw -> 
    625625                      copyToRawBuffer old_raw (w*charSize) 
    626626                                      praw (fromIntegral (count*charSize)) 
    627                     writeIORef ref old_buf{ bufR = w + count } 
     627                    writeIORef ref (old_buf{ bufR = w + count }) 
    628628                    return (emptyBuffer raw sz WriteBuffer) 
    629629 
    630630                -- else, we have to flush 
    … …  
    714714  | count <  0 = illegalBufferSize handle "hPutBuf" count 
    715715  | otherwise =  
    716716    wantWritableHandle "hPutBuf" handle $  
    717       \ h_@Handle__{..} -> do 
     717      \ h_@(Handle__{..}) -> do 
    718718          debugIO ("hPutBuf count=" ++ show count) 
    719719          -- first flush the Char buffer if it is non-empty, then we 
    720720          -- can work directly with the byte buffer 
    … …  
    732732          return r 
    733733 
    734734bufWrite :: Handle__-> Ptr Word8 -> Int -> Bool -> IO Int 
    735 bufWrite h_@Handle__{..} ptr count can_block = 
     735bufWrite h_@(Handle__{..}) ptr count can_block = 
    736736  seq count $ do  -- strictness hack 
    737   old_buf@Buffer{ bufRaw=old_raw, bufR=w, bufSize=size } 
     737  old_buf@(Buffer{ bufRaw=old_raw, bufR=w, bufSize=size }) 
    738738     <- readIORef haByteBuffer 
    739739 
    740740  -- enough room in handle buffer? 
    … …  
    743743        -- just copy the data in and update bufR. 
    744744        then do debugIO ("hPutBuf: copying to buffer, w=" ++ show w) 
    745745                copyToRawBuffer old_raw w ptr (fromIntegral count) 
    746                 writeIORef haByteBuffer old_buf{ bufR = w + count } 
     746                writeIORef haByteBuffer (old_buf{ bufR = w + count }) 
    747747                return count 
    748748 
    749749        -- else, we have to flush 
    750750        else do debugIO "hPutBuf: flushing first" 
    751751                Buffered.flushWriteBuffer haDevice old_buf 
    752752                        -- TODO: we should do a non-blocking flush here 
    753                 writeIORef haByteBuffer old_buf{bufL=0,bufR=0} 
     753                writeIORef haByteBuffer (old_buf{bufL=0,bufR=0}) 
    754754                -- if we can fit in the buffer, then just loop   
    755755                if count < size 
    756756                   then bufWrite h_ ptr count can_block 
    … …  
    760760                           else writeChunkNonBlocking h_ (castPtr ptr) count 
    761761 
    762762writeChunk :: Handle__ -> Ptr Word8 -> Int -> IO () 
    763 writeChunk h_@Handle__{..} ptr bytes 
     763writeChunk h_@(Handle__{..}) ptr bytes 
    764764  | Just fd <- cast haDevice  =  RawIO.write (fd::FD) ptr bytes 
    765765  | otherwise = error "Todo: hPutBuf" 
    766766 
    767767writeChunkNonBlocking :: Handle__ -> Ptr Word8 -> Int -> IO Int 
    768 writeChunkNonBlocking h_@Handle__{..} ptr bytes  
     768writeChunkNonBlocking h_@(Handle__{..}) ptr bytes  
    769769  | Just fd <- cast haDevice  =  RawIO.writeNonBlocking (fd::FD) ptr bytes 
    770770  | otherwise = error "Todo: hPutBuf" 
    771771 
    … …  
    803803-- taking data first from the buffer and then direct from the file 
    804804-- descriptor. 
    805805bufRead :: Handle__ -> Ptr Word8 -> Int -> Int -> IO Int 
    806 bufRead h_@Handle__{..} ptr so_far count = 
     806bufRead h_@(Handle__{..}) ptr so_far count = 
    807807  seq so_far $ seq count $ do -- strictness hack 
    808   buf@Buffer{ bufRaw=raw, bufR=w, bufL=r, bufSize=sz } <- readIORef haByteBuffer 
     808  buf@(Buffer{ bufRaw=raw, bufR=w, bufL=r, bufSize=sz }) <- readIORef haByteBuffer 
    809809  if isEmptyBuffer buf 
    810810     then if count > sz  -- small read? 
    811811                then do rest <- readChunk h_ ptr count 
    … …  
    820820        if (count == avail) 
    821821           then do  
    822822                copyFromRawBuffer ptr raw r count 
    823                 writeIORef haByteBuffer buf{ bufR=0, bufL=0 } 
     823                writeIORef haByteBuffer (buf{ bufR=0, bufL=0 }) 
    824824                return (so_far + count) 
    825825           else do 
    826826        if (count < avail) 
    827827           then do  
    828828                copyFromRawBuffer ptr raw r count 
    829                 writeIORef haByteBuffer buf{ bufL = r + count } 
     829                writeIORef haByteBuffer (buf{ bufL = r + count }) 
    830830                return (so_far + count) 
    831831           else do 
    832832   
    833833        copyFromRawBuffer ptr raw (fromIntegral r) (fromIntegral avail) 
    834         writeIORef haByteBuffer buf{ bufR=0, bufL=0 } 
     834        writeIORef haByteBuffer (buf{ bufR=0, bufL=0 }) 
    835835        let remaining = count - avail 
    836836            so_far' = so_far + avail 
    837837            ptr' = ptr `plusPtr` avail 
    … …  
    844844        return (so_far' + rest) 
    845845 
    846846readChunk :: Handle__ -> Ptr a -> Int -> IO Int 
    847 readChunk h_@Handle__{..} ptr bytes 
     847readChunk h_@(Handle__{..}) ptr bytes 
    848848 | Just fd <- cast haDevice = loop fd 0 bytes 
    849849 | otherwise = error "ToDo: hGetBuf" 
    850850 where 
    … …  
    886886         bufReadNonBlocking h_ (castPtr ptr) 0 count 
    887887 
    888888bufReadNonBlocking :: Handle__ -> Ptr Word8 -> Int -> Int -> IO Int 
    889 bufReadNonBlocking h_@Handle__{..} ptr so_far count =  
     889bufReadNonBlocking h_@(Handle__{..}) ptr so_far count =  
    890890  seq so_far $ seq count $ do -- strictness hack 
    891   buf@Buffer{ bufRaw=raw, bufR=w, bufL=r, bufSize=sz } <- readIORef haByteBuffer 
     891  buf@(Buffer{ bufRaw=raw, bufR=w, bufL=r, bufSize=sz }) <- readIORef haByteBuffer 
    892892  if isEmptyBuffer buf 
    893893     then if count > sz  -- large read? 
    894894                then do rest <- readChunkNonBlocking h_ ptr count 
    … …  
    909909        if (count == avail) 
    910910           then do  
    911911                copyFromRawBuffer ptr raw r count 
    912                 writeIORef haByteBuffer buf{ bufR=0, bufL=0 } 
     912                writeIORef haByteBuffer (buf{ bufR=0, bufL=0 }) 
    913913                return (so_far + count) 
    914914           else do 
    915915        if (count < avail) 
    916916           then do  
    917917                copyFromRawBuffer ptr raw r count 
    918                 writeIORef haByteBuffer buf{ bufL = r + count } 
     918                writeIORef haByteBuffer (buf{ bufL = r + count }) 
    919919                return (so_far + count) 
    920920           else do 
    921921 
    922922        copyFromRawBuffer ptr raw (fromIntegral r) (fromIntegral avail) 
    923         writeIORef haByteBuffer buf{ bufR=0, bufL=0 } 
     923        writeIORef haByteBuffer (buf{ bufR=0, bufL=0 }) 
    924924        let remaining = count - avail 
    925925            so_far' = so_far + avail 
    926926            ptr' = ptr `plusPtr` avail 
    … …  
    935935 
    936936 
    937937readChunkNonBlocking :: Handle__ -> Ptr Word8 -> Int -> IO Int 
    938 readChunkNonBlocking h_@Handle__{..} ptr bytes 
     938readChunkNonBlocking h_@(Handle__{..}) ptr bytes 
    939939 | Just fd <- cast haDevice = do 
    940940     m <- RawIO.readNonBlocking (fd::FD) ptr bytes 
    941941     case m of 

  • GHC/IO/Handle/Types.hs 

    diff -rN -u old-base/GHC/IO/Handle/Types.hs new-base/GHC/IO/Handle/Types.hs
    old new  
    170170isWritableHandleType _               = False 
    171171 
    172172isReadWriteHandleType :: HandleType -> Bool 
    173 isReadWriteHandleType ReadWriteHandle{} = True 
    174 isReadWriteHandleType _                 = False 
     173isReadWriteHandleType (ReadWriteHandle{}) = True 
     174isReadWriteHandleType _                   = False 
    175175 
    176176-- INVARIANTS on Handles: 
    177177-- 

  • GHC/IO/Handle.hs 

    diff -rN -u old-base/GHC/IO/Handle.hs new-base/GHC/IO/Handle.hs
    old new  
    108108 
    109109hFileSize :: Handle -> IO Integer 
    110110hFileSize handle = 
    111     withHandle_ "hFileSize" handle $ \ handle_@Handle__{haDevice=dev} -> do 
     111    withHandle_ "hFileSize" handle $ \ handle_@(Handle__{haDevice=dev}) -> do 
    112112    case haType handle_ of  
    113113      ClosedHandle              -> ioe_closedHandle 
    114114      SemiClosedHandle          -> ioe_closedHandle 
    … …  
    124124 
    125125hSetFileSize :: Handle -> Integer -> IO () 
    126126hSetFileSize handle size = 
    127     withHandle_ "hSetFileSize" handle $ \ handle_@Handle__{haDevice=dev} -> do 
     127    withHandle_ "hSetFileSize" handle $ \ handle_@(Handle__{haDevice=dev}) -> do 
    128128    case haType handle_ of  
    129129      ClosedHandle              -> ioe_closedHandle 
    130130      SemiClosedHandle          -> ioe_closedHandle 
    … …  
    189189 
    190190hSetBuffering :: Handle -> BufferMode -> IO () 
    191191hSetBuffering handle mode = 
    192   withAllHandles__ "hSetBuffering" handle $ \ handle_@Handle__{..} -> do 
     192  withAllHandles__ "hSetBuffering" handle $ \ handle_@(Handle__{..}) -> do 
    193193  case haType of 
    194194    ClosedHandle -> ioe_closedHandle 
    195195    _ -> do 
    … …  
    239239          -- throw away spare buffers, they might be the wrong size 
    240240          writeIORef haBuffers BufferListNil 
    241241 
    242           return Handle__{ haBufferMode = mode,.. } 
     242          return $ Handle__{ haBufferMode = mode,.. } 
    243243 
    244244-- ----------------------------------------------------------------------------- 
    245245-- hSetEncoding 
    … …  
    258258-- 
    259259hSetEncoding :: Handle -> TextEncoding -> IO () 
    260260hSetEncoding hdl encoding = do 
    261   withHandle "hSetEncoding" hdl $ \h_@Handle__{..} -> do 
     261  withHandle "hSetEncoding" hdl $ \h_@(Handle__{..}) -> do 
    262262    flushCharBuffer h_ 
    263263    openTextEncoding (Just encoding) haType $ \ mb_encoder mb_decoder -> do 
    264264    bbuf <- readIORef haByteBuffer 
    … …  
    280280-- 
    281281hGetEncoding :: Handle -> IO (Maybe TextEncoding) 
    282282hGetEncoding hdl = 
    283   withHandle_ "hGetEncoding" hdl $ \h_@Handle__{..} -> return haCodec 
     283  withHandle_ "hGetEncoding" hdl $ \h_@(Handle__{..}) -> return haCodec 
    284284 
    285285-- ----------------------------------------------------------------------------- 
    286286-- hFlush 
    … …  
    388388 
    389389hSeek :: Handle -> SeekMode -> Integer -> IO ()  
    390390hSeek handle mode offset = 
    391     wantSeekableHandle "hSeek" handle $ \ handle_@Handle__{..} -> do 
     391    wantSeekableHandle "hSeek" handle $ \ handle_@(Handle__{..}) -> do 
    392392    debugIO ("hSeek " ++ show (mode,offset)) 
    393393    buf <- readIORef haCharBuffer 
    394394 
    … …  
    400400    let r = bufL buf; w = bufR buf 
    401401    if mode == RelativeSeek && isNothing haDecoder &&  
    402402       offset >= 0 && offset < fromIntegral (w - r) 
    403         then writeIORef haCharBuffer buf{ bufL = r + fromIntegral offset } 
     403        then writeIORef haCharBuffer (buf{ bufL = r + fromIntegral offset }) 
    404404        else do  
    405405 
    406406    flushCharReadBuffer handle_ 
    … …  
    410410 
    411411hTell :: Handle -> IO Integer 
    412412hTell handle =  
    413     wantSeekableHandle "hGetPosn" handle $ \ handle_@Handle__{..} -> do 
     413    wantSeekableHandle "hGetPosn" handle $ \ handle_@(Handle__{..}) -> do 
    414414 
    415415      posn <- IODevice.tell haDevice 
    416416 
    … …  
    493493 
    494494hIsSeekable :: Handle -> IO Bool 
    495495hIsSeekable handle = 
    496     withHandle_ "hIsSeekable" handle $ \ handle_@Handle__{..} -> do 
     496    withHandle_ "hIsSeekable" handle $ \ handle_@(Handle__{..}) -> do 
    497497    case haType of  
    498498      ClosedHandle         -> ioe_closedHandle 
    499499      SemiClosedHandle     -> ioe_closedHandle 
    … …  
    511511    if not isT 
    512512     then return () 
    513513     else 
    514       withHandle_ "hSetEcho" handle $ \ Handle__{..} -> do 
     514      withHandle_ "hSetEcho" handle $ \(Handle__{..}) -> do 
    515515      case haType of  
    516516         ClosedHandle -> ioe_closedHandle 
    517517         _            -> IODevice.setEcho haDevice on 
    … …  
    524524    if not isT 
    525525     then return False 
    526526     else 
    527        withHandle_ "hGetEcho" handle $ \ Handle__{..} -> do 
     527       withHandle_ "hGetEcho" handle $ \(Handle__{..}) -> do 
    528528       case haType of  
    529529         ClosedHandle -> ioe_closedHandle 
    530530         _            -> IODevice.getEcho haDevice 
    … …  
    533533 
    534534hIsTerminalDevice :: Handle -> IO Bool 
    535535hIsTerminalDevice handle = do 
    536     withHandle_ "hIsTerminalDevice" handle $ \ Handle__{..} -> do 
     536    withHandle_ "hIsTerminalDevice" handle $ \(Handle__{..}) -> do 
    537537     case haType of  
    538538       ClosedHandle -> ioe_closedHandle 
    539539       _            -> IODevice.isTerminal haDevice 
    … …  
    549549-- 
    550550hSetBinaryMode :: Handle -> Bool -> IO () 
    551551hSetBinaryMode handle bin = 
    552   withAllHandles__ "hSetBinaryMode" handle $ \ h_@Handle__{..} -> 
     552  withAllHandles__ "hSetBinaryMode" handle $ \h_@(Handle__{..}) -> 
    553553    do  
    554554         flushBuffer h_ 
    555555 
    … …  
    565565         bbuf <- readIORef haByteBuffer 
    566566         ref <- newIORef (error "codec_state", bbuf) 
    567567 
    568          return Handle__{ haLastDecode = ref, 
    569                           haEncoder  = mb_encoder,  
    570                           haDecoder  = mb_decoder, 
    571                           haCodec    = mb_te, 
    572                           haInputNL  = inputNL nl, 
    573                           haOutputNL = outputNL nl, .. } 
     568         return $ Handle__{ haLastDecode = ref, 
     569                            haEncoder  = mb_encoder, 
     570                            haDecoder  = mb_decoder, 
     571                            haCodec    = mb_te, 
     572                            haInputNL  = inputNL nl, 
     573                            haOutputNL = outputNL nl, .. } 
    574574   
    575575-- ----------------------------------------------------------------------------- 
    576576-- hSetNewlineMode 
    … …  
    578578-- | Set the 'NewlineMode' on the specified 'Handle'.  All buffered 
    579579-- data is flushed first. 
    580580hSetNewlineMode :: Handle -> NewlineMode -> IO () 
    581 hSetNewlineMode handle NewlineMode{ inputNL=i, outputNL=o } = 
    582   withAllHandles__ "hSetNewlineMode" handle $ \h_@Handle__{..} -> 
     581hSetNewlineMode handle (NewlineMode{ inputNL=i, outputNL=o }) = 
     582  withAllHandles__ "hSetNewlineMode" handle $ \h_@(Handle__{..}) -> 
    583583    do 
    584584         flushBuffer h_ 
    585          return h_{ haInputNL=i, haOutputNL=o } 
     585         return $ h_{ haInputNL=i, haOutputNL=o } 
    586586 
    587587-- ----------------------------------------------------------------------------- 
    588588-- Duplicating a Handle 
    … …  
    611611          -> Handle__ 
    612612          -> Maybe HandleFinalizer 
    613613          -> IO Handle 
    614 dupHandle filepath h other_side h_@Handle__{..} mb_finalizer = do 
     614dupHandle filepath h other_side h_@(Handle__{..}) mb_finalizer = do 
    615615  -- flush the buffer first, so we don't have to copy its contents 
    616616  flushBuffer h_ 
    617617  case other_side of 
    … …  
    619619       new_dev <- IODevice.dup haDevice 
    620620       dupHandle_ new_dev filepath other_side h_ mb_finalizer 
    621621    Just r  ->  
    622        withHandle_' "dupHandle" h r $ \Handle__{haDevice=dev} -> do 
     622       withHandle_' "dupHandle" h r $ \(Handle__{haDevice=dev}) -> do 
    623623         dupHandle_ dev filepath other_side h_ mb_finalizer 
    624624 
    625625dupHandle_ :: (IODevice dev, BufferedIO dev, Typeable dev) => dev 
    … …  
    628628           -> Handle__ 
    629629           -> Maybe HandleFinalizer 
    630630           -> IO Handle 
    631 dupHandle_ new_dev filepath other_side h_@Handle__{..} mb_finalizer = do 
     631dupHandle_ new_dev filepath other_side h_@(Handle__{..}) mb_finalizer = do 
    632632   -- XXX wrong! 
    633633  let mb_codec = if isJust haEncoder then Just localeEncoding else Nothing 
    634634  mkHandle new_dev filepath haType True{-buffered-} mb_codec 
    635       NewlineMode { inputNL = haInputNL, outputNL = haOutputNL } 
     635      (NewlineMode { inputNL = haInputNL, outputNL = haOutputNL }) 
    636636      mb_finalizer other_side 
    637637 
    638638-- ----------------------------------------------------------------------------- 
    … …  
    680680            -> Maybe HandleFinalizer 
    681681            -> IO Handle__ 
    682682dupHandleTo filepath h other_side  
    683             hto_@Handle__{haDevice=devTo,..} 
    684             h_@Handle__{haDevice=dev} mb_finalizer = do 
     683            hto_@(Handle__{haDevice=devTo,..}) 
     684            h_@(Handle__{haDevice=dev}) mb_finalizer = do 
    685685  flushBuffer h_ 
    686686  case cast devTo of 
    687687    Nothing   -> ioe_dupHandlesNotCompatible h 

  • GHC/TopHandler.lhs 

    diff -rN -u old-base/GHC/TopHandler.lhs new-base/GHC/TopHandler.lhs
    old new  
    165165 
    166166           -- EPIPE errors received for stdout are ignored (#2699) 
    167167           _ -> case cast exn of 
    168                 Just IOError{ ioe_type = ResourceVanished, 
    169                               ioe_errno = Just ioe, 
    170                               ioe_handle = Just hdl } 
     168                Just (IOError{ ioe_type = ResourceVanished, 
     169                               ioe_errno = Just ioe, 
     170                               ioe_handle = Just hdl }) 
    171171                   | Errno ioe == ePIPE, hdl == stdout -> exit 0 
    172172                _ -> do reportError se 
    173173                        exit 1