compiler/iface/BinIface.hs

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