De-orphan a load of Binary instances

2 files changed, 215 insertions, 0 deletions

diff --git a/compiler/main/Annotations.hs b/compiler/main/Annotations.hs
index 277c059b11..ec179d86e2 100644
--- a/compiler/main/Annotations.hs
+++ b/compiler/main/Annotations.hs
@@ -16,6 +16,7 @@ module Annotations (
         deserializeAnns
     ) where
 
+import Binary
 import Module           ( Module )
 import Name
 import Outputable
@@ -64,6 +65,19 @@ instance Outputable name => Outputable (AnnTarget name) where
     ppr (NamedTarget nm) = text "Named target" <+> ppr nm
     ppr (ModuleTarget mod) = text "Module target" <+> ppr mod
 
+instance Binary name => Binary (AnnTarget name) where
+    put_ bh (NamedTarget a) = do
+        putByte bh 0
+        put_ bh a
+    put_ bh (ModuleTarget a) = do
+        putByte bh 1
+        put_ bh a
+    get bh = do
+        h <- getByte bh
+        case h of
+            0 -> get bh >>= (return . NamedTarget)
+            _ -> get bh >>= (return . ModuleTarget)
+
 instance Outputable Annotation where
     ppr ann = ppr (ann_target ann)
 
diff --git a/compiler/main/HscTypes.lhs b/compiler/main/HscTypes.lhs
index 163af051e8..e022ae3eae 100644
--- a/compiler/main/HscTypes.lhs
+++ b/compiler/main/HscTypes.lhs
@@ -159,6 +159,7 @@ import StringBuffer     ( StringBuffer )
 import Fingerprint
 import MonadUtils
 import Bag
+import Binary
 import ErrUtils
 import Platform
 import Util
@@ -717,6 +718,113 @@ data ModIface
                 -- See Note [RnNames . Trust Own Package]
      }
 
+instance Binary ModIface where
+   put_ bh (ModIface {
+                 mi_module    = mod,
+                 mi_boot      = is_boot,
+                 mi_iface_hash= iface_hash,
+                 mi_mod_hash  = mod_hash,
+                 mi_flag_hash = flag_hash,
+                 mi_orphan    = orphan,
+                 mi_finsts    = hasFamInsts,
+                 mi_deps      = deps,
+                 mi_usages    = usages,
+                 mi_exports   = exports,
+                 mi_exp_hash  = exp_hash,
+                 mi_used_th   = used_th,
+                 mi_fixities  = fixities,
+                 mi_warns     = warns,
+                 mi_anns      = anns,
+                 mi_decls     = decls,
+                 mi_insts     = insts,
+                 mi_fam_insts = fam_insts,
+                 mi_rules     = rules,
+                 mi_orphan_hash = orphan_hash,
+                 mi_vect_info = vect_info,
+                 mi_hpc       = hpc_info,
+                 mi_trust     = trust,
+                 mi_trust_pkg = trust_pkg }) = do
+        put_ bh mod
+        put_ bh is_boot
+        put_ bh iface_hash
+        put_ bh mod_hash
+        put_ bh flag_hash
+        put_ bh orphan
+        put_ bh hasFamInsts
+        lazyPut bh deps
+        lazyPut bh usages
+        put_ bh exports
+        put_ bh exp_hash
+        put_ bh used_th
+        put_ bh fixities
+        lazyPut bh warns
+        lazyPut bh anns
+        put_ bh decls
+        put_ bh insts
+        put_ bh fam_insts
+        lazyPut bh rules
+        put_ bh orphan_hash
+        put_ bh vect_info
+        put_ bh hpc_info
+        put_ bh trust
+        put_ bh trust_pkg
+
+   get bh = do
+        mod_name    <- get bh
+        is_boot     <- get bh
+        iface_hash  <- get bh
+        mod_hash    <- get bh
+        flag_hash   <- get bh
+        orphan      <- get bh
+        hasFamInsts <- get bh
+        deps        <- lazyGet bh
+        usages      <- {-# SCC "bin_usages" #-} lazyGet bh
+        exports     <- {-# SCC "bin_exports" #-} get bh
+        exp_hash    <- get bh
+        used_th     <- get bh
+        fixities    <- {-# SCC "bin_fixities" #-} get bh
+        warns       <- {-# SCC "bin_warns" #-} lazyGet bh
+        anns        <- {-# SCC "bin_anns" #-} lazyGet bh
+        decls       <- {-# SCC "bin_tycldecls" #-} get bh
+        insts       <- {-# SCC "bin_insts" #-} get bh
+        fam_insts   <- {-# SCC "bin_fam_insts" #-} get bh
+        rules       <- {-# SCC "bin_rules" #-} lazyGet bh
+        orphan_hash <- get bh
+        vect_info   <- get bh
+        hpc_info    <- get bh
+        trust       <- get bh
+        trust_pkg   <- get bh
+        return (ModIface {
+                 mi_module      = mod_name,
+                 mi_boot        = is_boot,
+                 mi_iface_hash  = iface_hash,
+                 mi_mod_hash    = mod_hash,
+                 mi_flag_hash   = flag_hash,
+                 mi_orphan      = orphan,
+                 mi_finsts      = hasFamInsts,
+                 mi_deps        = deps,
+                 mi_usages      = usages,
+                 mi_exports     = exports,
+                 mi_exp_hash    = exp_hash,
+                 mi_used_th     = used_th,
+                 mi_anns        = anns,
+                 mi_fixities    = fixities,
+                 mi_warns       = warns,
+                 mi_decls       = decls,
+                 mi_globals     = Nothing,
+                 mi_insts       = insts,
+                 mi_fam_insts   = fam_insts,
+                 mi_rules       = rules,
+                 mi_orphan_hash = orphan_hash,
+                 mi_vect_info   = vect_info,
+                 mi_hpc         = hpc_info,
+                 mi_trust       = trust,
+                 mi_trust_pkg   = trust_pkg,
+                        -- And build the cached values
+                 mi_warn_fn     = mkIfaceWarnCache warns,
+                 mi_fix_fn      = mkIfaceFixCache fixities,
+                 mi_hash_fn     = mkIfaceHashCache decls })
+
 -- | The original names declared of a certain module that are exported
 type IfaceExport = AvailInfo
 
@@ -1527,6 +1635,24 @@ data Warnings
      --        a Name to its fixity declaration.
   deriving( Eq )
 
+instance Binary Warnings where
+    put_ bh NoWarnings     = putByte bh 0
+    put_ bh (WarnAll t) = do
+            putByte bh 1
+            put_ bh t
+    put_ bh (WarnSome ts) = do
+            putByte bh 2
+            put_ bh ts
+
+    get bh = do
+            h <- getByte bh
+            case h of
+              0 -> return NoWarnings
+              1 -> do aa <- get bh
+                      return (WarnAll aa)
+              _ -> do aa <- get bh
+                      return (WarnSome aa)
+
 -- | Constructs the cache for the 'mi_warn_fn' field of a 'ModIface'
 mkIfaceWarnCache :: Warnings -> Name -> Maybe WarningTxt
 mkIfaceWarnCache NoWarnings  = \_ -> Nothing
@@ -1625,6 +1751,19 @@ data Dependencies
         -- Equality used only for old/new comparison in MkIface.addFingerprints
         -- See 'TcRnTypes.ImportAvails' for details on dependencies.
 
+instance Binary Dependencies where
+    put_ bh deps = do put_ bh (dep_mods deps)
+                      put_ bh (dep_pkgs deps)
+                      put_ bh (dep_orphs deps)
+                      put_ bh (dep_finsts deps)
+
+    get bh = do ms <- get bh
+                ps <- get bh
+                os <- get bh
+                fis <- get bh
+                return (Deps { dep_mods = ms, dep_pkgs = ps, dep_orphs = os,
+                               dep_finsts = fis })
+
 noDependencies :: Dependencies
 noDependencies = Deps [] [] [] []
 
@@ -1673,6 +1812,49 @@ data Usage
         --                      import M()
         -- And of course, for modules that aren't imported directly we don't
         -- depend on their export lists
+
+instance Binary Usage where
+    put_ bh usg@UsagePackageModule{} = do 
+        putByte bh 0
+        put_ bh (usg_mod usg)
+        put_ bh (usg_mod_hash usg)
+        put_ bh (usg_safe     usg)
+
+    put_ bh usg@UsageHomeModule{} = do 
+        putByte bh 1
+        put_ bh (usg_mod_name usg)
+        put_ bh (usg_mod_hash usg)
+        put_ bh (usg_exports  usg)
+        put_ bh (usg_entities usg)
+        put_ bh (usg_safe     usg)
+
+    put_ bh usg@UsageFile{} = do 
+        putByte bh 2
+        put_ bh (usg_file_path usg)
+        put_ bh (usg_mtime     usg)
+
+    get bh = do
+        h <- getByte bh
+        case h of
+          0 -> do
+            nm    <- get bh
+            mod   <- get bh
+            safe  <- get bh
+            return UsagePackageModule { usg_mod = nm, usg_mod_hash = mod, usg_safe = safe }
+          1 -> do
+            nm    <- get bh
+            mod   <- get bh
+            exps  <- get bh
+            ents  <- get bh
+            safe  <- get bh
+            return UsageHomeModule { usg_mod_name = nm, usg_mod_hash = mod,
+                     usg_exports = exps, usg_entities = ents, usg_safe = safe }
+          2 -> do
+            fp    <- get bh
+            mtime <- get bh
+            return UsageFile { usg_file_path = fp, usg_mtime = mtime }
+          i -> error ("Binary.get(Usage): " ++ show i)
+
 \end{code}
 
 
@@ -2060,6 +2242,21 @@ instance Outputable VectInfo where
              , ptext (sLit "parallel vars   :") <+> ppr (vectInfoParallelVars   info)
              , ptext (sLit "parallel tycons :") <+> ppr (vectInfoParallelTyCons info)
              ]
+
+instance Binary IfaceVectInfo where
+    put_ bh (IfaceVectInfo a1 a2 a3 a4 a5) = do
+        put_ bh a1
+        put_ bh a2
+        put_ bh a3
+        put_ bh a4
+        put_ bh a5
+    get bh = do
+        a1 <- get bh
+        a2 <- get bh
+        a3 <- get bh
+        a4 <- get bh
+        a5 <- get bh
+        return (IfaceVectInfo a1 a2 a3 a4 a5)
 \end{code}
 
 %************************************************************************
@@ -2111,6 +2308,10 @@ instance Outputable IfaceTrustInfo where
     ppr (TrustInfo Sf_Trustworthy)   = ptext $ sLit "trustworthy"
     ppr (TrustInfo Sf_Safe)          = ptext $ sLit "safe"
     ppr (TrustInfo Sf_SafeInferred)  = ptext $ sLit "safe-inferred"
+
+instance Binary IfaceTrustInfo where
+    put_ bh iftrust = putByte bh $ trustInfoToNum iftrust
+    get bh = getByte bh >>= (return . numToTrustInfo)
 \end{code}
 
 %************************************************************************