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