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