2 -- (c) The University of Glasgow 2002-2006
4 -- Binary interface file support.
6 module BinIface ( writeBinIface, readBinIface, v_IgnoreHiWay ) where
8 #include "HsVersions.h"
40 import Control.Exception
43 -- ---------------------------------------------------------------------------
44 -- Reading and writing binary interface files
46 readBinIface :: FilePath -> TcRnIf a b ModIface
47 readBinIface hi_path = do
49 (new_nc, iface) <- ioToIOEnv $ readBinIface_ hi_path nc
53 readBinIface_ :: FilePath -> NameCache -> IO (NameCache, ModIface)
54 readBinIface_ hi_path nc = do
55 bh <- Binary.readBinMem hi_path
57 -- Read the magic number to check that this really is a GHC .hi file
58 -- (This magic number does not change when we change
59 -- GHC interface file format)
61 when (magic /= binaryInterfaceMagic) $
62 throwDyn (ProgramError (
63 "magic number mismatch: old/corrupt interface file?"))
65 -- Read the dictionary
66 -- The next word in the file is a pointer to where the dictionary is
67 -- (probably at the end of the file)
68 dict_p <- Binary.get bh -- Get the dictionary ptr
69 data_p <- tellBin bh -- Remember where we are now
71 dict <- getDictionary bh
72 seekBin bh data_p -- Back to where we were before
74 -- Initialise the user-data field of bh
75 ud <- newReadState dict
76 bh <- return (setUserData bh ud)
78 symtab_p <- Binary.get bh -- Get the symtab ptr
79 data_p <- tellBin bh -- Remember where we are now
81 (nc', symtab) <- getSymbolTable bh nc
82 seekBin bh data_p -- Back to where we were before
83 let ud = getUserData bh
84 bh <- return $! setUserData bh ud{ud_symtab = symtab}
89 writeBinIface :: DynFlags -> FilePath -> ModIface -> IO ()
90 writeBinIface dflags hi_path mod_iface = do
91 bh <- openBinMem initBinMemSize
92 put_ bh binaryInterfaceMagic
94 -- Remember where the dictionary pointer will go
95 dict_p_p <- tellBin bh
96 put_ bh dict_p_p -- Placeholder for ptr to dictionary
98 -- Remember where the symbol table pointer will go
99 symtab_p_p <- tellBin bh
102 -- Make some intial state
105 -- Put the main thing,
106 bh <- return $ setUserData bh ud
109 -- Write the symtab pointer at the fornt of the file
110 symtab_p <- tellBin bh -- This is where the symtab will start
111 putAt bh symtab_p_p symtab_p -- Fill in the placeholder
112 seekBin bh symtab_p -- Seek back to the end of the file
114 -- Write the symbol table itself
115 symtab_next <- readFastMutInt (ud_symtab_next ud)
116 symtab_map <- readIORef (ud_symtab_map ud)
117 putSymbolTable bh symtab_next symtab_map
118 debugTraceMsg dflags 3 (text "writeBinIface:" <+> int symtab_next
121 -- NB. write the dictionary after the symbol table, because
122 -- writing the symbol table may create more dictionary entries.
124 -- Write the dictionary pointer at the fornt of the file
125 dict_p <- tellBin bh -- This is where the dictionary will start
126 putAt bh dict_p_p dict_p -- Fill in the placeholder
127 seekBin bh dict_p -- Seek back to the end of the file
129 -- Write the dictionary itself
130 dict_next <- readFastMutInt (ud_dict_next ud)
131 dict_map <- readIORef (ud_dict_map ud)
132 putDictionary bh dict_next dict_map
133 debugTraceMsg dflags 3 (text "writeBinIface:" <+> int dict_next
134 <+> text "dict entries")
136 -- And send the result to the file
137 writeBinMem bh hi_path
139 initBinMemSize = (1024*1024) :: Int
141 -- The *host* architecture version:
142 #include "MachDeps.h"
144 #if WORD_SIZE_IN_BITS == 32
145 binaryInterfaceMagic = 0x1face :: Word32
146 #elif WORD_SIZE_IN_BITS == 64
147 binaryInterfaceMagic = 0x1face64 :: Word32
150 -- -----------------------------------------------------------------------------
153 putSymbolTable :: BinHandle -> Int -> UniqFM (Int,Name) -> IO ()
154 putSymbolTable bh next_off symtab = do
156 let names = elems (array (0,next_off-1) (eltsUFM symtab))
157 mapM_ (\n -> serialiseName bh n symtab) names
159 getSymbolTable :: BinHandle -> NameCache -> IO (NameCache, Array Int Name)
160 getSymbolTable bh namecache = do
162 od_names <- sequence (replicate sz (get bh))
164 arr = listArray (0,sz-1) names
165 (namecache', names) =
166 mapAccumR (fromOnDiskName arr) namecache od_names
168 return (namecache', arr)
170 type OnDiskName = (PackageId, ModuleName, OccName)
177 fromOnDiskName arr nc (pid, mod_name, occ) =
179 mod = mkModule pid mod_name
182 case lookupOrigNameCache cache mod occ of
183 Just name -> (nc, name)
187 uniq = uniqFromSupply us
188 name = mkExternalName uniq mod occ noSrcLoc
189 new_cache = extendNameCache cache mod occ name
191 case splitUniqSupply us of { (us',_) ->
192 ( nc{ nsUniqs = us', nsNames = new_cache }, name )
195 serialiseName :: BinHandle -> Name -> UniqFM (Int,Name) -> IO ()
196 serialiseName bh name symtab = do
197 let mod = nameModule name
198 put_ bh (modulePackageId mod, moduleName mod, nameOccName name)
200 -- -----------------------------------------------------------------------------
201 -- All the binary instances
204 {-! for IPName derive: Binary !-}
205 {-! for Fixity derive: Binary !-}
206 {-! for FixityDirection derive: Binary !-}
207 {-! for Boxity derive: Binary !-}
208 {-! for StrictnessMark derive: Binary !-}
209 {-! for Activation derive: Binary !-}
212 {-! for Demand derive: Binary !-}
213 {-! for Demands derive: Binary !-}
214 {-! for DmdResult derive: Binary !-}
215 {-! for StrictSig derive: Binary !-}
218 {-! for DefMeth derive: Binary !-}
221 {-! for HsPred derive: Binary !-}
222 {-! for HsType derive: Binary !-}
223 {-! for TupCon derive: Binary !-}
224 {-! for HsTyVarBndr derive: Binary !-}
227 {-! for UfExpr derive: Binary !-}
228 {-! for UfConAlt derive: Binary !-}
229 {-! for UfBinding derive: Binary !-}
230 {-! for UfBinder derive: Binary !-}
231 {-! for HsIdInfo derive: Binary !-}
232 {-! for UfNote derive: Binary !-}
235 {-! for ConDetails derive: Binary !-}
236 {-! for BangType derive: Binary !-}
239 {-! for IsCafCC derive: Binary !-}
240 {-! for IsDupdCC derive: Binary !-}
241 {-! for CostCentre derive: Binary !-}
245 -- ---------------------------------------------------------------------------
246 -- Reading a binary interface into ParsedIface
248 instance Binary ModIface where
252 mi_mod_vers = mod_vers,
254 mi_finsts = hasFamInsts,
257 mi_exports = exports,
258 mi_exp_vers = exp_vers,
259 mi_fixities = fixities,
260 mi_deprecs = deprecs,
263 mi_fam_insts = fam_insts,
265 mi_rule_vers = rule_vers }) = do
266 put_ bh (show opt_HiVersion)
267 way_descr <- getWayDescr
288 let our_ver = show opt_HiVersion
289 when (check_ver /= our_ver) $
290 -- use userError because this will be caught by readIface
291 -- which will emit an error msg containing the iface module name.
292 throwDyn (ProgramError (
293 "mismatched interface file versions: expected "
294 ++ our_ver ++ ", found " ++ check_ver))
297 ignore_way <- readIORef v_IgnoreHiWay
298 way_descr <- getWayDescr
299 when (not ignore_way && check_way /= way_descr) $
300 -- use userError because this will be caught by readIface
301 -- which will emit an error msg containing the iface module name.
302 throwDyn (ProgramError (
303 "mismatched interface file ways: expected "
304 ++ way_descr ++ ", found " ++ check_way))
310 hasFamInsts <- get bh
312 usages <- {-# SCC "bin_usages" #-} lazyGet bh
313 exports <- {-# SCC "bin_exports" #-} get bh
315 fixities <- {-# SCC "bin_fixities" #-} get bh
316 deprecs <- {-# SCC "bin_deprecs" #-} lazyGet bh
317 decls <- {-# SCC "bin_tycldecls" #-} get bh
318 insts <- {-# SCC "bin_insts" #-} get bh
319 fam_insts <- {-# SCC "bin_fam_insts" #-} get bh
320 rules <- {-# SCC "bin_rules" #-} lazyGet bh
323 mi_module = mod_name,
325 mi_mod_vers = mod_vers,
327 mi_finsts = hasFamInsts,
330 mi_exports = exports,
331 mi_exp_vers = exp_vers,
332 mi_fixities = fixities,
333 mi_deprecs = deprecs,
335 mi_globals = Nothing,
337 mi_fam_insts = fam_insts,
339 mi_rule_vers = rule_vers,
340 -- And build the cached values
341 mi_dep_fn = mkIfaceDepCache deprecs,
342 mi_fix_fn = mkIfaceFixCache fixities,
343 mi_ver_fn = mkIfaceVerCache decls })
345 GLOBAL_VAR(v_IgnoreHiWay, False, Bool)
347 getWayDescr :: IO String
349 tag <- readIORef v_Build_tag
350 if cGhcUnregisterised == "YES" then return ('u':tag) else return tag
351 -- if this is an unregisterised build, make sure our interfaces
352 -- can't be used by a registerised build.
354 -------------------------------------------------------------------------
355 -- Types from: HscTypes
356 -------------------------------------------------------------------------
358 instance Binary Dependencies where
359 put_ bh deps = do put_ bh (dep_mods deps)
360 put_ bh (dep_pkgs deps)
361 put_ bh (dep_orphs deps)
362 put_ bh (dep_finsts deps)
364 get bh = do ms <- get bh
368 return (Deps { dep_mods = ms, dep_pkgs = ps, dep_orphs = os,
371 instance (Binary name) => Binary (GenAvailInfo name) where
372 put_ bh (Avail aa) = do
375 put_ bh (AvailTC ab ac) = do
386 return (AvailTC ab ac)
388 instance Binary Usage where
390 put_ bh (usg_name usg)
391 put_ bh (usg_mod usg)
392 put_ bh (usg_exports usg)
393 put_ bh (usg_entities usg)
394 put_ bh (usg_rules usg)
402 return (Usage { usg_name = nm, usg_mod = mod,
403 usg_exports = exps, usg_entities = ents,
406 instance Binary a => Binary (Deprecs a) where
407 put_ bh NoDeprecs = putByte bh 0
408 put_ bh (DeprecAll t) = do
411 put_ bh (DeprecSome ts) = do
418 0 -> return NoDeprecs
420 return (DeprecAll aa)
422 return (DeprecSome aa)
424 -------------------------------------------------------------------------
425 -- Types from: BasicTypes
426 -------------------------------------------------------------------------
428 instance Binary Activation where
429 put_ bh NeverActive = do
431 put_ bh AlwaysActive = do
433 put_ bh (ActiveBefore aa) = do
436 put_ bh (ActiveAfter ab) = do
442 0 -> do return NeverActive
443 1 -> do return AlwaysActive
445 return (ActiveBefore aa)
447 return (ActiveAfter ab)
449 instance Binary StrictnessMark where
450 put_ bh MarkedStrict = do
452 put_ bh MarkedUnboxed = do
454 put_ bh NotMarkedStrict = do
459 0 -> do return MarkedStrict
460 1 -> do return MarkedUnboxed
461 _ -> do return NotMarkedStrict
463 instance Binary Boxity where
472 _ -> do return Unboxed
474 instance Binary TupCon where
475 put_ bh (TupCon ab ac) = do
481 return (TupCon ab ac)
483 instance Binary RecFlag where
484 put_ bh Recursive = do
486 put_ bh NonRecursive = do
491 0 -> do return Recursive
492 _ -> do return NonRecursive
494 instance Binary DefMeth where
495 put_ bh NoDefMeth = putByte bh 0
496 put_ bh DefMeth = putByte bh 1
497 put_ bh GenDefMeth = putByte bh 2
501 0 -> return NoDefMeth
503 _ -> return GenDefMeth
505 instance Binary FixityDirection where
515 0 -> do return InfixL
516 1 -> do return InfixR
517 _ -> do return InfixN
519 instance Binary Fixity where
520 put_ bh (Fixity aa ab) = do
526 return (Fixity aa ab)
528 instance (Binary name) => Binary (IPName name) where
529 put_ bh (IPName aa) = put_ bh aa
530 get bh = do aa <- get bh
533 -------------------------------------------------------------------------
534 -- Types from: Demand
535 -------------------------------------------------------------------------
537 instance Binary DmdType where
538 -- Ignore DmdEnv when spitting out the DmdType
539 put bh (DmdType _ ds dr) = do p <- put bh ds; put bh dr; return (castBin p)
540 get bh = do ds <- get bh; dr <- get bh; return (DmdType emptyVarEnv ds dr)
542 instance Binary Demand where
547 put_ bh (Call aa) = do
550 put_ bh (Eval ab) = do
553 put_ bh (Defer ac) = do
556 put_ bh (Box ad) = do
576 instance Binary Demands where
577 put_ bh (Poly aa) = do
580 put_ bh (Prod ab) = do
591 instance Binary DmdResult where
601 0 -> do return TopRes
602 1 -> do return RetCPR -- Really use RetCPR even if -fcpr-off
603 -- The wrapper was generated for CPR in
604 -- the imported module!
605 _ -> do return BotRes
607 instance Binary StrictSig where
608 put_ bh (StrictSig aa) = do
612 return (StrictSig aa)
615 -------------------------------------------------------------------------
616 -- Types from: CostCentre
617 -------------------------------------------------------------------------
619 instance Binary IsCafCC where
622 put_ bh NotCafCC = do
628 _ -> do return NotCafCC
630 instance Binary IsDupdCC where
631 put_ bh OriginalCC = do
638 0 -> do return OriginalCC
639 _ -> do return DupdCC
641 instance Binary CostCentre where
642 put_ bh NoCostCentre = do
644 put_ bh (NormalCC aa ab ac ad) = do
650 put_ bh (AllCafsCC ae) = do
656 0 -> do return NoCostCentre
661 return (NormalCC aa ab ac ad)
663 return (AllCafsCC ae)
665 -------------------------------------------------------------------------
666 -- IfaceTypes and friends
667 -------------------------------------------------------------------------
669 instance Binary IfaceBndr where
670 put_ bh (IfaceIdBndr aa) = do
673 put_ bh (IfaceTvBndr ab) = do
680 return (IfaceIdBndr aa)
682 return (IfaceTvBndr ab)
684 instance Binary IfaceType where
685 put_ bh (IfaceForAllTy aa ab) = do
689 put_ bh (IfaceTyVar ad) = do
692 put_ bh (IfaceAppTy ae af) = do
696 put_ bh (IfaceFunTy ag ah) = do
700 put_ bh (IfacePredTy aq) = do
704 -- Simple compression for common cases of TyConApp
705 put_ bh (IfaceTyConApp IfaceIntTc []) = putByte bh 6
706 put_ bh (IfaceTyConApp IfaceCharTc []) = putByte bh 7
707 put_ bh (IfaceTyConApp IfaceBoolTc []) = putByte bh 8
708 put_ bh (IfaceTyConApp IfaceListTc [ty]) = do { putByte bh 9; put_ bh ty }
709 -- Unit tuple and pairs
710 put_ bh (IfaceTyConApp (IfaceTupTc Boxed 0) []) = putByte bh 10
711 put_ bh (IfaceTyConApp (IfaceTupTc Boxed 2) [t1,t2]) = do { putByte bh 11; put_ bh t1; put_ bh t2 }
713 put_ bh (IfaceTyConApp IfaceLiftedTypeKindTc []) = putByte bh 12
714 put_ bh (IfaceTyConApp IfaceOpenTypeKindTc []) = putByte bh 13
715 put_ bh (IfaceTyConApp IfaceUnliftedTypeKindTc []) = putByte bh 14
716 put_ bh (IfaceTyConApp IfaceUbxTupleKindTc []) = putByte bh 15
717 put_ bh (IfaceTyConApp IfaceArgTypeKindTc []) = putByte bh 16
721 put_ bh (IfaceTyConApp (IfaceTc tc) tys) = do { putByte bh 18; put_ bh tc; put_ bh tys }
722 put_ bh (IfaceTyConApp tc tys) = do { putByte bh 19; put_ bh tc; put_ bh tys }
729 return (IfaceForAllTy aa ab)
731 return (IfaceTyVar ad)
734 return (IfaceAppTy ae af)
737 return (IfaceFunTy ag ah)
739 return (IfacePredTy ap)
741 -- Now the special cases for TyConApp
742 6 -> return (IfaceTyConApp IfaceIntTc [])
743 7 -> return (IfaceTyConApp IfaceCharTc [])
744 8 -> return (IfaceTyConApp IfaceBoolTc [])
745 9 -> do { ty <- get bh; return (IfaceTyConApp IfaceListTc [ty]) }
746 10 -> return (IfaceTyConApp (IfaceTupTc Boxed 0) [])
747 11 -> do { t1 <- get bh; t2 <- get bh; return (IfaceTyConApp (IfaceTupTc Boxed 2) [t1,t2]) }
748 12 -> return (IfaceTyConApp IfaceLiftedTypeKindTc [])
749 13 -> return (IfaceTyConApp IfaceOpenTypeKindTc [])
750 14 -> return (IfaceTyConApp IfaceUnliftedTypeKindTc [])
751 15 -> return (IfaceTyConApp IfaceUbxTupleKindTc [])
752 16 -> return (IfaceTyConApp IfaceArgTypeKindTc [])
754 18 -> do { tc <- get bh; tys <- get bh; return (IfaceTyConApp (IfaceTc tc) tys) }
755 _ -> do { tc <- get bh; tys <- get bh; return (IfaceTyConApp tc tys) }
757 instance Binary IfaceTyCon where
758 -- Int,Char,Bool can't show up here because they can't not be saturated
760 put_ bh IfaceIntTc = putByte bh 1
761 put_ bh IfaceBoolTc = putByte bh 2
762 put_ bh IfaceCharTc = putByte bh 3
763 put_ bh IfaceListTc = putByte bh 4
764 put_ bh IfacePArrTc = putByte bh 5
765 put_ bh IfaceLiftedTypeKindTc = putByte bh 6
766 put_ bh IfaceOpenTypeKindTc = putByte bh 7
767 put_ bh IfaceUnliftedTypeKindTc = putByte bh 8
768 put_ bh IfaceUbxTupleKindTc = putByte bh 9
769 put_ bh IfaceArgTypeKindTc = putByte bh 10
770 put_ bh (IfaceTupTc bx ar) = do { putByte bh 11; put_ bh bx; put_ bh ar }
771 put_ bh (IfaceTc ext) = do { putByte bh 12; put_ bh ext }
776 1 -> return IfaceIntTc
777 2 -> return IfaceBoolTc
778 3 -> return IfaceCharTc
779 4 -> return IfaceListTc
780 5 -> return IfacePArrTc
781 6 -> return IfaceLiftedTypeKindTc
782 7 -> return IfaceOpenTypeKindTc
783 8 -> return IfaceUnliftedTypeKindTc
784 9 -> return IfaceUbxTupleKindTc
785 10 -> return IfaceArgTypeKindTc
786 11 -> do { bx <- get bh; ar <- get bh; return (IfaceTupTc bx ar) }
787 _ -> do { ext <- get bh; return (IfaceTc ext) }
789 instance Binary IfacePredType where
790 put_ bh (IfaceClassP aa ab) = do
794 put_ bh (IfaceIParam ac ad) = do
798 put_ bh (IfaceEqPred ac ad) = do
807 return (IfaceClassP aa ab)
810 return (IfaceIParam ac ad)
813 return (IfaceEqPred ac ad)
815 -------------------------------------------------------------------------
816 -- IfaceExpr and friends
817 -------------------------------------------------------------------------
819 instance Binary IfaceExpr where
820 put_ bh (IfaceLcl aa) = do
823 put_ bh (IfaceType ab) = do
826 put_ bh (IfaceTuple ac ad) = do
830 put_ bh (IfaceLam ae af) = do
834 put_ bh (IfaceApp ag ah) = do
839 put_ bh (IfaceCase ai aj al ak) = do
846 put_ bh (IfaceLet al am) = do
850 put_ bh (IfaceNote an ao) = do
854 put_ bh (IfaceLit ap) = do
857 put_ bh (IfaceFCall as at) = do
861 put_ bh (IfaceExt aa) = do
864 put_ bh (IfaceCast ie ico) = do
874 return (IfaceType ab)
877 return (IfaceTuple ac ad)
880 return (IfaceLam ae af)
883 return (IfaceApp ag ah)
890 return (IfaceCase ai aj al ak)
893 return (IfaceLet al am)
896 return (IfaceNote an ao)
901 return (IfaceFCall as at)
902 10 -> do aa <- get bh
904 11 -> do ie <- get bh
906 return (IfaceCast ie ico)
908 instance Binary IfaceConAlt where
909 put_ bh IfaceDefault = do
911 put_ bh (IfaceDataAlt aa) = do
914 put_ bh (IfaceTupleAlt ab) = do
917 put_ bh (IfaceLitAlt ac) = do
923 0 -> do return IfaceDefault
925 return (IfaceDataAlt aa)
927 return (IfaceTupleAlt ab)
929 return (IfaceLitAlt ac)
931 instance Binary IfaceBinding where
932 put_ bh (IfaceNonRec aa ab) = do
936 put_ bh (IfaceRec ac) = do
944 return (IfaceNonRec aa ab)
948 instance Binary IfaceIdInfo where
949 put_ bh NoInfo = putByte bh 0
950 put_ bh (HasInfo i) = do
952 lazyPut bh i -- NB lazyPut
958 _ -> do info <- lazyGet bh -- NB lazyGet
959 return (HasInfo info)
961 instance Binary IfaceInfoItem where
962 put_ bh (HsArity aa) = do
965 put_ bh (HsStrictness ab) = do
968 put_ bh (HsUnfold ad) = do
971 put_ bh (HsInline ad) = do
974 put_ bh HsNoCafRefs = do
976 put_ bh (HsWorker ae af) = do
986 return (HsStrictness ab)
991 4 -> do return HsNoCafRefs
994 return (HsWorker ae af)
996 instance Binary IfaceNote where
997 put_ bh (IfaceSCC aa) = do
1000 put_ bh IfaceInlineMe = do
1002 put_ bh (IfaceCoreNote s) = do
1005 put_ bh (IfaceTickBox m n) = do
1009 put_ bh (IfaceBinaryTickBox m t e) = do
1017 0 -> do aa <- get bh
1018 return (IfaceSCC aa)
1019 3 -> do return IfaceInlineMe
1020 4 -> do ac <- get bh
1021 return (IfaceCoreNote ac)
1024 return (IfaceTickBox m n)
1028 return (IfaceBinaryTickBox m t e)
1030 -------------------------------------------------------------------------
1031 -- IfaceDecl and friends
1032 -------------------------------------------------------------------------
1034 -- A bit of magic going on here: there's no need to store the OccName
1035 -- for a decl on the disk, since we can infer the namespace from the
1036 -- context; however it is useful to have the OccName in the IfaceDecl
1037 -- to avoid re-building it in various places. So we build the OccName
1038 -- when de-serialising.
1040 instance Binary IfaceDecl where
1041 put_ bh (IfaceId name ty idinfo) = do
1043 put_ bh (occNameFS name)
1046 put_ bh (IfaceForeign ae af) =
1047 error "Binary.put_(IfaceDecl): IfaceForeign"
1048 put_ bh (IfaceData a1 a2 a3 a4 a5 a6 a7 a8) = do
1050 put_ bh (occNameFS a1)
1058 put_ bh (IfaceSyn aq ar as at) = do
1060 put_ bh (occNameFS aq)
1064 put_ bh (IfaceClass a1 a2 a3 a4 a5 a6 a7) = do
1067 put_ bh (occNameFS a2)
1076 0 -> do name <- get bh
1079 occ <- return $! mkOccNameFS varName name
1080 return (IfaceId occ ty idinfo)
1081 1 -> error "Binary.get(TyClDecl): ForeignType"
1091 occ <- return $! mkOccNameFS tcName a1
1092 return (IfaceData occ a2 a3 a4 a5 a6 a7 a8)
1098 occ <- return $! mkOccNameFS tcName aq
1099 return (IfaceSyn occ ar as at)
1108 occ <- return $! mkOccNameFS clsName a2
1109 return (IfaceClass a1 occ a3 a4 a5 a6 a7)
1111 instance Binary IfaceInst where
1112 put_ bh (IfaceInst cls tys dfun flag orph) = do
1118 get bh = do cls <- get bh
1123 return (IfaceInst cls tys dfun flag orph)
1125 instance Binary IfaceFamInst where
1126 put_ bh (IfaceFamInst fam tys tycon) = do
1130 get bh = do fam <- get bh
1133 return (IfaceFamInst fam tys tycon)
1135 instance Binary OverlapFlag where
1136 put_ bh NoOverlap = putByte bh 0
1137 put_ bh OverlapOk = putByte bh 1
1138 put_ bh Incoherent = putByte bh 2
1139 get bh = do h <- getByte bh
1141 0 -> return NoOverlap
1142 1 -> return OverlapOk
1143 2 -> return Incoherent
1145 instance Binary IfaceConDecls where
1146 put_ bh IfAbstractTyCon = putByte bh 0
1147 put_ bh IfOpenDataTyCon = putByte bh 1
1148 put_ bh IfOpenNewTyCon = putByte bh 2
1149 put_ bh (IfDataTyCon cs) = do { putByte bh 3
1151 put_ bh (IfNewTyCon c) = do { putByte bh 4
1156 0 -> return IfAbstractTyCon
1157 1 -> return IfOpenDataTyCon
1158 2 -> return IfOpenNewTyCon
1159 3 -> do cs <- get bh
1160 return (IfDataTyCon cs)
1161 _ -> do aa <- get bh
1162 return (IfNewTyCon aa)
1164 instance Binary IfaceConDecl where
1165 put_ bh (IfCon a1 a2 a3 a4 a5 a6 a7 a8 a9) = do
1175 get bh = do a1 <- get bh
1184 return (IfCon a1 a2 a3 a4 a5 a6 a7 a8 a9)
1186 instance Binary IfaceClassOp where
1187 put_ bh (IfaceClassOp n def ty) = do
1188 put_ bh (occNameFS n)
1195 occ <- return $! mkOccNameFS varName n
1196 return (IfaceClassOp occ def ty)
1198 instance Binary IfaceRule where
1199 put_ bh (IfaceRule a1 a2 a3 a4 a5 a6 a7) = do
1215 return (IfaceRule a1 a2 a3 a4 a5 a6 a7)