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,
256 mi_exports = exports,
257 mi_exp_vers = exp_vers,
258 mi_fixities = fixities,
259 mi_deprecs = deprecs,
262 mi_fam_insts = fam_insts,
264 mi_rule_vers = rule_vers }) = do
265 put_ bh (show opt_HiVersion)
266 way_descr <- getWayDescr
286 let our_ver = show opt_HiVersion
287 when (check_ver /= our_ver) $
288 -- use userError because this will be caught by readIface
289 -- which will emit an error msg containing the iface module name.
290 throwDyn (ProgramError (
291 "mismatched interface file versions: expected "
292 ++ our_ver ++ ", found " ++ check_ver))
295 ignore_way <- readIORef v_IgnoreHiWay
296 way_descr <- getWayDescr
297 when (not ignore_way && check_way /= way_descr) $
298 -- use userError because this will be caught by readIface
299 -- which will emit an error msg containing the iface module name.
300 throwDyn (ProgramError (
301 "mismatched interface file ways: expected "
302 ++ way_descr ++ ", found " ++ check_way))
309 usages <- {-# SCC "bin_usages" #-} lazyGet bh
310 exports <- {-# SCC "bin_exports" #-} get bh
312 fixities <- {-# SCC "bin_fixities" #-} get bh
313 deprecs <- {-# SCC "bin_deprecs" #-} lazyGet bh
314 decls <- {-# SCC "bin_tycldecls" #-} get bh
315 insts <- {-# SCC "bin_insts" #-} get bh
316 fam_insts <- {-# SCC "bin_fam_insts" #-} get bh
317 rules <- {-# SCC "bin_rules" #-} lazyGet bh
320 mi_module = mod_name,
322 mi_mod_vers = mod_vers,
326 mi_exports = exports,
327 mi_exp_vers = exp_vers,
328 mi_fixities = fixities,
329 mi_deprecs = deprecs,
331 mi_globals = Nothing,
333 mi_fam_insts = fam_insts,
335 mi_rule_vers = rule_vers,
336 -- And build the cached values
337 mi_dep_fn = mkIfaceDepCache deprecs,
338 mi_fix_fn = mkIfaceFixCache fixities,
339 mi_ver_fn = mkIfaceVerCache decls })
341 GLOBAL_VAR(v_IgnoreHiWay, False, Bool)
343 getWayDescr :: IO String
345 tag <- readIORef v_Build_tag
346 if cGhcUnregisterised == "YES" then return ('u':tag) else return tag
347 -- if this is an unregisterised build, make sure our interfaces
348 -- can't be used by a registerised build.
350 -------------------------------------------------------------------------
351 -- Types from: HscTypes
352 -------------------------------------------------------------------------
354 instance Binary Dependencies where
355 put_ bh deps = do put_ bh (dep_mods deps)
356 put_ bh (dep_pkgs deps)
357 put_ bh (dep_orphs deps)
359 get bh = do ms <- get bh
362 return (Deps { dep_mods = ms, dep_pkgs = ps, dep_orphs = os })
364 instance (Binary name) => Binary (GenAvailInfo name) where
365 put_ bh (Avail aa) = do
368 put_ bh (AvailTC ab ac) = do
379 return (AvailTC ab ac)
381 instance Binary Usage where
383 put_ bh (usg_name usg)
384 put_ bh (usg_mod usg)
385 put_ bh (usg_exports usg)
386 put_ bh (usg_entities usg)
387 put_ bh (usg_rules usg)
395 return (Usage { usg_name = nm, usg_mod = mod,
396 usg_exports = exps, usg_entities = ents,
399 instance Binary a => Binary (Deprecs a) where
400 put_ bh NoDeprecs = putByte bh 0
401 put_ bh (DeprecAll t) = do
404 put_ bh (DeprecSome ts) = do
411 0 -> return NoDeprecs
413 return (DeprecAll aa)
415 return (DeprecSome aa)
417 -------------------------------------------------------------------------
418 -- Types from: BasicTypes
419 -------------------------------------------------------------------------
421 instance Binary Activation where
422 put_ bh NeverActive = do
424 put_ bh AlwaysActive = do
426 put_ bh (ActiveBefore aa) = do
429 put_ bh (ActiveAfter ab) = do
435 0 -> do return NeverActive
436 1 -> do return AlwaysActive
438 return (ActiveBefore aa)
440 return (ActiveAfter ab)
442 instance Binary StrictnessMark where
443 put_ bh MarkedStrict = do
445 put_ bh MarkedUnboxed = do
447 put_ bh NotMarkedStrict = do
452 0 -> do return MarkedStrict
453 1 -> do return MarkedUnboxed
454 _ -> do return NotMarkedStrict
456 instance Binary Boxity where
465 _ -> do return Unboxed
467 instance Binary TupCon where
468 put_ bh (TupCon ab ac) = do
474 return (TupCon ab ac)
476 instance Binary RecFlag where
477 put_ bh Recursive = do
479 put_ bh NonRecursive = do
484 0 -> do return Recursive
485 _ -> do return NonRecursive
487 instance Binary DefMeth where
488 put_ bh NoDefMeth = putByte bh 0
489 put_ bh DefMeth = putByte bh 1
490 put_ bh GenDefMeth = putByte bh 2
494 0 -> return NoDefMeth
496 _ -> return GenDefMeth
498 instance Binary FixityDirection where
508 0 -> do return InfixL
509 1 -> do return InfixR
510 _ -> do return InfixN
512 instance Binary Fixity where
513 put_ bh (Fixity aa ab) = do
519 return (Fixity aa ab)
521 instance (Binary name) => Binary (IPName name) where
522 put_ bh (IPName aa) = put_ bh aa
523 get bh = do aa <- get bh
526 -------------------------------------------------------------------------
527 -- Types from: Demand
528 -------------------------------------------------------------------------
530 instance Binary DmdType where
531 -- Ignore DmdEnv when spitting out the DmdType
532 put bh (DmdType _ ds dr) = do p <- put bh ds; put bh dr; return (castBin p)
533 get bh = do ds <- get bh; dr <- get bh; return (DmdType emptyVarEnv ds dr)
535 instance Binary Demand where
540 put_ bh (Call aa) = do
543 put_ bh (Eval ab) = do
546 put_ bh (Defer ac) = do
549 put_ bh (Box ad) = do
569 instance Binary Demands where
570 put_ bh (Poly aa) = do
573 put_ bh (Prod ab) = do
584 instance Binary DmdResult where
594 0 -> do return TopRes
595 1 -> do return RetCPR -- Really use RetCPR even if -fcpr-off
596 -- The wrapper was generated for CPR in
597 -- the imported module!
598 _ -> do return BotRes
600 instance Binary StrictSig where
601 put_ bh (StrictSig aa) = do
605 return (StrictSig aa)
608 -------------------------------------------------------------------------
609 -- Types from: CostCentre
610 -------------------------------------------------------------------------
612 instance Binary IsCafCC where
615 put_ bh NotCafCC = do
621 _ -> do return NotCafCC
623 instance Binary IsDupdCC where
624 put_ bh OriginalCC = do
631 0 -> do return OriginalCC
632 _ -> do return DupdCC
634 instance Binary CostCentre where
635 put_ bh NoCostCentre = do
637 put_ bh (NormalCC aa ab ac ad) = do
643 put_ bh (AllCafsCC ae) = do
649 0 -> do return NoCostCentre
654 return (NormalCC aa ab ac ad)
656 return (AllCafsCC ae)
658 -------------------------------------------------------------------------
659 -- IfaceTypes and friends
660 -------------------------------------------------------------------------
662 instance Binary IfaceBndr where
663 put_ bh (IfaceIdBndr aa) = do
666 put_ bh (IfaceTvBndr ab) = do
673 return (IfaceIdBndr aa)
675 return (IfaceTvBndr ab)
677 instance Binary IfaceType where
678 put_ bh (IfaceForAllTy aa ab) = do
682 put_ bh (IfaceTyVar ad) = do
685 put_ bh (IfaceAppTy ae af) = do
689 put_ bh (IfaceFunTy ag ah) = do
693 put_ bh (IfacePredTy aq) = do
697 -- Simple compression for common cases of TyConApp
698 put_ bh (IfaceTyConApp IfaceIntTc []) = putByte bh 6
699 put_ bh (IfaceTyConApp IfaceCharTc []) = putByte bh 7
700 put_ bh (IfaceTyConApp IfaceBoolTc []) = putByte bh 8
701 put_ bh (IfaceTyConApp IfaceListTc [ty]) = do { putByte bh 9; put_ bh ty }
702 -- Unit tuple and pairs
703 put_ bh (IfaceTyConApp (IfaceTupTc Boxed 0) []) = putByte bh 10
704 put_ bh (IfaceTyConApp (IfaceTupTc Boxed 2) [t1,t2]) = do { putByte bh 11; put_ bh t1; put_ bh t2 }
706 put_ bh (IfaceTyConApp IfaceLiftedTypeKindTc []) = putByte bh 12
707 put_ bh (IfaceTyConApp IfaceOpenTypeKindTc []) = putByte bh 13
708 put_ bh (IfaceTyConApp IfaceUnliftedTypeKindTc []) = putByte bh 14
709 put_ bh (IfaceTyConApp IfaceUbxTupleKindTc []) = putByte bh 15
710 put_ bh (IfaceTyConApp IfaceArgTypeKindTc []) = putByte bh 16
714 put_ bh (IfaceTyConApp (IfaceTc tc) tys) = do { putByte bh 18; put_ bh tc; put_ bh tys }
715 put_ bh (IfaceTyConApp tc tys) = do { putByte bh 19; put_ bh tc; put_ bh tys }
722 return (IfaceForAllTy aa ab)
724 return (IfaceTyVar ad)
727 return (IfaceAppTy ae af)
730 return (IfaceFunTy ag ah)
732 return (IfacePredTy ap)
734 -- Now the special cases for TyConApp
735 6 -> return (IfaceTyConApp IfaceIntTc [])
736 7 -> return (IfaceTyConApp IfaceCharTc [])
737 8 -> return (IfaceTyConApp IfaceBoolTc [])
738 9 -> do { ty <- get bh; return (IfaceTyConApp IfaceListTc [ty]) }
739 10 -> return (IfaceTyConApp (IfaceTupTc Boxed 0) [])
740 11 -> do { t1 <- get bh; t2 <- get bh; return (IfaceTyConApp (IfaceTupTc Boxed 2) [t1,t2]) }
741 12 -> return (IfaceTyConApp IfaceLiftedTypeKindTc [])
742 13 -> return (IfaceTyConApp IfaceOpenTypeKindTc [])
743 14 -> return (IfaceTyConApp IfaceUnliftedTypeKindTc [])
744 15 -> return (IfaceTyConApp IfaceUbxTupleKindTc [])
745 16 -> return (IfaceTyConApp IfaceArgTypeKindTc [])
747 18 -> do { tc <- get bh; tys <- get bh; return (IfaceTyConApp (IfaceTc tc) tys) }
748 _ -> do { tc <- get bh; tys <- get bh; return (IfaceTyConApp tc tys) }
750 instance Binary IfaceTyCon where
751 -- Int,Char,Bool can't show up here because they can't not be saturated
753 put_ bh IfaceIntTc = putByte bh 1
754 put_ bh IfaceBoolTc = putByte bh 2
755 put_ bh IfaceCharTc = putByte bh 3
756 put_ bh IfaceListTc = putByte bh 4
757 put_ bh IfacePArrTc = putByte bh 5
758 put_ bh IfaceLiftedTypeKindTc = putByte bh 6
759 put_ bh IfaceOpenTypeKindTc = putByte bh 7
760 put_ bh IfaceUnliftedTypeKindTc = putByte bh 8
761 put_ bh IfaceUbxTupleKindTc = putByte bh 9
762 put_ bh IfaceArgTypeKindTc = putByte bh 10
763 put_ bh (IfaceTupTc bx ar) = do { putByte bh 11; put_ bh bx; put_ bh ar }
764 put_ bh (IfaceTc ext) = do { putByte bh 12; put_ bh ext }
769 1 -> return IfaceIntTc
770 2 -> return IfaceBoolTc
771 3 -> return IfaceCharTc
772 4 -> return IfaceListTc
773 5 -> return IfacePArrTc
774 6 -> return IfaceLiftedTypeKindTc
775 7 -> return IfaceOpenTypeKindTc
776 8 -> return IfaceUnliftedTypeKindTc
777 9 -> return IfaceUbxTupleKindTc
778 10 -> return IfaceArgTypeKindTc
779 11 -> do { bx <- get bh; ar <- get bh; return (IfaceTupTc bx ar) }
780 _ -> do { ext <- get bh; return (IfaceTc ext) }
782 instance Binary IfacePredType where
783 put_ bh (IfaceClassP aa ab) = do
787 put_ bh (IfaceIParam ac ad) = do
791 put_ bh (IfaceEqPred ac ad) = do
800 return (IfaceClassP aa ab)
803 return (IfaceIParam ac ad)
806 return (IfaceEqPred ac ad)
808 -------------------------------------------------------------------------
809 -- IfaceExpr and friends
810 -------------------------------------------------------------------------
812 instance Binary IfaceExpr where
813 put_ bh (IfaceLcl aa) = do
816 put_ bh (IfaceType ab) = do
819 put_ bh (IfaceTuple ac ad) = do
823 put_ bh (IfaceLam ae af) = do
827 put_ bh (IfaceApp ag ah) = do
832 put_ bh (IfaceCase ai aj al ak) = do
839 put_ bh (IfaceLet al am) = do
843 put_ bh (IfaceNote an ao) = do
847 put_ bh (IfaceLit ap) = do
850 put_ bh (IfaceFCall as at) = do
854 put_ bh (IfaceExt aa) = do
857 put_ bh (IfaceCast ie ico) = do
867 return (IfaceType ab)
870 return (IfaceTuple ac ad)
873 return (IfaceLam ae af)
876 return (IfaceApp ag ah)
883 return (IfaceCase ai aj al ak)
886 return (IfaceLet al am)
889 return (IfaceNote an ao)
894 return (IfaceFCall as at)
895 10 -> do aa <- get bh
897 11 -> do ie <- get bh
899 return (IfaceCast ie ico)
901 instance Binary IfaceConAlt where
902 put_ bh IfaceDefault = do
904 put_ bh (IfaceDataAlt aa) = do
907 put_ bh (IfaceTupleAlt ab) = do
910 put_ bh (IfaceLitAlt ac) = do
916 0 -> do return IfaceDefault
918 return (IfaceDataAlt aa)
920 return (IfaceTupleAlt ab)
922 return (IfaceLitAlt ac)
924 instance Binary IfaceBinding where
925 put_ bh (IfaceNonRec aa ab) = do
929 put_ bh (IfaceRec ac) = do
937 return (IfaceNonRec aa ab)
941 instance Binary IfaceIdInfo where
942 put_ bh NoInfo = putByte bh 0
943 put_ bh (HasInfo i) = do
945 lazyPut bh i -- NB lazyPut
951 _ -> do info <- lazyGet bh -- NB lazyGet
952 return (HasInfo info)
954 instance Binary IfaceInfoItem where
955 put_ bh (HsArity aa) = do
958 put_ bh (HsStrictness ab) = do
961 put_ bh (HsUnfold ad) = do
964 put_ bh (HsInline ad) = do
967 put_ bh HsNoCafRefs = do
969 put_ bh (HsWorker ae af) = do
979 return (HsStrictness ab)
984 4 -> do return HsNoCafRefs
987 return (HsWorker ae af)
989 instance Binary IfaceNote where
990 put_ bh (IfaceSCC aa) = do
993 put_ bh IfaceInlineMe = do
995 put_ bh (IfaceCoreNote s) = do
1001 0 -> do aa <- get bh
1002 return (IfaceSCC aa)
1003 3 -> do return IfaceInlineMe
1004 4 -> do ac <- get bh
1005 return (IfaceCoreNote ac)
1008 -------------------------------------------------------------------------
1009 -- IfaceDecl and friends
1010 -------------------------------------------------------------------------
1012 -- A bit of magic going on here: there's no need to store the OccName
1013 -- for a decl on the disk, since we can infer the namespace from the
1014 -- context; however it is useful to have the OccName in the IfaceDecl
1015 -- to avoid re-building it in various places. So we build the OccName
1016 -- when de-serialising.
1018 instance Binary IfaceDecl where
1019 put_ bh (IfaceId name ty idinfo) = do
1021 put_ bh (occNameFS name)
1024 put_ bh (IfaceForeign ae af) =
1025 error "Binary.put_(IfaceDecl): IfaceForeign"
1026 put_ bh (IfaceData a1 a2 a3 a4 a5 a6 a7 a8) = do
1028 put_ bh (occNameFS a1)
1036 put_ bh (IfaceSyn aq ar as at) = do
1038 put_ bh (occNameFS aq)
1042 put_ bh (IfaceClass a1 a2 a3 a4 a5 a6 a7) = do
1045 put_ bh (occNameFS a2)
1054 0 -> do name <- get bh
1057 occ <- return $! mkOccNameFS varName name
1058 return (IfaceId occ ty idinfo)
1059 1 -> error "Binary.get(TyClDecl): ForeignType"
1069 occ <- return $! mkOccNameFS tcName a1
1070 return (IfaceData occ a2 a3 a4 a5 a6 a7 a8)
1076 occ <- return $! mkOccNameFS tcName aq
1077 return (IfaceSyn occ ar as at)
1086 occ <- return $! mkOccNameFS clsName a2
1087 return (IfaceClass a1 occ a3 a4 a5 a6 a7)
1089 instance Binary IfaceInst where
1090 put_ bh (IfaceInst cls tys dfun flag orph) = do
1096 get bh = do cls <- get bh
1101 return (IfaceInst cls tys dfun flag orph)
1103 instance Binary IfaceFamInst where
1104 put_ bh (IfaceFamInst fam tys tycon) = do
1108 get bh = do fam <- get bh
1111 return (IfaceFamInst fam tys tycon)
1113 instance Binary OverlapFlag where
1114 put_ bh NoOverlap = putByte bh 0
1115 put_ bh OverlapOk = putByte bh 1
1116 put_ bh Incoherent = putByte bh 2
1117 get bh = do h <- getByte bh
1119 0 -> return NoOverlap
1120 1 -> return OverlapOk
1121 2 -> return Incoherent
1123 instance Binary IfaceConDecls where
1124 put_ bh IfAbstractTyCon = putByte bh 0
1125 put_ bh IfOpenDataTyCon = putByte bh 1
1126 put_ bh IfOpenNewTyCon = putByte bh 2
1127 put_ bh (IfDataTyCon cs) = do { putByte bh 3
1129 put_ bh (IfNewTyCon c) = do { putByte bh 4
1134 0 -> return IfAbstractTyCon
1135 1 -> return IfOpenDataTyCon
1136 2 -> return IfOpenNewTyCon
1137 3 -> do cs <- get bh
1138 return (IfDataTyCon cs)
1139 _ -> do aa <- get bh
1140 return (IfNewTyCon aa)
1142 instance Binary IfaceConDecl where
1143 put_ bh (IfCon a1 a2 a3 a4 a5 a6 a7 a8 a9) = do
1153 get bh = do a1 <- get bh
1162 return (IfCon a1 a2 a3 a4 a5 a6 a7 a8 a9)
1164 instance Binary IfaceClassOp where
1165 put_ bh (IfaceClassOp n def ty) = do
1166 put_ bh (occNameFS n)
1173 occ <- return $! mkOccNameFS varName n
1174 return (IfaceClassOp occ def ty)
1176 instance Binary IfaceRule where
1177 put_ bh (IfaceRule a1 a2 a3 a4 a5 a6 a7) = do
1193 return (IfaceRule a1 a2 a3 a4 a5 a6 a7)