compiler/iface/BinIface.hs

   1
   2 --
   3 --  (c) The University of Glasgow 2002-2006
   4 --
   5 -- Binary interface file support.
   6
   7 module BinIface ( writeBinIface, readBinIface,
   8                   CheckHiWay(..), TraceBinIFaceReading(..) ) where
   9
  10 #include "HsVersions.h"
  11
  12 import TcRnMonad
  13 import IfaceEnv
  14 import HscTypes
  15 import BasicTypes
  16 import NewDemand
  17 import IfaceSyn
  18 import Module
  19 import Name
  20 import OccName
  21 import VarEnv
  22 import InstEnv
  23 import Class
  24 import DynFlags
  25 import UniqFM
  26 import UniqSupply
  27 import CostCentre
  28 import StaticFlags
  29 import Panic
  30 import Binary
  31 import SrcLoc
  32 import ErrUtils
  33 import Config
  34 import FastMutInt
  35 import Unique
  36 import Outputable
  37 import FastString
  38
  39 import Data.List
  40 import Data.Word
  41 import Data.Array
  42 import Data.IORef
  43 import Control.Exception
  44 import Control.Monad
  45
  46 data CheckHiWay = CheckHiWay | IgnoreHiWay
  47     deriving Eq
  48
  49 data TraceBinIFaceReading = TraceBinIFaceReading | QuietBinIFaceReading
  50     deriving Eq
  51
  52 -- ---------------------------------------------------------------------------
  53 -- Reading and writing binary interface files
  54
  55 readBinIface :: CheckHiWay -> TraceBinIFaceReading -> FilePath
  56              -> TcRnIf a b ModIface
  57 readBinIface checkHiWay traceBinIFaceReading hi_path = do
  58   nc <- getNameCache
  59   (new_nc, iface) <- liftIO $
  60     readBinIface_ checkHiWay traceBinIFaceReading hi_path nc
  61   setNameCache new_nc
  62   return iface
  63
  64 readBinIface_ :: CheckHiWay -> TraceBinIFaceReading -> FilePath -> NameCache
  65               -> IO (NameCache, ModIface)
  66 readBinIface_ checkHiWay traceBinIFaceReading hi_path nc = do
  67   let printer :: SDoc -> IO ()
  68       printer = case traceBinIFaceReading of
  69                 TraceBinIFaceReading -> \sd -> printSDoc sd defaultDumpStyle
  70                 QuietBinIFaceReading -> \_ -> return ()
  71       wantedGot :: Outputable a => String -> a -> a -> IO ()
  72       wantedGot what wanted got
  73           = printer (text what <> text ": " <>
  74                      vcat [text "Wanted " <> ppr wanted <> text ",",
  75                            text "got    " <> ppr got])
  76       errorOnMismatch :: (Eq a, Show a) => String -> a -> a -> IO ()
  77       errorOnMismatch what wanted got
  78             -- This will be caught by readIface which will emit an error
  79             -- msg containing the iface module name.
  80           = when (wanted /= got) $ throwDyn $ ProgramError
  81                         (what ++ " (wanted " ++ show wanted
  82                               ++ ", got "    ++ show got ++ ")")
  83   bh <- Binary.readBinMem hi_path
  84
  85         -- Read the magic number to check that this really is a GHC .hi file
  86         -- (This magic number does not change when we change
  87         --  GHC interface file format)
  88   magic <- get bh
  89   wantedGot "Magic" binaryInterfaceMagic magic
  90   errorOnMismatch "magic number mismatch: old/corrupt interface file?"
  91       binaryInterfaceMagic magic
  92
  93         -- Get the dictionary pointer.  We won't attempt to actually
  94         -- read the dictionary until we've done the version checks below,
  95         -- just in case this isn't a valid interface.  In retrospect the
  96         -- version should have come before the dictionary pointer, but this
  97         -- is the way it was done originally, and we can't change it now.
  98   dict_p <- Binary.get bh       -- Get the dictionary ptr
  99
 100         -- Check the interface file version and ways.
 101   check_ver  <- get bh
 102   let our_ver = show opt_HiVersion
 103   wantedGot "Version" our_ver check_ver
 104   errorOnMismatch "mismatched interface file versions" our_ver check_ver
 105
 106   check_way <- get bh
 107   way_descr <- getWayDescr
 108   wantedGot "Way" way_descr check_way
 109   when (checkHiWay == CheckHiWay) $
 110        errorOnMismatch "mismatched interface file ways" way_descr check_way
 111
 112         -- Read the dictionary
 113         -- The next word in the file is a pointer to where the dictionary is
 114         -- (probably at the end of the file)
 115   data_p <- tellBin bh          -- Remember where we are now
 116   seekBin bh dict_p
 117   dict <- getDictionary bh
 118   seekBin bh data_p             -- Back to where we were before
 119
 120         -- Initialise the user-data field of bh
 121   ud <- newReadState dict
 122   bh <- return (setUserData bh ud)
 123
 124   symtab_p <- Binary.get bh     -- Get the symtab ptr
 125   data_p <- tellBin bh          -- Remember where we are now
 126   seekBin bh symtab_p
 127   (nc', symtab) <- getSymbolTable bh nc
 128   seekBin bh data_p             -- Back to where we were before
 129   let ud = getUserData bh
 130   bh <- return $! setUserData bh ud{ud_symtab = symtab}
 131   iface <- get bh
 132   return (nc', iface)
 133
 134
 135 writeBinIface :: DynFlags -> FilePath -> ModIface -> IO ()
 136 writeBinIface dflags hi_path mod_iface = do
 137   bh <- openBinMem initBinMemSize
 138   put_ bh binaryInterfaceMagic
 139
 140         -- Remember where the dictionary pointer will go
 141   dict_p_p <- tellBin bh
 142   put_ bh dict_p_p      -- Placeholder for ptr to dictionary
 143
 144         -- The version and way descriptor go next
 145   put_ bh (show opt_HiVersion)
 146   way_descr <- getWayDescr
 147   put  bh way_descr
 148
 149         -- Remember where the symbol table pointer will go
 150   symtab_p_p <- tellBin bh
 151   put_ bh symtab_p_p
 152
 153         -- Make some intial state
 154   symtab_next <- newFastMutInt
 155   writeFastMutInt symtab_next 0
 156   symtab_map <- newIORef emptyUFM
 157   let bin_symtab = BinSymbolTable {
 158                       bin_symtab_next = symtab_next,
 159                       bin_symtab_map  = symtab_map }
 160   dict_next_ref <- newFastMutInt
 161   writeFastMutInt dict_next_ref 0
 162   dict_map_ref <- newIORef emptyUFM
 163   let bin_dict = BinDictionary {
 164                       bin_dict_next = dict_next_ref,
 165                       bin_dict_map  = dict_map_ref }
 166   ud <- newWriteState (putName bin_symtab) (putFastString bin_dict)
 167
 168         -- Put the main thing,
 169   bh <- return $ setUserData bh ud
 170   put_ bh mod_iface
 171
 172         -- Write the symtab pointer at the fornt of the file
 173   symtab_p <- tellBin bh                -- This is where the symtab will start
 174   putAt bh symtab_p_p symtab_p  -- Fill in the placeholder
 175   seekBin bh symtab_p           -- Seek back to the end of the file
 176
 177         -- Write the symbol table itself
 178   symtab_next <- readFastMutInt symtab_next
 179   symtab_map  <- readIORef symtab_map
 180   putSymbolTable bh symtab_next symtab_map
 181   debugTraceMsg dflags 3 (text "writeBinIface:" <+> int symtab_next
 182                                 <+> text "Names")
 183
 184         -- NB. write the dictionary after the symbol table, because
 185         -- writing the symbol table may create more dictionary entries.
 186
 187         -- Write the dictionary pointer at the fornt of the file
 188   dict_p <- tellBin bh          -- This is where the dictionary will start
 189   putAt bh dict_p_p dict_p      -- Fill in the placeholder
 190   seekBin bh dict_p             -- Seek back to the end of the file
 191
 192         -- Write the dictionary itself
 193   dict_next <- readFastMutInt dict_next_ref
 194   dict_map  <- readIORef dict_map_ref
 195   putDictionary bh dict_next dict_map
 196   debugTraceMsg dflags 3 (text "writeBinIface:" <+> int dict_next
 197                                  <+> text "dict entries")
 198
 199         -- And send the result to the file
 200   writeBinMem bh hi_path
 201
 202 initBinMemSize :: Int
 203 initBinMemSize = 1024 * 1024
 204
 205 -- The *host* architecture version:
 206 #include "MachDeps.h"
 207
 208 binaryInterfaceMagic :: Word32
 209 #if   WORD_SIZE_IN_BITS == 32
 210 binaryInterfaceMagic = 0x1face
 211 #elif WORD_SIZE_IN_BITS == 64
 212 binaryInterfaceMagic = 0x1face64
 213 #endif
 214
 215 -- -----------------------------------------------------------------------------
 216 -- The symbol table
 217
 218 putSymbolTable :: BinHandle -> Int -> UniqFM (Int,Name) -> IO ()
 219 putSymbolTable bh next_off symtab = do
 220   put_ bh next_off
 221   let names = elems (array (0,next_off-1) (eltsUFM symtab))
 222   mapM_ (\n -> serialiseName bh n symtab) names
 223
 224 getSymbolTable :: BinHandle -> NameCache -> IO (NameCache, Array Int Name)
 225 getSymbolTable bh namecache = do
 226   sz <- get bh
 227   od_names <- sequence (replicate sz (get bh))
 228   let
 229         arr = listArray (0,sz-1) names
 230         (namecache', names) =
 231                 mapAccumR (fromOnDiskName arr) namecache od_names
 232   --
 233   return (namecache', arr)
 234
 235 type OnDiskName = (PackageId, ModuleName, OccName)
 236
 237 fromOnDiskName
 238    :: Array Int Name
 239    -> NameCache
 240    -> OnDiskName
 241    -> (NameCache, Name)
 242 fromOnDiskName _ nc (pid, mod_name, occ) =
 243   let
 244         mod   = mkModule pid mod_name
 245         cache = nsNames nc
 246   in
 247   case lookupOrigNameCache cache  mod occ of
 248      Just name -> (nc, name)
 249      Nothing   ->
 250         let
 251                 us        = nsUniqs nc
 252                 uniq      = uniqFromSupply us
 253                 name      = mkExternalName uniq mod occ noSrcSpan
 254                 new_cache = extendNameCache cache mod occ name
 255         in
 256         case splitUniqSupply us of { (us',_) ->
 257         ( nc{ nsUniqs = us', nsNames = new_cache }, name )
 258         }
 259
 260 serialiseName :: BinHandle -> Name -> UniqFM (Int,Name) -> IO ()
 261 serialiseName bh name _ = do
 262   let mod = nameModule name
 263   put_ bh (modulePackageId mod, moduleName mod, nameOccName name)
 264
 265
 266 putName :: BinSymbolTable -> BinHandle -> Name -> IO ()
 267 putName BinSymbolTable{
 268             bin_symtab_map = symtab_map_ref,
 269             bin_symtab_next = symtab_next }    bh name
 270   = do
 271     symtab_map <- readIORef symtab_map_ref
 272     case lookupUFM symtab_map name of
 273       Just (off,_) -> put_ bh off
 274       Nothing -> do
 275          off <- readFastMutInt symtab_next
 276          writeFastMutInt symtab_next (off+1)
 277          writeIORef symtab_map_ref
 278              $! addToUFM symtab_map name (off,name)
 279          put_ bh off
 280
 281
 282 data BinSymbolTable = BinSymbolTable {
 283         bin_symtab_next :: !FastMutInt, -- The next index to use
 284         bin_symtab_map  :: !(IORef (UniqFM (Int,Name)))
 285                                 -- indexed by Name
 286   }
 287
 288
 289 putFastString :: BinDictionary -> BinHandle -> FastString -> IO ()
 290 putFastString BinDictionary { bin_dict_next = j_r,
 291                               bin_dict_map  = out_r}  bh f
 292   = do
 293     out <- readIORef out_r
 294     let uniq = getUnique f
 295     case lookupUFM out uniq of
 296         Just (j, _)  -> put_ bh j
 297         Nothing -> do
 298            j <- readFastMutInt j_r
 299            put_ bh j
 300            writeFastMutInt j_r (j + 1)
 301            writeIORef out_r $! addToUFM out uniq (j, f)
 302
 303
 304 data BinDictionary = BinDictionary {
 305         bin_dict_next :: !FastMutInt, -- The next index to use
 306         bin_dict_map  :: !(IORef (UniqFM (Int,FastString)))
 307                                 -- indexed by FastString
 308   }
 309
 310 -- -----------------------------------------------------------------------------
 311 -- All the binary instances
 312
 313 -- BasicTypes
 314 {-! for IPName derive: Binary !-}
 315 {-! for Fixity derive: Binary !-}
 316 {-! for FixityDirection derive: Binary !-}
 317 {-! for Boxity derive: Binary !-}
 318 {-! for StrictnessMark derive: Binary !-}
 319 {-! for Activation derive: Binary !-}
 320
 321 -- NewDemand
 322 {-! for Demand derive: Binary !-}
 323 {-! for Demands derive: Binary !-}
 324 {-! for DmdResult derive: Binary !-}
 325 {-! for StrictSig derive: Binary !-}
 326
 327 -- Class
 328 {-! for DefMeth derive: Binary !-}
 329
 330 -- HsTypes
 331 {-! for HsPred derive: Binary !-}
 332 {-! for HsType derive: Binary !-}
 333 {-! for TupCon derive: Binary !-}
 334 {-! for HsTyVarBndr derive: Binary !-}
 335
 336 -- HsCore
 337 {-! for UfExpr derive: Binary !-}
 338 {-! for UfConAlt derive: Binary !-}
 339 {-! for UfBinding derive: Binary !-}
 340 {-! for UfBinder derive: Binary !-}
 341 {-! for HsIdInfo derive: Binary !-}
 342 {-! for UfNote derive: Binary !-}
 343
 344 -- HsDecls
 345 {-! for ConDetails derive: Binary !-}
 346 {-! for BangType derive: Binary !-}
 347
 348 -- CostCentre
 349 {-! for IsCafCC derive: Binary !-}
 350 {-! for IsDupdCC derive: Binary !-}
 351 {-! for CostCentre derive: Binary !-}
 352
 353
 354
 355 -- ---------------------------------------------------------------------------
 356 -- Reading a binary interface into ParsedIface
 357
 358 instance Binary ModIface where
 359    put_ bh (ModIface {
 360                  mi_module    = mod,
 361                  mi_boot      = is_boot,
 362                  mi_iface_hash= iface_hash,
 363                  mi_mod_hash  = mod_hash,
 364                  mi_orphan    = orphan,
 365                  mi_finsts    = hasFamInsts,
 366                  mi_deps      = deps,
 367                  mi_usages    = usages,
 368                  mi_exports   = exports,
 369                  mi_exp_hash  = exp_hash,
 370                  mi_fixities  = fixities,
 371                  mi_deprecs   = deprecs,
 372                  mi_decls     = decls,
 373                  mi_insts     = insts,
 374                  mi_fam_insts = fam_insts,
 375                  mi_rules     = rules,
 376                  mi_orphan_hash = orphan_hash,
 377                  mi_vect_info = vect_info,
 378                  mi_hpc       = hpc_info }) = do
 379         put_ bh mod
 380         put_ bh is_boot
 381         put_ bh iface_hash
 382         put_ bh mod_hash
 383         put_ bh orphan
 384         put_ bh hasFamInsts
 385         lazyPut bh deps
 386         lazyPut bh usages
 387         put_ bh exports
 388         put_ bh exp_hash
 389         put_ bh fixities
 390         lazyPut bh deprecs
 391         put_ bh decls
 392         put_ bh insts
 393         put_ bh fam_insts
 394         lazyPut bh rules
 395         put_ bh orphan_hash
 396         put_ bh vect_info
 397         put_ bh hpc_info
 398
 399    get bh = do
 400         mod_name  <- get bh
 401         is_boot   <- get bh
 402         iface_hash <- get bh
 403         mod_hash  <- get bh
 404         orphan    <- get bh
 405         hasFamInsts <- get bh
 406         deps      <- lazyGet bh
 407         usages    <- {-# SCC "bin_usages" #-} lazyGet bh
 408         exports   <- {-# SCC "bin_exports" #-} get bh
 409         exp_hash  <- get bh
 410         fixities  <- {-# SCC "bin_fixities" #-} get bh
 411         deprecs   <- {-# SCC "bin_deprecs" #-} lazyGet bh
 412         decls     <- {-# SCC "bin_tycldecls" #-} get bh
 413         insts     <- {-# SCC "bin_insts" #-} get bh
 414         fam_insts <- {-# SCC "bin_fam_insts" #-} get bh
 415         rules     <- {-# SCC "bin_rules" #-} lazyGet bh
 416         orphan_hash <- get bh
 417         vect_info <- get bh
 418         hpc_info  <- get bh
 419         return (ModIface {
 420                  mi_module    = mod_name,
 421                  mi_boot      = is_boot,
 422                  mi_iface_hash = iface_hash,
 423                  mi_mod_hash  = mod_hash,
 424                  mi_orphan    = orphan,
 425                  mi_finsts    = hasFamInsts,
 426                  mi_deps      = deps,
 427                  mi_usages    = usages,
 428                  mi_exports   = exports,
 429                  mi_exp_hash  = exp_hash,
 430                  mi_fixities  = fixities,
 431                  mi_deprecs   = deprecs,
 432                  mi_decls     = decls,
 433                  mi_globals   = Nothing,
 434                  mi_insts     = insts,
 435                  mi_fam_insts = fam_insts,
 436                  mi_rules     = rules,
 437                  mi_orphan_hash = orphan_hash,
 438                  mi_vect_info = vect_info,
 439                  mi_hpc       = hpc_info,
 440                         -- And build the cached values
 441                  mi_dep_fn    = mkIfaceDepCache deprecs,
 442                  mi_fix_fn    = mkIfaceFixCache fixities,
 443                  mi_hash_fn   = mkIfaceHashCache decls })
 444
 445 getWayDescr :: IO String
 446 getWayDescr = do
 447   tag <- readIORef v_Build_tag
 448   if cGhcUnregisterised == "YES" then return ('u':tag) else return tag
 449         -- if this is an unregisterised build, make sure our interfaces
 450         -- can't be used by a registerised build.
 451
 452 -------------------------------------------------------------------------
 453 --              Types from: HscTypes
 454 -------------------------------------------------------------------------
 455
 456 instance Binary Dependencies where
 457     put_ bh deps = do put_ bh (dep_mods deps)
 458                       put_ bh (dep_pkgs deps)
 459                       put_ bh (dep_orphs deps)
 460                       put_ bh (dep_finsts deps)
 461
 462     get bh = do ms <- get bh
 463                 ps <- get bh
 464                 os <- get bh
 465                 fis <- get bh
 466                 return (Deps { dep_mods = ms, dep_pkgs = ps, dep_orphs = os,
 467                                dep_finsts = fis })
 468
 469 instance (Binary name) => Binary (GenAvailInfo name) where
 470     put_ bh (Avail aa) = do
 471             putByte bh 0
 472             put_ bh aa
 473     put_ bh (AvailTC ab ac) = do
 474             putByte bh 1
 475             put_ bh ab
 476             put_ bh ac
 477     get bh = do
 478             h <- getByte bh
 479             case h of
 480               0 -> do aa <- get bh
 481                       return (Avail aa)
 482               _ -> do ab <- get bh
 483                       ac <- get bh
 484                       return (AvailTC ab ac)
 485
 486 instance Binary Usage where
 487     put_ bh usg@UsagePackageModule{} = do
 488         putByte bh 0
 489         put_ bh (usg_mod usg)
 490         put_ bh (usg_mod_hash usg)
 491     put_ bh usg@UsageHomeModule{} = do
 492         putByte bh 1
 493         put_ bh (usg_mod_name usg)
 494         put_ bh (usg_mod_hash usg)
 495         put_ bh (usg_exports  usg)
 496         put_ bh (usg_entities usg)
 497
 498     get bh = do
 499         h <- getByte bh
 500         case h of
 501           0 -> do
 502             nm    <- get bh
 503             mod   <- get bh
 504             return UsagePackageModule { usg_mod = nm, usg_mod_hash = mod }
 505           _ -> do
 506             nm    <- get bh
 507             mod   <- get bh
 508             exps  <- get bh
 509             ents  <- get bh
 510             return UsageHomeModule { usg_mod_name = nm, usg_mod_hash = mod,
 511                             usg_exports = exps, usg_entities = ents }
 512
 513 instance Binary Deprecations where
 514     put_ bh NoDeprecs     = putByte bh 0
 515     put_ bh (DeprecAll t) = do
 516             putByte bh 1
 517             put_ bh t
 518     put_ bh (DeprecSome ts) = do
 519             putByte bh 2
 520             put_ bh ts
 521
 522     get bh = do
 523             h <- getByte bh
 524             case h of
 525               0 -> return NoDeprecs
 526               1 -> do aa <- get bh
 527                       return (DeprecAll aa)
 528               _ -> do aa <- get bh
 529                       return (DeprecSome aa)
 530
 531 -------------------------------------------------------------------------
 532 --              Types from: BasicTypes
 533 -------------------------------------------------------------------------
 534
 535 instance Binary Activation where
 536     put_ bh NeverActive = do
 537             putByte bh 0
 538     put_ bh AlwaysActive = do
 539             putByte bh 1
 540     put_ bh (ActiveBefore aa) = do
 541             putByte bh 2
 542             put_ bh aa
 543     put_ bh (ActiveAfter ab) = do
 544             putByte bh 3
 545             put_ bh ab
 546     get bh = do
 547             h <- getByte bh
 548             case h of
 549               0 -> do return NeverActive
 550               1 -> do return AlwaysActive
 551               2 -> do aa <- get bh
 552                       return (ActiveBefore aa)
 553               _ -> do ab <- get bh
 554                       return (ActiveAfter ab)
 555
 556 instance Binary StrictnessMark where
 557     put_ bh MarkedStrict = do
 558             putByte bh 0
 559     put_ bh MarkedUnboxed = do
 560             putByte bh 1
 561     put_ bh NotMarkedStrict = do
 562             putByte bh 2
 563     get bh = do
 564             h <- getByte bh
 565             case h of
 566               0 -> do return MarkedStrict
 567               1 -> do return MarkedUnboxed
 568               _ -> do return NotMarkedStrict
 569
 570 instance Binary Boxity where
 571     put_ bh Boxed = do
 572             putByte bh 0
 573     put_ bh Unboxed = do
 574             putByte bh 1
 575     get bh = do
 576             h <- getByte bh
 577             case h of
 578               0 -> do return Boxed
 579               _ -> do return Unboxed
 580
 581 instance Binary TupCon where
 582     put_ bh (TupCon ab ac) = do
 583             put_ bh ab
 584             put_ bh ac
 585     get bh = do
 586           ab <- get bh
 587           ac <- get bh
 588           return (TupCon ab ac)
 589
 590 instance Binary RecFlag where
 591     put_ bh Recursive = do
 592             putByte bh 0
 593     put_ bh NonRecursive = do
 594             putByte bh 1
 595     get bh = do
 596             h <- getByte bh
 597             case h of
 598               0 -> do return Recursive
 599               _ -> do return NonRecursive
 600
 601 instance Binary DefMeth where
 602     put_ bh NoDefMeth  = putByte bh 0
 603     put_ bh DefMeth    = putByte bh 1
 604     put_ bh GenDefMeth = putByte bh 2
 605     get bh = do
 606             h <- getByte bh
 607             case h of
 608               0 -> return NoDefMeth
 609               1 -> return DefMeth
 610               _ -> return GenDefMeth
 611
 612 instance Binary FixityDirection where
 613     put_ bh InfixL = do
 614             putByte bh 0
 615     put_ bh InfixR = do
 616             putByte bh 1
 617     put_ bh InfixN = do
 618             putByte bh 2
 619     get bh = do
 620             h <- getByte bh
 621             case h of
 622               0 -> do return InfixL
 623               1 -> do return InfixR
 624               _ -> do return InfixN
 625
 626 instance Binary Fixity where
 627     put_ bh (Fixity aa ab) = do
 628             put_ bh aa
 629             put_ bh ab
 630     get bh = do
 631           aa <- get bh
 632           ab <- get bh
 633           return (Fixity aa ab)
 634
 635 instance (Binary name) => Binary (IPName name) where
 636     put_ bh (IPName aa) = put_ bh aa
 637     get bh = do aa <- get bh
 638                 return (IPName aa)
 639
 640 -------------------------------------------------------------------------
 641 --              Types from: Demand
 642 -------------------------------------------------------------------------
 643
 644 instance Binary DmdType where
 645         -- Ignore DmdEnv when spitting out the DmdType
 646   put bh (DmdType _ ds dr) = do p <- put bh ds; put bh dr; return (castBin p)
 647   get bh = do ds <- get bh; dr <- get bh; return (DmdType emptyVarEnv ds dr)
 648
 649 instance Binary Demand where
 650     put_ bh Top = do
 651             putByte bh 0
 652     put_ bh Abs = do
 653             putByte bh 1
 654     put_ bh (Call aa) = do
 655             putByte bh 2
 656             put_ bh aa
 657     put_ bh (Eval ab) = do
 658             putByte bh 3
 659             put_ bh ab
 660     put_ bh (Defer ac) = do
 661             putByte bh 4
 662             put_ bh ac
 663     put_ bh (Box ad) = do
 664             putByte bh 5
 665             put_ bh ad
 666     put_ bh Bot = do
 667             putByte bh 6
 668     get bh = do
 669             h <- getByte bh
 670             case h of
 671               0 -> do return Top
 672               1 -> do return Abs
 673               2 -> do aa <- get bh
 674                       return (Call aa)
 675               3 -> do ab <- get bh
 676                       return (Eval ab)
 677               4 -> do ac <- get bh
 678                       return (Defer ac)
 679               5 -> do ad <- get bh
 680                       return (Box ad)
 681               _ -> do return Bot
 682
 683 instance Binary Demands where
 684     put_ bh (Poly aa) = do
 685             putByte bh 0
 686             put_ bh aa
 687     put_ bh (Prod ab) = do
 688             putByte bh 1
 689             put_ bh ab
 690     get bh = do
 691             h <- getByte bh
 692             case h of
 693               0 -> do aa <- get bh
 694                       return (Poly aa)
 695               _ -> do ab <- get bh
 696                       return (Prod ab)
 697
 698 instance Binary DmdResult where
 699     put_ bh TopRes = do
 700             putByte bh 0
 701     put_ bh RetCPR = do
 702             putByte bh 1
 703     put_ bh BotRes = do
 704             putByte bh 2
 705     get bh = do
 706             h <- getByte bh
 707             case h of
 708               0 -> do return TopRes
 709               1 -> do return RetCPR     -- Really use RetCPR even if -fcpr-off
 710                                         -- The wrapper was generated for CPR in
 711                                         -- the imported module!
 712               _ -> do return BotRes
 713
 714 instance Binary StrictSig where
 715     put_ bh (StrictSig aa) = do
 716             put_ bh aa
 717     get bh = do
 718           aa <- get bh
 719           return (StrictSig aa)
 720
 721
 722 -------------------------------------------------------------------------
 723 --              Types from: CostCentre
 724 -------------------------------------------------------------------------
 725
 726 instance Binary IsCafCC where
 727     put_ bh CafCC = do
 728             putByte bh 0
 729     put_ bh NotCafCC = do
 730             putByte bh 1
 731     get bh = do
 732             h <- getByte bh
 733             case h of
 734               0 -> do return CafCC
 735               _ -> do return NotCafCC
 736
 737 instance Binary IsDupdCC where
 738     put_ bh OriginalCC = do
 739             putByte bh 0
 740     put_ bh DupdCC = do
 741             putByte bh 1
 742     get bh = do
 743             h <- getByte bh
 744             case h of
 745               0 -> do return OriginalCC
 746               _ -> do return DupdCC
 747
 748 instance Binary CostCentre where
 749     put_ bh NoCostCentre = do
 750             putByte bh 0
 751     put_ bh (NormalCC aa ab ac ad) = do
 752             putByte bh 1
 753             put_ bh aa
 754             put_ bh ab
 755             put_ bh ac
 756             put_ bh ad
 757     put_ bh (AllCafsCC ae) = do
 758             putByte bh 2
 759             put_ bh ae
 760     get bh = do
 761             h <- getByte bh
 762             case h of
 763               0 -> do return NoCostCentre
 764               1 -> do aa <- get bh
 765                       ab <- get bh
 766                       ac <- get bh
 767                       ad <- get bh
 768                       return (NormalCC aa ab ac ad)
 769               _ -> do ae <- get bh
 770                       return (AllCafsCC ae)
 771
 772 -------------------------------------------------------------------------
 773 --              IfaceTypes and friends
 774 -------------------------------------------------------------------------
 775
 776 instance Binary IfaceBndr where
 777     put_ bh (IfaceIdBndr aa) = do
 778             putByte bh 0
 779             put_ bh aa
 780     put_ bh (IfaceTvBndr ab) = do
 781             putByte bh 1
 782             put_ bh ab
 783     get bh = do
 784             h <- getByte bh
 785             case h of
 786               0 -> do aa <- get bh
 787                       return (IfaceIdBndr aa)
 788               _ -> do ab <- get bh
 789                       return (IfaceTvBndr ab)
 790
 791 instance Binary IfaceLetBndr where
 792     put_ bh (IfLetBndr a b c) = do
 793             put_ bh a
 794             put_ bh b
 795             put_ bh c
 796     get bh = do a <- get bh
 797                 b <- get bh
 798                 c <- get bh
 799                 return (IfLetBndr a b c)
 800
 801 instance Binary IfaceType where
 802     put_ bh (IfaceForAllTy aa ab) = do
 803             putByte bh 0
 804             put_ bh aa
 805             put_ bh ab
 806     put_ bh (IfaceTyVar ad) = do
 807             putByte bh 1
 808             put_ bh ad
 809     put_ bh (IfaceAppTy ae af) = do
 810             putByte bh 2
 811             put_ bh ae
 812             put_ bh af
 813     put_ bh (IfaceFunTy ag ah) = do
 814             putByte bh 3
 815             put_ bh ag
 816             put_ bh ah
 817     put_ bh (IfacePredTy aq) = do
 818             putByte bh 5
 819             put_ bh aq
 820
 821         -- Simple compression for common cases of TyConApp
 822     put_ bh (IfaceTyConApp IfaceIntTc  [])   = putByte bh 6
 823     put_ bh (IfaceTyConApp IfaceCharTc [])   = putByte bh 7
 824     put_ bh (IfaceTyConApp IfaceBoolTc [])   = putByte bh 8
 825     put_ bh (IfaceTyConApp IfaceListTc [ty]) = do { putByte bh 9; put_ bh ty }
 826         -- Unit tuple and pairs
 827     put_ bh (IfaceTyConApp (IfaceTupTc Boxed 0) [])      = putByte bh 10
 828     put_ bh (IfaceTyConApp (IfaceTupTc Boxed 2) [t1,t2]) = do { putByte bh 11; put_ bh t1; put_ bh t2 }
 829         -- Kind cases
 830     put_ bh (IfaceTyConApp IfaceLiftedTypeKindTc [])   = putByte bh 12
 831     put_ bh (IfaceTyConApp IfaceOpenTypeKindTc [])     = putByte bh 13
 832     put_ bh (IfaceTyConApp IfaceUnliftedTypeKindTc []) = putByte bh 14
 833     put_ bh (IfaceTyConApp IfaceUbxTupleKindTc [])     = putByte bh 15
 834     put_ bh (IfaceTyConApp IfaceArgTypeKindTc [])      = putByte bh 16
 835
 836         -- Generic cases
 837
 838     put_ bh (IfaceTyConApp (IfaceTc tc) tys) = do { putByte bh 18; put_ bh tc; put_ bh tys }
 839     put_ bh (IfaceTyConApp tc tys)           = do { putByte bh 19; put_ bh tc; put_ bh tys }
 840
 841     get bh = do
 842             h <- getByte bh
 843             case h of
 844               0 -> do aa <- get bh
 845                       ab <- get bh
 846                       return (IfaceForAllTy aa ab)
 847               1 -> do ad <- get bh
 848                       return (IfaceTyVar ad)
 849               2 -> do ae <- get bh
 850                       af <- get bh
 851                       return (IfaceAppTy ae af)
 852               3 -> do ag <- get bh
 853                       ah <- get bh
 854                       return (IfaceFunTy ag ah)
 855               5 -> do ap <- get bh
 856                       return (IfacePredTy ap)
 857
 858                 -- Now the special cases for TyConApp
 859               6 -> return (IfaceTyConApp IfaceIntTc [])
 860               7 -> return (IfaceTyConApp IfaceCharTc [])
 861               8 -> return (IfaceTyConApp IfaceBoolTc [])
 862               9 -> do { ty <- get bh; return (IfaceTyConApp IfaceListTc [ty]) }
 863               10 -> return (IfaceTyConApp (IfaceTupTc Boxed 0) [])
 864               11 -> do { t1 <- get bh; t2 <- get bh; return (IfaceTyConApp (IfaceTupTc Boxed 2) [t1,t2]) }
 865               12 -> return (IfaceTyConApp IfaceLiftedTypeKindTc [])
 866               13 -> return (IfaceTyConApp IfaceOpenTypeKindTc [])
 867               14 -> return (IfaceTyConApp IfaceUnliftedTypeKindTc [])
 868               15 -> return (IfaceTyConApp IfaceUbxTupleKindTc [])
 869               16 -> return (IfaceTyConApp IfaceArgTypeKindTc [])
 870
 871               18 -> do { tc <- get bh; tys <- get bh; return (IfaceTyConApp (IfaceTc tc) tys) }
 872               _  -> do { tc <- get bh; tys <- get bh; return (IfaceTyConApp tc tys) }
 873
 874 instance Binary IfaceTyCon where
 875         -- Int,Char,Bool can't show up here because they can't not be saturated
 876
 877    put_ bh IfaceIntTc         = putByte bh 1
 878    put_ bh IfaceBoolTc        = putByte bh 2
 879    put_ bh IfaceCharTc        = putByte bh 3
 880    put_ bh IfaceListTc        = putByte bh 4
 881    put_ bh IfacePArrTc        = putByte bh 5
 882    put_ bh IfaceLiftedTypeKindTc   = putByte bh 6
 883    put_ bh IfaceOpenTypeKindTc     = putByte bh 7
 884    put_ bh IfaceUnliftedTypeKindTc = putByte bh 8
 885    put_ bh IfaceUbxTupleKindTc     = putByte bh 9
 886    put_ bh IfaceArgTypeKindTc      = putByte bh 10
 887    put_ bh (IfaceTupTc bx ar) = do { putByte bh 11; put_ bh bx; put_ bh ar }
 888    put_ bh (IfaceTc ext)      = do { putByte bh 12; put_ bh ext }
 889
 890    get bh = do
 891         h <- getByte bh
 892         case h of
 893           1 -> return IfaceIntTc
 894           2 -> return IfaceBoolTc
 895           3 -> return IfaceCharTc
 896           4 -> return IfaceListTc
 897           5 -> return IfacePArrTc
 898           6 -> return IfaceLiftedTypeKindTc
 899           7 -> return IfaceOpenTypeKindTc
 900           8 -> return IfaceUnliftedTypeKindTc
 901           9 -> return IfaceUbxTupleKindTc
 902           10 -> return IfaceArgTypeKindTc
 903           11 -> do { bx <- get bh; ar <- get bh; return (IfaceTupTc bx ar) }
 904           _ -> do { ext <- get bh; return (IfaceTc ext) }
 905
 906 instance Binary IfacePredType where
 907     put_ bh (IfaceClassP aa ab) = do
 908             putByte bh 0
 909             put_ bh aa
 910             put_ bh ab
 911     put_ bh (IfaceIParam ac ad) = do
 912             putByte bh 1
 913             put_ bh ac
 914             put_ bh ad
 915     put_ bh (IfaceEqPred ac ad) = do
 916             putByte bh 2
 917             put_ bh ac
 918             put_ bh ad
 919     get bh = do
 920             h <- getByte bh
 921             case h of
 922               0 -> do aa <- get bh
 923                       ab <- get bh
 924                       return (IfaceClassP aa ab)
 925               1 -> do ac <- get bh
 926                       ad <- get bh
 927                       return (IfaceIParam ac ad)
 928               2 -> do ac <- get bh
 929                       ad <- get bh
 930                       return (IfaceEqPred ac ad)
 931               _ -> panic ("get IfacePredType " ++ show h)
 932
 933 -------------------------------------------------------------------------
 934 --              IfaceExpr and friends
 935 -------------------------------------------------------------------------
 936
 937 instance Binary IfaceExpr where
 938     put_ bh (IfaceLcl aa) = do
 939             putByte bh 0
 940             put_ bh aa
 941     put_ bh (IfaceType ab) = do
 942             putByte bh 1
 943             put_ bh ab
 944     put_ bh (IfaceTuple ac ad) = do
 945             putByte bh 2
 946             put_ bh ac
 947             put_ bh ad
 948     put_ bh (IfaceLam ae af) = do
 949             putByte bh 3
 950             put_ bh ae
 951             put_ bh af
 952     put_ bh (IfaceApp ag ah) = do
 953             putByte bh 4
 954             put_ bh ag
 955             put_ bh ah
 956 -- gaw 2004
 957     put_ bh (IfaceCase ai aj al ak) = do
 958             putByte bh 5
 959             put_ bh ai
 960             put_ bh aj
 961 -- gaw 2004
 962             put_ bh al
 963             put_ bh ak
 964     put_ bh (IfaceLet al am) = do
 965             putByte bh 6
 966             put_ bh al
 967             put_ bh am
 968     put_ bh (IfaceNote an ao) = do
 969             putByte bh 7
 970             put_ bh an
 971             put_ bh ao
 972     put_ bh (IfaceLit ap) = do
 973             putByte bh 8
 974             put_ bh ap
 975     put_ bh (IfaceFCall as at) = do
 976             putByte bh 9
 977             put_ bh as
 978             put_ bh at
 979     put_ bh (IfaceExt aa) = do
 980             putByte bh 10
 981             put_ bh aa
 982     put_ bh (IfaceCast ie ico) = do
 983             putByte bh 11
 984             put_ bh ie
 985             put_ bh ico
 986     put_ bh (IfaceTick m ix) = do
 987             putByte bh 12
 988             put_ bh m
 989             put_ bh ix
 990     get bh = do
 991             h <- getByte bh
 992             case h of
 993               0 -> do aa <- get bh
 994                       return (IfaceLcl aa)
 995               1 -> do ab <- get bh
 996                       return (IfaceType ab)
 997               2 -> do ac <- get bh
 998                       ad <- get bh
 999                       return (IfaceTuple ac ad)
1000               3 -> do ae <- get bh
1001                       af <- get bh
1002                       return (IfaceLam ae af)
1003               4 -> do ag <- get bh
1004                       ah <- get bh
1005                       return (IfaceApp ag ah)
1006               5 -> do ai <- get bh
1007                       aj <- get bh
1008 -- gaw 2004
1009                       al <- get bh
1010                       ak <- get bh
1011 -- gaw 2004
1012                       return (IfaceCase ai aj al ak)
1013               6 -> do al <- get bh
1014                       am <- get bh
1015                       return (IfaceLet al am)
1016               7 -> do an <- get bh
1017                       ao <- get bh
1018                       return (IfaceNote an ao)
1019               8 -> do ap <- get bh
1020                       return (IfaceLit ap)
1021               9 -> do as <- get bh
1022                       at <- get bh
1023                       return (IfaceFCall as at)
1024               10 -> do aa <- get bh
1025                        return (IfaceExt aa)
1026               11 -> do ie <- get bh
1027                        ico <- get bh
1028                        return (IfaceCast ie ico)
1029               12 -> do m <- get bh
1030                        ix <- get bh
1031                        return (IfaceTick m ix)
1032               _ -> panic ("get IfaceExpr " ++ show h)
1033
1034 instance Binary IfaceConAlt where
1035     put_ bh IfaceDefault = do
1036             putByte bh 0
1037     put_ bh (IfaceDataAlt aa) = do
1038             putByte bh 1
1039             put_ bh aa
1040     put_ bh (IfaceTupleAlt ab) = do
1041             putByte bh 2
1042             put_ bh ab
1043     put_ bh (IfaceLitAlt ac) = do
1044             putByte bh 3
1045             put_ bh ac
1046     get bh = do
1047             h <- getByte bh
1048             case h of
1049               0 -> do return IfaceDefault
1050               1 -> do aa <- get bh
1051                       return (IfaceDataAlt aa)
1052               2 -> do ab <- get bh
1053                       return (IfaceTupleAlt ab)
1054               _ -> do ac <- get bh
1055                       return (IfaceLitAlt ac)
1056
1057 instance Binary IfaceBinding where
1058     put_ bh (IfaceNonRec aa ab) = do
1059             putByte bh 0
1060             put_ bh aa
1061             put_ bh ab
1062     put_ bh (IfaceRec ac) = do
1063             putByte bh 1
1064             put_ bh ac
1065     get bh = do
1066             h <- getByte bh
1067             case h of
1068               0 -> do aa <- get bh
1069                       ab <- get bh
1070                       return (IfaceNonRec aa ab)
1071               _ -> do ac <- get bh
1072                       return (IfaceRec ac)
1073
1074 instance Binary IfaceIdInfo where
1075     put_ bh NoInfo = putByte bh 0
1076     put_ bh (HasInfo i) = do
1077             putByte bh 1
1078             lazyPut bh i                        -- NB lazyPut
1079
1080     get bh = do
1081             h <- getByte bh
1082             case h of
1083               0 -> return NoInfo
1084               _ -> do info <- lazyGet bh        -- NB lazyGet
1085                       return (HasInfo info)
1086
1087 instance Binary IfaceInfoItem where
1088     put_ bh (HsArity aa) = do
1089             putByte bh 0
1090             put_ bh aa
1091     put_ bh (HsStrictness ab) = do
1092             putByte bh 1
1093             put_ bh ab
1094     put_ bh (HsUnfold ad) = do
1095             putByte bh 2
1096             put_ bh ad
1097     put_ bh (HsInline ad) = do
1098             putByte bh 3
1099             put_ bh ad
1100     put_ bh HsNoCafRefs = do
1101             putByte bh 4
1102     put_ bh (HsWorker ae af) = do
1103             putByte bh 5
1104             put_ bh ae
1105             put_ bh af
1106     get bh = do
1107             h <- getByte bh
1108             case h of
1109               0 -> do aa <- get bh
1110                       return (HsArity aa)
1111               1 -> do ab <- get bh
1112                       return (HsStrictness ab)
1113               2 -> do ad <- get bh
1114                       return (HsUnfold ad)
1115               3 -> do ad <- get bh
1116                       return (HsInline ad)
1117               4 -> do return HsNoCafRefs
1118               _ -> do ae <- get bh
1119                       af <- get bh
1120                       return (HsWorker ae af)
1121
1122 instance Binary IfaceNote where
1123     put_ bh (IfaceSCC aa) = do
1124             putByte bh 0
1125             put_ bh aa
1126     put_ bh IfaceInlineMe = do
1127             putByte bh 3
1128     put_ bh (IfaceCoreNote s) = do
1129             putByte bh 4
1130             put_ bh s
1131     get bh = do
1132             h <- getByte bh
1133             case h of
1134               0 -> do aa <- get bh
1135                       return (IfaceSCC aa)
1136               3 -> do return IfaceInlineMe
1137               4 -> do ac <- get bh
1138                       return (IfaceCoreNote ac)
1139               _ -> panic ("get IfaceNote " ++ show h)
1140
1141 -------------------------------------------------------------------------
1142 --              IfaceDecl and friends
1143 -------------------------------------------------------------------------
1144
1145 -- A bit of magic going on here: there's no need to store the OccName
1146 -- for a decl on the disk, since we can infer the namespace from the
1147 -- context; however it is useful to have the OccName in the IfaceDecl
1148 -- to avoid re-building it in various places.  So we build the OccName
1149 -- when de-serialising.
1150
1151 instance Binary IfaceDecl where
1152     put_ bh (IfaceId name ty idinfo) = do
1153             putByte bh 0
1154             put_ bh (occNameFS name)
1155             put_ bh ty
1156             put_ bh idinfo
1157     put_ _ (IfaceForeign _ _) =
1158         error "Binary.put_(IfaceDecl): IfaceForeign"
1159     put_ bh (IfaceData a1 a2 a3 a4 a5 a6 a7 a8) = do
1160             putByte bh 2
1161             put_ bh (occNameFS a1)
1162             put_ bh a2
1163             put_ bh a3
1164             put_ bh a4
1165             put_ bh a5
1166             put_ bh a6
1167             put_ bh a7
1168             put_ bh a8
1169     put_ bh (IfaceSyn a1 a2 a3 a4 a5) = do
1170             putByte bh 3
1171             put_ bh (occNameFS a1)
1172             put_ bh a2
1173             put_ bh a3
1174             put_ bh a4
1175             put_ bh a5
1176     put_ bh (IfaceClass a1 a2 a3 a4 a5 a6 a7) = do
1177             putByte bh 4
1178             put_ bh a1
1179             put_ bh (occNameFS a2)
1180             put_ bh a3
1181             put_ bh a4
1182             put_ bh a5
1183             put_ bh a6
1184             put_ bh a7
1185     get bh = do
1186             h <- getByte bh
1187             case h of
1188               0 -> do name   <- get bh
1189                       ty     <- get bh
1190                       idinfo <- get bh
1191                       occ <- return $! mkOccNameFS varName name
1192                       return (IfaceId occ ty idinfo)
1193               1 -> error "Binary.get(TyClDecl): ForeignType"
1194               2 -> do
1195                     a1 <- get bh
1196                     a2 <- get bh
1197                     a3 <- get bh
1198                     a4 <- get bh
1199                     a5 <- get bh
1200                     a6 <- get bh
1201                     a7 <- get bh
1202                     a8 <- get bh
1203                     occ <- return $! mkOccNameFS tcName a1
1204                     return (IfaceData occ a2 a3 a4 a5 a6 a7 a8)
1205               3 -> do
1206                     a1 <- get bh
1207                     a2 <- get bh
1208                     a3 <- get bh
1209                     a4 <- get bh
1210                     a5 <- get bh
1211                     occ <- return $! mkOccNameFS tcName a1
1212                     return (IfaceSyn occ a2 a3 a4 a5)
1213               _ -> do
1214                     a1 <- get bh
1215                     a2 <- get bh
1216                     a3 <- get bh
1217                     a4 <- get bh
1218                     a5 <- get bh
1219                     a6 <- get bh
1220                     a7 <- get bh
1221                     occ <- return $! mkOccNameFS clsName a2
1222                     return (IfaceClass a1 occ a3 a4 a5 a6 a7)
1223
1224 instance Binary IfaceInst where
1225     put_ bh (IfaceInst cls tys dfun flag orph) = do
1226             put_ bh cls
1227             put_ bh tys
1228             put_ bh dfun
1229             put_ bh flag
1230             put_ bh orph
1231     get bh = do cls  <- get bh
1232                 tys  <- get bh
1233                 dfun <- get bh
1234                 flag <- get bh
1235                 orph <- get bh
1236                 return (IfaceInst cls tys dfun flag orph)
1237
1238 instance Binary IfaceFamInst where
1239     put_ bh (IfaceFamInst fam tys tycon) = do
1240             put_ bh fam
1241             put_ bh tys
1242             put_ bh tycon
1243     get bh = do fam   <- get bh
1244                 tys   <- get bh
1245                 tycon <- get bh
1246                 return (IfaceFamInst fam tys tycon)
1247
1248 instance Binary OverlapFlag where
1249     put_ bh NoOverlap  = putByte bh 0
1250     put_ bh OverlapOk  = putByte bh 1
1251     put_ bh Incoherent = putByte bh 2
1252     get bh = do h <- getByte bh
1253                 case h of
1254                   0 -> return NoOverlap
1255                   1 -> return OverlapOk
1256                   2 -> return Incoherent
1257                   _ -> panic ("get OverlapFlag " ++ show h)
1258
1259 instance Binary IfaceConDecls where
1260     put_ bh IfAbstractTyCon = putByte bh 0
1261     put_ bh IfOpenDataTyCon = putByte bh 1
1262     put_ bh (IfDataTyCon cs) = do { putByte bh 2
1263                                   ; put_ bh cs }
1264     put_ bh (IfNewTyCon c)  = do { putByte bh 3
1265                                   ; put_ bh c }
1266     get bh = do
1267             h <- getByte bh
1268             case h of
1269               0 -> return IfAbstractTyCon
1270               1 -> return IfOpenDataTyCon
1271               2 -> do cs <- get bh
1272                       return (IfDataTyCon cs)
1273               _ -> do aa <- get bh
1274                       return (IfNewTyCon aa)
1275
1276 instance Binary IfaceConDecl where
1277     put_ bh (IfCon a1 a2 a3 a4 a5 a6 a7 a8 a9) = do
1278             put_ bh a1
1279             put_ bh a2
1280             put_ bh a3
1281             put_ bh a4
1282             put_ bh a5
1283             put_ bh a6
1284             put_ bh a7
1285             put_ bh a8
1286             put_ bh a9
1287     get bh = do a1 <- get bh
1288                 a2 <- get bh
1289                 a3 <- get bh
1290                 a4 <- get bh
1291                 a5 <- get bh
1292                 a6 <- get bh
1293                 a7 <- get bh
1294                 a8 <- get bh
1295                 a9 <- get bh
1296                 return (IfCon a1 a2 a3 a4 a5 a6 a7 a8 a9)
1297
1298 instance Binary IfaceClassOp where
1299    put_ bh (IfaceClassOp n def ty) = do
1300         put_ bh (occNameFS n)
1301         put_ bh def
1302         put_ bh ty
1303    get bh = do
1304         n <- get bh
1305         def <- get bh
1306         ty <- get bh
1307         occ <- return $! mkOccNameFS varName n
1308         return (IfaceClassOp occ def ty)
1309
1310 instance Binary IfaceRule where
1311     put_ bh (IfaceRule a1 a2 a3 a4 a5 a6 a7) = do
1312             put_ bh a1
1313             put_ bh a2
1314             put_ bh a3
1315             put_ bh a4
1316             put_ bh a5
1317             put_ bh a6
1318             put_ bh a7
1319     get bh = do
1320             a1 <- get bh
1321             a2 <- get bh
1322             a3 <- get bh
1323             a4 <- get bh
1324             a5 <- get bh
1325             a6 <- get bh
1326             a7 <- get bh
1327             return (IfaceRule a1 a2 a3 a4 a5 a6 a7)
1328
1329 instance Binary IfaceVectInfo where
1330     put_ bh (IfaceVectInfo a1 a2 a3) = do
1331             put_ bh a1
1332             put_ bh a2
1333             put_ bh a3
1334     get bh = do
1335             a1 <- get bh
1336             a2 <- get bh
1337             a3 <- get bh
1338             return (IfaceVectInfo a1 a2 a3)
1339
1340