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"
41 import Control.Exception
44 -- ---------------------------------------------------------------------------
45 -- Reading and writing binary interface files
47 readBinIface :: FilePath -> TcRnIf a b ModIface
48 readBinIface hi_path = do
50 (new_nc, iface) <- ioToIOEnv $ readBinIface_ hi_path nc
54 readBinIface_ :: FilePath -> NameCache -> IO (NameCache, ModIface)
55 readBinIface_ hi_path nc = do
56 bh <- Binary.readBinMem hi_path
58 -- Read the magic number to check that this really is a GHC .hi file
59 -- (This magic number does not change when we change
60 -- GHC interface file format)
62 when (magic /= binaryInterfaceMagic) $
63 throwDyn (ProgramError (
64 "magic number mismatch: old/corrupt interface file?"))
66 -- Get the dictionary pointer. We won't attempt to actually
67 -- read the dictionary until we've done the version checks below,
68 -- just in case this isn't a valid interface. In retrospect the
69 -- version should have come before the dictionary pointer, but this
70 -- is the way it was done originally, and we can't change it now.
71 dict_p <- Binary.get bh -- Get the dictionary ptr
73 -- Check the interface file version and ways.
75 let our_ver = show opt_HiVersion
76 when (check_ver /= our_ver) $
77 -- This will be caught by readIface which will emit an error
78 -- msg containing the iface module name.
79 throwDyn (ProgramError (
80 "mismatched interface file versions: expected "
81 ++ our_ver ++ ", found " ++ check_ver))
84 ignore_way <- readIORef v_IgnoreHiWay
85 way_descr <- getWayDescr
86 when (not ignore_way && check_way /= way_descr) $
87 -- This will be caught by readIface
88 -- which will emit an error msg containing the iface module name.
89 throwDyn (ProgramError (
90 "mismatched interface file ways: expected "
91 ++ way_descr ++ ", found " ++ check_way))
93 -- Read the dictionary
94 -- The next word in the file is a pointer to where the dictionary is
95 -- (probably at the end of the file)
96 data_p <- tellBin bh -- Remember where we are now
98 dict <- getDictionary bh
99 seekBin bh data_p -- Back to where we were before
101 -- Initialise the user-data field of bh
102 ud <- newReadState dict
103 bh <- return (setUserData bh ud)
105 symtab_p <- Binary.get bh -- Get the symtab ptr
106 data_p <- tellBin bh -- Remember where we are now
108 (nc', symtab) <- getSymbolTable bh nc
109 seekBin bh data_p -- Back to where we were before
110 let ud = getUserData bh
111 bh <- return $! setUserData bh ud{ud_symtab = symtab}
116 writeBinIface :: DynFlags -> FilePath -> ModIface -> IO ()
117 writeBinIface dflags hi_path mod_iface = do
118 bh <- openBinMem initBinMemSize
119 put_ bh binaryInterfaceMagic
121 -- Remember where the dictionary pointer will go
122 dict_p_p <- tellBin bh
123 put_ bh dict_p_p -- Placeholder for ptr to dictionary
125 -- The version and way descriptor go next
126 put_ bh (show opt_HiVersion)
127 way_descr <- getWayDescr
130 -- Remember where the symbol table pointer will go
131 symtab_p_p <- tellBin bh
134 -- Make some intial state
137 -- Put the main thing,
138 bh <- return $ setUserData bh ud
141 -- Write the symtab pointer at the fornt of the file
142 symtab_p <- tellBin bh -- This is where the symtab will start
143 putAt bh symtab_p_p symtab_p -- Fill in the placeholder
144 seekBin bh symtab_p -- Seek back to the end of the file
146 -- Write the symbol table itself
147 symtab_next <- readFastMutInt (ud_symtab_next ud)
148 symtab_map <- readIORef (ud_symtab_map ud)
149 putSymbolTable bh symtab_next symtab_map
150 debugTraceMsg dflags 3 (text "writeBinIface:" <+> int symtab_next
153 -- NB. write the dictionary after the symbol table, because
154 -- writing the symbol table may create more dictionary entries.
156 -- Write the dictionary pointer at the fornt of the file
157 dict_p <- tellBin bh -- This is where the dictionary will start
158 putAt bh dict_p_p dict_p -- Fill in the placeholder
159 seekBin bh dict_p -- Seek back to the end of the file
161 -- Write the dictionary itself
162 dict_next <- readFastMutInt (ud_dict_next ud)
163 dict_map <- readIORef (ud_dict_map ud)
164 putDictionary bh dict_next dict_map
165 debugTraceMsg dflags 3 (text "writeBinIface:" <+> int dict_next
166 <+> text "dict entries")
168 -- And send the result to the file
169 writeBinMem bh hi_path
171 initBinMemSize = (1024*1024) :: Int
173 -- The *host* architecture version:
174 #include "MachDeps.h"
176 #if WORD_SIZE_IN_BITS == 32
177 binaryInterfaceMagic = 0x1face :: Word32
178 #elif WORD_SIZE_IN_BITS == 64
179 binaryInterfaceMagic = 0x1face64 :: Word32
182 -- -----------------------------------------------------------------------------
185 putSymbolTable :: BinHandle -> Int -> UniqFM (Int,Name) -> IO ()
186 putSymbolTable bh next_off symtab = do
188 let names = elems (array (0,next_off-1) (eltsUFM symtab))
189 mapM_ (\n -> serialiseName bh n symtab) names
191 getSymbolTable :: BinHandle -> NameCache -> IO (NameCache, Array Int Name)
192 getSymbolTable bh namecache = do
194 od_names <- sequence (replicate sz (get bh))
196 arr = listArray (0,sz-1) names
197 (namecache', names) =
198 mapAccumR (fromOnDiskName arr) namecache od_names
200 return (namecache', arr)
202 type OnDiskName = (PackageId, ModuleName, OccName)
209 fromOnDiskName arr nc (pid, mod_name, occ) =
211 mod = mkModule pid mod_name
214 case lookupOrigNameCache cache mod occ of
215 Just name -> (nc, name)
219 uniq = uniqFromSupply us
220 name = mkExternalName uniq mod occ noSrcSpan
221 new_cache = extendNameCache cache mod occ name
223 case splitUniqSupply us of { (us',_) ->
224 ( nc{ nsUniqs = us', nsNames = new_cache }, name )
227 serialiseName :: BinHandle -> Name -> UniqFM (Int,Name) -> IO ()
228 serialiseName bh name symtab = do
229 let mod = nameModule name
230 put_ bh (modulePackageId mod, moduleName mod, nameOccName name)
232 -- -----------------------------------------------------------------------------
233 -- All the binary instances
236 {-! for IPName derive: Binary !-}
237 {-! for Fixity derive: Binary !-}
238 {-! for FixityDirection derive: Binary !-}
239 {-! for Boxity derive: Binary !-}
240 {-! for StrictnessMark derive: Binary !-}
241 {-! for Activation derive: Binary !-}
244 {-! for Demand derive: Binary !-}
245 {-! for Demands derive: Binary !-}
246 {-! for DmdResult derive: Binary !-}
247 {-! for StrictSig derive: Binary !-}
250 {-! for DefMeth derive: Binary !-}
253 {-! for HsPred derive: Binary !-}
254 {-! for HsType derive: Binary !-}
255 {-! for TupCon derive: Binary !-}
256 {-! for HsTyVarBndr derive: Binary !-}
259 {-! for UfExpr derive: Binary !-}
260 {-! for UfConAlt derive: Binary !-}
261 {-! for UfBinding derive: Binary !-}
262 {-! for UfBinder derive: Binary !-}
263 {-! for HsIdInfo derive: Binary !-}
264 {-! for UfNote derive: Binary !-}
267 {-! for ConDetails derive: Binary !-}
268 {-! for BangType derive: Binary !-}
271 {-! for IsCafCC derive: Binary !-}
272 {-! for IsDupdCC derive: Binary !-}
273 {-! for CostCentre derive: Binary !-}
277 -- ---------------------------------------------------------------------------
278 -- Reading a binary interface into ParsedIface
280 instance Binary ModIface where
284 mi_mod_vers = mod_vers,
286 mi_finsts = hasFamInsts,
289 mi_exports = exports,
290 mi_exp_vers = exp_vers,
291 mi_fixities = fixities,
292 mi_deprecs = deprecs,
295 mi_fam_insts = fam_insts,
297 mi_rule_vers = rule_vers,
298 mi_vect_info = vect_info,
299 mi_hpc = hpc_info }) = do
324 hasFamInsts <- get bh
326 usages <- {-# SCC "bin_usages" #-} lazyGet bh
327 exports <- {-# SCC "bin_exports" #-} get bh
329 fixities <- {-# SCC "bin_fixities" #-} get bh
330 deprecs <- {-# SCC "bin_deprecs" #-} lazyGet bh
331 decls <- {-# SCC "bin_tycldecls" #-} get bh
332 insts <- {-# SCC "bin_insts" #-} get bh
333 fam_insts <- {-# SCC "bin_fam_insts" #-} get bh
334 rules <- {-# SCC "bin_rules" #-} lazyGet bh
339 mi_module = mod_name,
341 mi_mod_vers = mod_vers,
343 mi_finsts = hasFamInsts,
346 mi_exports = exports,
347 mi_exp_vers = exp_vers,
348 mi_fixities = fixities,
349 mi_deprecs = deprecs,
351 mi_globals = Nothing,
353 mi_fam_insts = fam_insts,
355 mi_rule_vers = rule_vers,
356 mi_vect_info = vect_info,
358 -- And build the cached values
359 mi_dep_fn = mkIfaceDepCache deprecs,
360 mi_fix_fn = mkIfaceFixCache fixities,
361 mi_ver_fn = mkIfaceVerCache decls })
363 GLOBAL_VAR(v_IgnoreHiWay, False, Bool)
365 getWayDescr :: IO String
367 tag <- readIORef v_Build_tag
368 if cGhcUnregisterised == "YES" then return ('u':tag) else return tag
369 -- if this is an unregisterised build, make sure our interfaces
370 -- can't be used by a registerised build.
372 -------------------------------------------------------------------------
373 -- Types from: HscTypes
374 -------------------------------------------------------------------------
376 instance Binary Dependencies where
377 put_ bh deps = do put_ bh (dep_mods deps)
378 put_ bh (dep_pkgs deps)
379 put_ bh (dep_orphs deps)
380 put_ bh (dep_finsts deps)
382 get bh = do ms <- get bh
386 return (Deps { dep_mods = ms, dep_pkgs = ps, dep_orphs = os,
389 instance (Binary name) => Binary (GenAvailInfo name) where
390 put_ bh (Avail aa) = do
393 put_ bh (AvailTC ab ac) = do
404 return (AvailTC ab ac)
406 instance Binary Usage where
408 put_ bh (usg_name usg)
409 put_ bh (usg_mod usg)
410 put_ bh (usg_exports usg)
411 put_ bh (usg_entities usg)
412 put_ bh (usg_rules usg)
420 return (Usage { usg_name = nm, usg_mod = mod,
421 usg_exports = exps, usg_entities = ents,
424 instance Binary a => Binary (Deprecs a) where
425 put_ bh NoDeprecs = putByte bh 0
426 put_ bh (DeprecAll t) = do
429 put_ bh (DeprecSome ts) = do
436 0 -> return NoDeprecs
438 return (DeprecAll aa)
440 return (DeprecSome aa)
442 -------------------------------------------------------------------------
443 -- Types from: BasicTypes
444 -------------------------------------------------------------------------
446 instance Binary Activation where
447 put_ bh NeverActive = do
449 put_ bh AlwaysActive = do
451 put_ bh (ActiveBefore aa) = do
454 put_ bh (ActiveAfter ab) = do
460 0 -> do return NeverActive
461 1 -> do return AlwaysActive
463 return (ActiveBefore aa)
465 return (ActiveAfter ab)
467 instance Binary StrictnessMark where
468 put_ bh MarkedStrict = do
470 put_ bh MarkedUnboxed = do
472 put_ bh NotMarkedStrict = do
477 0 -> do return MarkedStrict
478 1 -> do return MarkedUnboxed
479 _ -> do return NotMarkedStrict
481 instance Binary Boxity where
490 _ -> do return Unboxed
492 instance Binary TupCon where
493 put_ bh (TupCon ab ac) = do
499 return (TupCon ab ac)
501 instance Binary RecFlag where
502 put_ bh Recursive = do
504 put_ bh NonRecursive = do
509 0 -> do return Recursive
510 _ -> do return NonRecursive
512 instance Binary DefMeth where
513 put_ bh NoDefMeth = putByte bh 0
514 put_ bh DefMeth = putByte bh 1
515 put_ bh GenDefMeth = putByte bh 2
519 0 -> return NoDefMeth
521 _ -> return GenDefMeth
523 instance Binary FixityDirection where
533 0 -> do return InfixL
534 1 -> do return InfixR
535 _ -> do return InfixN
537 instance Binary Fixity where
538 put_ bh (Fixity aa ab) = do
544 return (Fixity aa ab)
546 instance (Binary name) => Binary (IPName name) where
547 put_ bh (IPName aa) = put_ bh aa
548 get bh = do aa <- get bh
551 -------------------------------------------------------------------------
552 -- Types from: Demand
553 -------------------------------------------------------------------------
555 instance Binary DmdType where
556 -- Ignore DmdEnv when spitting out the DmdType
557 put bh (DmdType _ ds dr) = do p <- put bh ds; put bh dr; return (castBin p)
558 get bh = do ds <- get bh; dr <- get bh; return (DmdType emptyVarEnv ds dr)
560 instance Binary Demand where
565 put_ bh (Call aa) = do
568 put_ bh (Eval ab) = do
571 put_ bh (Defer ac) = do
574 put_ bh (Box ad) = do
594 instance Binary Demands where
595 put_ bh (Poly aa) = do
598 put_ bh (Prod ab) = do
609 instance Binary DmdResult where
619 0 -> do return TopRes
620 1 -> do return RetCPR -- Really use RetCPR even if -fcpr-off
621 -- The wrapper was generated for CPR in
622 -- the imported module!
623 _ -> do return BotRes
625 instance Binary StrictSig where
626 put_ bh (StrictSig aa) = do
630 return (StrictSig aa)
633 -------------------------------------------------------------------------
634 -- Types from: CostCentre
635 -------------------------------------------------------------------------
637 instance Binary IsCafCC where
640 put_ bh NotCafCC = do
646 _ -> do return NotCafCC
648 instance Binary IsDupdCC where
649 put_ bh OriginalCC = do
656 0 -> do return OriginalCC
657 _ -> do return DupdCC
659 instance Binary CostCentre where
660 put_ bh NoCostCentre = do
662 put_ bh (NormalCC aa ab ac ad) = do
668 put_ bh (AllCafsCC ae) = do
674 0 -> do return NoCostCentre
679 return (NormalCC aa ab ac ad)
681 return (AllCafsCC ae)
683 -------------------------------------------------------------------------
684 -- IfaceTypes and friends
685 -------------------------------------------------------------------------
687 instance Binary IfaceBndr where
688 put_ bh (IfaceIdBndr aa) = do
691 put_ bh (IfaceTvBndr ab) = do
698 return (IfaceIdBndr aa)
700 return (IfaceTvBndr ab)
702 instance Binary IfaceLetBndr where
703 put_ bh (IfLetBndr a b c) = do
707 get bh = do a <- get bh
710 return (IfLetBndr a b c)
712 instance Binary IfaceType where
713 put_ bh (IfaceForAllTy aa ab) = do
717 put_ bh (IfaceTyVar ad) = do
720 put_ bh (IfaceAppTy ae af) = do
724 put_ bh (IfaceFunTy ag ah) = do
728 put_ bh (IfacePredTy aq) = do
732 -- Simple compression for common cases of TyConApp
733 put_ bh (IfaceTyConApp IfaceIntTc []) = putByte bh 6
734 put_ bh (IfaceTyConApp IfaceCharTc []) = putByte bh 7
735 put_ bh (IfaceTyConApp IfaceBoolTc []) = putByte bh 8
736 put_ bh (IfaceTyConApp IfaceListTc [ty]) = do { putByte bh 9; put_ bh ty }
737 -- Unit tuple and pairs
738 put_ bh (IfaceTyConApp (IfaceTupTc Boxed 0) []) = putByte bh 10
739 put_ bh (IfaceTyConApp (IfaceTupTc Boxed 2) [t1,t2]) = do { putByte bh 11; put_ bh t1; put_ bh t2 }
741 put_ bh (IfaceTyConApp IfaceLiftedTypeKindTc []) = putByte bh 12
742 put_ bh (IfaceTyConApp IfaceOpenTypeKindTc []) = putByte bh 13
743 put_ bh (IfaceTyConApp IfaceUnliftedTypeKindTc []) = putByte bh 14
744 put_ bh (IfaceTyConApp IfaceUbxTupleKindTc []) = putByte bh 15
745 put_ bh (IfaceTyConApp IfaceArgTypeKindTc []) = putByte bh 16
749 put_ bh (IfaceTyConApp (IfaceTc tc) tys) = do { putByte bh 18; put_ bh tc; put_ bh tys }
750 put_ bh (IfaceTyConApp tc tys) = do { putByte bh 19; put_ bh tc; put_ bh tys }
757 return (IfaceForAllTy aa ab)
759 return (IfaceTyVar ad)
762 return (IfaceAppTy ae af)
765 return (IfaceFunTy ag ah)
767 return (IfacePredTy ap)
769 -- Now the special cases for TyConApp
770 6 -> return (IfaceTyConApp IfaceIntTc [])
771 7 -> return (IfaceTyConApp IfaceCharTc [])
772 8 -> return (IfaceTyConApp IfaceBoolTc [])
773 9 -> do { ty <- get bh; return (IfaceTyConApp IfaceListTc [ty]) }
774 10 -> return (IfaceTyConApp (IfaceTupTc Boxed 0) [])
775 11 -> do { t1 <- get bh; t2 <- get bh; return (IfaceTyConApp (IfaceTupTc Boxed 2) [t1,t2]) }
776 12 -> return (IfaceTyConApp IfaceLiftedTypeKindTc [])
777 13 -> return (IfaceTyConApp IfaceOpenTypeKindTc [])
778 14 -> return (IfaceTyConApp IfaceUnliftedTypeKindTc [])
779 15 -> return (IfaceTyConApp IfaceUbxTupleKindTc [])
780 16 -> return (IfaceTyConApp IfaceArgTypeKindTc [])
782 18 -> do { tc <- get bh; tys <- get bh; return (IfaceTyConApp (IfaceTc tc) tys) }
783 _ -> do { tc <- get bh; tys <- get bh; return (IfaceTyConApp tc tys) }
785 instance Binary IfaceTyCon where
786 -- Int,Char,Bool can't show up here because they can't not be saturated
788 put_ bh IfaceIntTc = putByte bh 1
789 put_ bh IfaceBoolTc = putByte bh 2
790 put_ bh IfaceCharTc = putByte bh 3
791 put_ bh IfaceListTc = putByte bh 4
792 put_ bh IfacePArrTc = putByte bh 5
793 put_ bh IfaceLiftedTypeKindTc = putByte bh 6
794 put_ bh IfaceOpenTypeKindTc = putByte bh 7
795 put_ bh IfaceUnliftedTypeKindTc = putByte bh 8
796 put_ bh IfaceUbxTupleKindTc = putByte bh 9
797 put_ bh IfaceArgTypeKindTc = putByte bh 10
798 put_ bh (IfaceTupTc bx ar) = do { putByte bh 11; put_ bh bx; put_ bh ar }
799 put_ bh (IfaceTc ext) = do { putByte bh 12; put_ bh ext }
804 1 -> return IfaceIntTc
805 2 -> return IfaceBoolTc
806 3 -> return IfaceCharTc
807 4 -> return IfaceListTc
808 5 -> return IfacePArrTc
809 6 -> return IfaceLiftedTypeKindTc
810 7 -> return IfaceOpenTypeKindTc
811 8 -> return IfaceUnliftedTypeKindTc
812 9 -> return IfaceUbxTupleKindTc
813 10 -> return IfaceArgTypeKindTc
814 11 -> do { bx <- get bh; ar <- get bh; return (IfaceTupTc bx ar) }
815 _ -> do { ext <- get bh; return (IfaceTc ext) }
817 instance Binary IfacePredType where
818 put_ bh (IfaceClassP aa ab) = do
822 put_ bh (IfaceIParam ac ad) = do
826 put_ bh (IfaceEqPred ac ad) = do
835 return (IfaceClassP aa ab)
838 return (IfaceIParam ac ad)
841 return (IfaceEqPred ac ad)
843 -------------------------------------------------------------------------
844 -- IfaceExpr and friends
845 -------------------------------------------------------------------------
847 instance Binary IfaceExpr where
848 put_ bh (IfaceLcl aa) = do
851 put_ bh (IfaceType ab) = do
854 put_ bh (IfaceTuple ac ad) = do
858 put_ bh (IfaceLam ae af) = do
862 put_ bh (IfaceApp ag ah) = do
867 put_ bh (IfaceCase ai aj al ak) = do
874 put_ bh (IfaceLet al am) = do
878 put_ bh (IfaceNote an ao) = do
882 put_ bh (IfaceLit ap) = do
885 put_ bh (IfaceFCall as at) = do
889 put_ bh (IfaceExt aa) = do
892 put_ bh (IfaceCast ie ico) = do
896 put_ bh (IfaceTick m ix) = do
906 return (IfaceType ab)
909 return (IfaceTuple ac ad)
912 return (IfaceLam ae af)
915 return (IfaceApp ag ah)
922 return (IfaceCase ai aj al ak)
925 return (IfaceLet al am)
928 return (IfaceNote an ao)
933 return (IfaceFCall as at)
934 10 -> do aa <- get bh
936 11 -> do ie <- get bh
938 return (IfaceCast ie ico)
941 return (IfaceTick m ix)
943 instance Binary IfaceConAlt where
944 put_ bh IfaceDefault = do
946 put_ bh (IfaceDataAlt aa) = do
949 put_ bh (IfaceTupleAlt ab) = do
952 put_ bh (IfaceLitAlt ac) = do
958 0 -> do return IfaceDefault
960 return (IfaceDataAlt aa)
962 return (IfaceTupleAlt ab)
964 return (IfaceLitAlt ac)
966 instance Binary IfaceBinding where
967 put_ bh (IfaceNonRec aa ab) = do
971 put_ bh (IfaceRec ac) = do
979 return (IfaceNonRec aa ab)
983 instance Binary IfaceIdInfo where
984 put_ bh NoInfo = putByte bh 0
985 put_ bh (HasInfo i) = do
987 lazyPut bh i -- NB lazyPut
993 _ -> do info <- lazyGet bh -- NB lazyGet
994 return (HasInfo info)
996 instance Binary IfaceInfoItem where
997 put_ bh (HsArity aa) = do
1000 put_ bh (HsStrictness ab) = do
1003 put_ bh (HsUnfold ad) = do
1006 put_ bh (HsInline ad) = do
1009 put_ bh HsNoCafRefs = do
1011 put_ bh (HsWorker ae af) = do
1018 0 -> do aa <- get bh
1020 1 -> do ab <- get bh
1021 return (HsStrictness ab)
1022 2 -> do ad <- get bh
1023 return (HsUnfold ad)
1024 3 -> do ad <- get bh
1025 return (HsInline ad)
1026 4 -> do return HsNoCafRefs
1027 _ -> do ae <- get bh
1029 return (HsWorker ae af)
1031 instance Binary IfaceNote where
1032 put_ bh (IfaceSCC aa) = do
1035 put_ bh IfaceInlineMe = do
1037 put_ bh (IfaceCoreNote s) = do
1043 0 -> do aa <- get bh
1044 return (IfaceSCC aa)
1045 3 -> do return IfaceInlineMe
1046 4 -> do ac <- get bh
1047 return (IfaceCoreNote ac)
1049 -------------------------------------------------------------------------
1050 -- IfaceDecl and friends
1051 -------------------------------------------------------------------------
1053 -- A bit of magic going on here: there's no need to store the OccName
1054 -- for a decl on the disk, since we can infer the namespace from the
1055 -- context; however it is useful to have the OccName in the IfaceDecl
1056 -- to avoid re-building it in various places. So we build the OccName
1057 -- when de-serialising.
1059 instance Binary IfaceDecl where
1060 put_ bh (IfaceId name ty idinfo) = do
1062 put_ bh (occNameFS name)
1065 put_ bh (IfaceForeign ae af) =
1066 error "Binary.put_(IfaceDecl): IfaceForeign"
1067 put_ bh (IfaceData a1 a2 a3 a4 a5 a6 a7 a8) = do
1069 put_ bh (occNameFS a1)
1077 put_ bh (IfaceSyn a1 a2 a3 a4 a5) = do
1079 put_ bh (occNameFS a1)
1084 put_ bh (IfaceClass a1 a2 a3 a4 a5 a6 a7) = do
1087 put_ bh (occNameFS a2)
1096 0 -> do name <- get bh
1099 occ <- return $! mkOccNameFS varName name
1100 return (IfaceId occ ty idinfo)
1101 1 -> error "Binary.get(TyClDecl): ForeignType"
1111 occ <- return $! mkOccNameFS tcName a1
1112 return (IfaceData occ a2 a3 a4 a5 a6 a7 a8)
1119 occ <- return $! mkOccNameFS tcName a1
1120 return (IfaceSyn occ a2 a3 a4 a5)
1129 occ <- return $! mkOccNameFS clsName a2
1130 return (IfaceClass a1 occ a3 a4 a5 a6 a7)
1132 instance Binary IfaceInst where
1133 put_ bh (IfaceInst cls tys dfun flag orph) = do
1139 get bh = do cls <- get bh
1144 return (IfaceInst cls tys dfun flag orph)
1146 instance Binary IfaceFamInst where
1147 put_ bh (IfaceFamInst fam tys tycon) = do
1151 get bh = do fam <- get bh
1154 return (IfaceFamInst fam tys tycon)
1156 instance Binary OverlapFlag where
1157 put_ bh NoOverlap = putByte bh 0
1158 put_ bh OverlapOk = putByte bh 1
1159 put_ bh Incoherent = putByte bh 2
1160 get bh = do h <- getByte bh
1162 0 -> return NoOverlap
1163 1 -> return OverlapOk
1164 2 -> return Incoherent
1166 instance Binary IfaceConDecls where
1167 put_ bh IfAbstractTyCon = putByte bh 0
1168 put_ bh IfOpenDataTyCon = putByte bh 1
1169 put_ bh (IfDataTyCon cs) = do { putByte bh 2
1171 put_ bh (IfNewTyCon c) = do { putByte bh 3
1176 0 -> return IfAbstractTyCon
1177 1 -> return IfOpenDataTyCon
1178 2 -> do cs <- get bh
1179 return (IfDataTyCon cs)
1180 _ -> do aa <- get bh
1181 return (IfNewTyCon aa)
1183 instance Binary IfaceConDecl where
1184 put_ bh (IfCon a1 a2 a3 a4 a5 a6 a7 a8 a9) = do
1194 get bh = do a1 <- get bh
1203 return (IfCon a1 a2 a3 a4 a5 a6 a7 a8 a9)
1205 instance Binary IfaceClassOp where
1206 put_ bh (IfaceClassOp n def ty) = do
1207 put_ bh (occNameFS n)
1214 occ <- return $! mkOccNameFS varName n
1215 return (IfaceClassOp occ def ty)
1217 instance Binary IfaceRule where
1218 put_ bh (IfaceRule a1 a2 a3 a4 a5 a6 a7) = do
1234 return (IfaceRule a1 a2 a3 a4 a5 a6 a7)
1236 instance Binary IfaceVectInfo where
1237 put_ bh (IfaceVectInfo a1 a2 a3) = do
1245 return (IfaceVectInfo a1 a2 a3)