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 -- Get the dictionary pointer. We won't attempt to actually
66 -- read the dictionary until we've done the version checks below,
67 -- just in case this isn't a valid interface. In retrospect the
68 -- version should have come before the dictionary pointer, but this
69 -- is the way it was done originally, and we can't change it now.
70 dict_p <- Binary.get bh -- Get the dictionary ptr
72 -- Check the interface file version and ways.
74 let our_ver = show opt_HiVersion
75 when (check_ver /= our_ver) $
76 -- This will be caught by readIface which will emit an error
77 -- msg containing the iface module name.
78 throwDyn (ProgramError (
79 "mismatched interface file versions: expected "
80 ++ our_ver ++ ", found " ++ check_ver))
83 ignore_way <- readIORef v_IgnoreHiWay
84 way_descr <- getWayDescr
85 when (not ignore_way && check_way /= way_descr) $
86 -- This will be caught by readIface
87 -- which will emit an error msg containing the iface module name.
88 throwDyn (ProgramError (
89 "mismatched interface file ways: expected "
90 ++ way_descr ++ ", found " ++ check_way))
92 -- Read the dictionary
93 -- The next word in the file is a pointer to where the dictionary is
94 -- (probably at the end of the file)
95 data_p <- tellBin bh -- Remember where we are now
97 dict <- getDictionary bh
98 seekBin bh data_p -- Back to where we were before
100 -- Initialise the user-data field of bh
101 ud <- newReadState dict
102 bh <- return (setUserData bh ud)
104 symtab_p <- Binary.get bh -- Get the symtab ptr
105 data_p <- tellBin bh -- Remember where we are now
107 (nc', symtab) <- getSymbolTable bh nc
108 seekBin bh data_p -- Back to where we were before
109 let ud = getUserData bh
110 bh <- return $! setUserData bh ud{ud_symtab = symtab}
115 writeBinIface :: DynFlags -> FilePath -> ModIface -> IO ()
116 writeBinIface dflags hi_path mod_iface = do
117 bh <- openBinMem initBinMemSize
118 put_ bh binaryInterfaceMagic
120 -- Remember where the dictionary pointer will go
121 dict_p_p <- tellBin bh
122 put_ bh dict_p_p -- Placeholder for ptr to dictionary
124 -- The version and way descriptor go next
125 put_ bh (show opt_HiVersion)
126 way_descr <- getWayDescr
129 -- Remember where the symbol table pointer will go
130 symtab_p_p <- tellBin bh
133 -- Make some intial state
136 -- Put the main thing,
137 bh <- return $ setUserData bh ud
140 -- Write the symtab pointer at the fornt of the file
141 symtab_p <- tellBin bh -- This is where the symtab will start
142 putAt bh symtab_p_p symtab_p -- Fill in the placeholder
143 seekBin bh symtab_p -- Seek back to the end of the file
145 -- Write the symbol table itself
146 symtab_next <- readFastMutInt (ud_symtab_next ud)
147 symtab_map <- readIORef (ud_symtab_map ud)
148 putSymbolTable bh symtab_next symtab_map
149 debugTraceMsg dflags 3 (text "writeBinIface:" <+> int symtab_next
152 -- NB. write the dictionary after the symbol table, because
153 -- writing the symbol table may create more dictionary entries.
155 -- Write the dictionary pointer at the fornt of the file
156 dict_p <- tellBin bh -- This is where the dictionary will start
157 putAt bh dict_p_p dict_p -- Fill in the placeholder
158 seekBin bh dict_p -- Seek back to the end of the file
160 -- Write the dictionary itself
161 dict_next <- readFastMutInt (ud_dict_next ud)
162 dict_map <- readIORef (ud_dict_map ud)
163 putDictionary bh dict_next dict_map
164 debugTraceMsg dflags 3 (text "writeBinIface:" <+> int dict_next
165 <+> text "dict entries")
167 -- And send the result to the file
168 writeBinMem bh hi_path
170 initBinMemSize = (1024*1024) :: Int
172 -- The *host* architecture version:
173 #include "MachDeps.h"
175 #if WORD_SIZE_IN_BITS == 32
176 binaryInterfaceMagic = 0x1face :: Word32
177 #elif WORD_SIZE_IN_BITS == 64
178 binaryInterfaceMagic = 0x1face64 :: Word32
181 -- -----------------------------------------------------------------------------
184 putSymbolTable :: BinHandle -> Int -> UniqFM (Int,Name) -> IO ()
185 putSymbolTable bh next_off symtab = do
187 let names = elems (array (0,next_off-1) (eltsUFM symtab))
188 mapM_ (\n -> serialiseName bh n symtab) names
190 getSymbolTable :: BinHandle -> NameCache -> IO (NameCache, Array Int Name)
191 getSymbolTable bh namecache = do
193 od_names <- sequence (replicate sz (get bh))
195 arr = listArray (0,sz-1) names
196 (namecache', names) =
197 mapAccumR (fromOnDiskName arr) namecache od_names
199 return (namecache', arr)
201 type OnDiskName = (PackageId, ModuleName, OccName)
208 fromOnDiskName arr nc (pid, mod_name, occ) =
210 mod = mkModule pid mod_name
213 case lookupOrigNameCache cache mod occ of
214 Just name -> (nc, name)
218 uniq = uniqFromSupply us
219 name = mkExternalName uniq mod occ noSrcLoc
220 new_cache = extendNameCache cache mod occ name
222 case splitUniqSupply us of { (us',_) ->
223 ( nc{ nsUniqs = us', nsNames = new_cache }, name )
226 serialiseName :: BinHandle -> Name -> UniqFM (Int,Name) -> IO ()
227 serialiseName bh name symtab = do
228 let mod = nameModule name
229 put_ bh (modulePackageId mod, moduleName mod, nameOccName name)
231 -- -----------------------------------------------------------------------------
232 -- All the binary instances
235 {-! for IPName derive: Binary !-}
236 {-! for Fixity derive: Binary !-}
237 {-! for FixityDirection derive: Binary !-}
238 {-! for Boxity derive: Binary !-}
239 {-! for StrictnessMark derive: Binary !-}
240 {-! for Activation derive: Binary !-}
243 {-! for Demand derive: Binary !-}
244 {-! for Demands derive: Binary !-}
245 {-! for DmdResult derive: Binary !-}
246 {-! for StrictSig derive: Binary !-}
249 {-! for DefMeth derive: Binary !-}
252 {-! for HsPred derive: Binary !-}
253 {-! for HsType derive: Binary !-}
254 {-! for TupCon derive: Binary !-}
255 {-! for HsTyVarBndr derive: Binary !-}
258 {-! for UfExpr derive: Binary !-}
259 {-! for UfConAlt derive: Binary !-}
260 {-! for UfBinding derive: Binary !-}
261 {-! for UfBinder derive: Binary !-}
262 {-! for HsIdInfo derive: Binary !-}
263 {-! for UfNote derive: Binary !-}
266 {-! for ConDetails derive: Binary !-}
267 {-! for BangType derive: Binary !-}
270 {-! for IsCafCC derive: Binary !-}
271 {-! for IsDupdCC derive: Binary !-}
272 {-! for CostCentre derive: Binary !-}
276 -- ---------------------------------------------------------------------------
277 -- Reading a binary interface into ParsedIface
279 instance Binary ModIface where
283 mi_mod_vers = mod_vers,
285 mi_finsts = hasFamInsts,
288 mi_exports = exports,
289 mi_exp_vers = exp_vers,
290 mi_fixities = fixities,
291 mi_deprecs = deprecs,
294 mi_fam_insts = fam_insts,
296 mi_rule_vers = rule_vers,
297 mi_vect_info = vect_info }) = do
321 hasFamInsts <- get bh
323 usages <- {-# SCC "bin_usages" #-} lazyGet bh
324 exports <- {-# SCC "bin_exports" #-} get bh
326 fixities <- {-# SCC "bin_fixities" #-} get bh
327 deprecs <- {-# SCC "bin_deprecs" #-} lazyGet bh
328 decls <- {-# SCC "bin_tycldecls" #-} get bh
329 insts <- {-# SCC "bin_insts" #-} get bh
330 fam_insts <- {-# SCC "bin_fam_insts" #-} get bh
331 rules <- {-# SCC "bin_rules" #-} lazyGet bh
335 mi_module = mod_name,
337 mi_mod_vers = mod_vers,
339 mi_finsts = hasFamInsts,
342 mi_exports = exports,
343 mi_exp_vers = exp_vers,
344 mi_fixities = fixities,
345 mi_deprecs = deprecs,
347 mi_globals = Nothing,
349 mi_fam_insts = fam_insts,
351 mi_rule_vers = rule_vers,
352 mi_vect_info = vect_info,
353 -- And build the cached values
354 mi_dep_fn = mkIfaceDepCache deprecs,
355 mi_fix_fn = mkIfaceFixCache fixities,
356 mi_ver_fn = mkIfaceVerCache decls })
358 GLOBAL_VAR(v_IgnoreHiWay, False, Bool)
360 getWayDescr :: IO String
362 tag <- readIORef v_Build_tag
363 if cGhcUnregisterised == "YES" then return ('u':tag) else return tag
364 -- if this is an unregisterised build, make sure our interfaces
365 -- can't be used by a registerised build.
367 -------------------------------------------------------------------------
368 -- Types from: HscTypes
369 -------------------------------------------------------------------------
371 instance Binary Dependencies where
372 put_ bh deps = do put_ bh (dep_mods deps)
373 put_ bh (dep_pkgs deps)
374 put_ bh (dep_orphs deps)
375 put_ bh (dep_finsts deps)
377 get bh = do ms <- get bh
381 return (Deps { dep_mods = ms, dep_pkgs = ps, dep_orphs = os,
384 instance (Binary name) => Binary (GenAvailInfo name) where
385 put_ bh (Avail aa) = do
388 put_ bh (AvailTC ab ac) = do
399 return (AvailTC ab ac)
401 instance Binary Usage where
403 put_ bh (usg_name usg)
404 put_ bh (usg_mod usg)
405 put_ bh (usg_exports usg)
406 put_ bh (usg_entities usg)
407 put_ bh (usg_rules usg)
415 return (Usage { usg_name = nm, usg_mod = mod,
416 usg_exports = exps, usg_entities = ents,
419 instance Binary a => Binary (Deprecs a) where
420 put_ bh NoDeprecs = putByte bh 0
421 put_ bh (DeprecAll t) = do
424 put_ bh (DeprecSome ts) = do
431 0 -> return NoDeprecs
433 return (DeprecAll aa)
435 return (DeprecSome aa)
437 -------------------------------------------------------------------------
438 -- Types from: BasicTypes
439 -------------------------------------------------------------------------
441 instance Binary Activation where
442 put_ bh NeverActive = do
444 put_ bh AlwaysActive = do
446 put_ bh (ActiveBefore aa) = do
449 put_ bh (ActiveAfter ab) = do
455 0 -> do return NeverActive
456 1 -> do return AlwaysActive
458 return (ActiveBefore aa)
460 return (ActiveAfter ab)
462 instance Binary StrictnessMark where
463 put_ bh MarkedStrict = do
465 put_ bh MarkedUnboxed = do
467 put_ bh NotMarkedStrict = do
472 0 -> do return MarkedStrict
473 1 -> do return MarkedUnboxed
474 _ -> do return NotMarkedStrict
476 instance Binary Boxity where
485 _ -> do return Unboxed
487 instance Binary TupCon where
488 put_ bh (TupCon ab ac) = do
494 return (TupCon ab ac)
496 instance Binary RecFlag where
497 put_ bh Recursive = do
499 put_ bh NonRecursive = do
504 0 -> do return Recursive
505 _ -> do return NonRecursive
507 instance Binary DefMeth where
508 put_ bh NoDefMeth = putByte bh 0
509 put_ bh DefMeth = putByte bh 1
510 put_ bh GenDefMeth = putByte bh 2
514 0 -> return NoDefMeth
516 _ -> return GenDefMeth
518 instance Binary FixityDirection where
528 0 -> do return InfixL
529 1 -> do return InfixR
530 _ -> do return InfixN
532 instance Binary Fixity where
533 put_ bh (Fixity aa ab) = do
539 return (Fixity aa ab)
541 instance (Binary name) => Binary (IPName name) where
542 put_ bh (IPName aa) = put_ bh aa
543 get bh = do aa <- get bh
546 -------------------------------------------------------------------------
547 -- Types from: Demand
548 -------------------------------------------------------------------------
550 instance Binary DmdType where
551 -- Ignore DmdEnv when spitting out the DmdType
552 put bh (DmdType _ ds dr) = do p <- put bh ds; put bh dr; return (castBin p)
553 get bh = do ds <- get bh; dr <- get bh; return (DmdType emptyVarEnv ds dr)
555 instance Binary Demand where
560 put_ bh (Call aa) = do
563 put_ bh (Eval ab) = do
566 put_ bh (Defer ac) = do
569 put_ bh (Box ad) = do
589 instance Binary Demands where
590 put_ bh (Poly aa) = do
593 put_ bh (Prod ab) = do
604 instance Binary DmdResult where
614 0 -> do return TopRes
615 1 -> do return RetCPR -- Really use RetCPR even if -fcpr-off
616 -- The wrapper was generated for CPR in
617 -- the imported module!
618 _ -> do return BotRes
620 instance Binary StrictSig where
621 put_ bh (StrictSig aa) = do
625 return (StrictSig aa)
628 -------------------------------------------------------------------------
629 -- Types from: CostCentre
630 -------------------------------------------------------------------------
632 instance Binary IsCafCC where
635 put_ bh NotCafCC = do
641 _ -> do return NotCafCC
643 instance Binary IsDupdCC where
644 put_ bh OriginalCC = do
651 0 -> do return OriginalCC
652 _ -> do return DupdCC
654 instance Binary CostCentre where
655 put_ bh NoCostCentre = do
657 put_ bh (NormalCC aa ab ac ad) = do
663 put_ bh (AllCafsCC ae) = do
669 0 -> do return NoCostCentre
674 return (NormalCC aa ab ac ad)
676 return (AllCafsCC ae)
678 -------------------------------------------------------------------------
679 -- IfaceTypes and friends
680 -------------------------------------------------------------------------
682 instance Binary IfaceBndr where
683 put_ bh (IfaceIdBndr aa) = do
686 put_ bh (IfaceTvBndr ab) = do
693 return (IfaceIdBndr aa)
695 return (IfaceTvBndr ab)
697 instance Binary IfaceLetBndr where
698 put_ bh (IfLetBndr a b c) = do
702 get bh = do a <- get bh
705 return (IfLetBndr a b c)
707 instance Binary IfaceType where
708 put_ bh (IfaceForAllTy aa ab) = do
712 put_ bh (IfaceTyVar ad) = do
715 put_ bh (IfaceAppTy ae af) = do
719 put_ bh (IfaceFunTy ag ah) = do
723 put_ bh (IfacePredTy aq) = do
727 -- Simple compression for common cases of TyConApp
728 put_ bh (IfaceTyConApp IfaceIntTc []) = putByte bh 6
729 put_ bh (IfaceTyConApp IfaceCharTc []) = putByte bh 7
730 put_ bh (IfaceTyConApp IfaceBoolTc []) = putByte bh 8
731 put_ bh (IfaceTyConApp IfaceListTc [ty]) = do { putByte bh 9; put_ bh ty }
732 -- Unit tuple and pairs
733 put_ bh (IfaceTyConApp (IfaceTupTc Boxed 0) []) = putByte bh 10
734 put_ bh (IfaceTyConApp (IfaceTupTc Boxed 2) [t1,t2]) = do { putByte bh 11; put_ bh t1; put_ bh t2 }
736 put_ bh (IfaceTyConApp IfaceLiftedTypeKindTc []) = putByte bh 12
737 put_ bh (IfaceTyConApp IfaceOpenTypeKindTc []) = putByte bh 13
738 put_ bh (IfaceTyConApp IfaceUnliftedTypeKindTc []) = putByte bh 14
739 put_ bh (IfaceTyConApp IfaceUbxTupleKindTc []) = putByte bh 15
740 put_ bh (IfaceTyConApp IfaceArgTypeKindTc []) = putByte bh 16
744 put_ bh (IfaceTyConApp (IfaceTc tc) tys) = do { putByte bh 18; put_ bh tc; put_ bh tys }
745 put_ bh (IfaceTyConApp tc tys) = do { putByte bh 19; put_ bh tc; put_ bh tys }
752 return (IfaceForAllTy aa ab)
754 return (IfaceTyVar ad)
757 return (IfaceAppTy ae af)
760 return (IfaceFunTy ag ah)
762 return (IfacePredTy ap)
764 -- Now the special cases for TyConApp
765 6 -> return (IfaceTyConApp IfaceIntTc [])
766 7 -> return (IfaceTyConApp IfaceCharTc [])
767 8 -> return (IfaceTyConApp IfaceBoolTc [])
768 9 -> do { ty <- get bh; return (IfaceTyConApp IfaceListTc [ty]) }
769 10 -> return (IfaceTyConApp (IfaceTupTc Boxed 0) [])
770 11 -> do { t1 <- get bh; t2 <- get bh; return (IfaceTyConApp (IfaceTupTc Boxed 2) [t1,t2]) }
771 12 -> return (IfaceTyConApp IfaceLiftedTypeKindTc [])
772 13 -> return (IfaceTyConApp IfaceOpenTypeKindTc [])
773 14 -> return (IfaceTyConApp IfaceUnliftedTypeKindTc [])
774 15 -> return (IfaceTyConApp IfaceUbxTupleKindTc [])
775 16 -> return (IfaceTyConApp IfaceArgTypeKindTc [])
777 18 -> do { tc <- get bh; tys <- get bh; return (IfaceTyConApp (IfaceTc tc) tys) }
778 _ -> do { tc <- get bh; tys <- get bh; return (IfaceTyConApp tc tys) }
780 instance Binary IfaceTyCon where
781 -- Int,Char,Bool can't show up here because they can't not be saturated
783 put_ bh IfaceIntTc = putByte bh 1
784 put_ bh IfaceBoolTc = putByte bh 2
785 put_ bh IfaceCharTc = putByte bh 3
786 put_ bh IfaceListTc = putByte bh 4
787 put_ bh IfacePArrTc = putByte bh 5
788 put_ bh IfaceLiftedTypeKindTc = putByte bh 6
789 put_ bh IfaceOpenTypeKindTc = putByte bh 7
790 put_ bh IfaceUnliftedTypeKindTc = putByte bh 8
791 put_ bh IfaceUbxTupleKindTc = putByte bh 9
792 put_ bh IfaceArgTypeKindTc = putByte bh 10
793 put_ bh (IfaceTupTc bx ar) = do { putByte bh 11; put_ bh bx; put_ bh ar }
794 put_ bh (IfaceTc ext) = do { putByte bh 12; put_ bh ext }
799 1 -> return IfaceIntTc
800 2 -> return IfaceBoolTc
801 3 -> return IfaceCharTc
802 4 -> return IfaceListTc
803 5 -> return IfacePArrTc
804 6 -> return IfaceLiftedTypeKindTc
805 7 -> return IfaceOpenTypeKindTc
806 8 -> return IfaceUnliftedTypeKindTc
807 9 -> return IfaceUbxTupleKindTc
808 10 -> return IfaceArgTypeKindTc
809 11 -> do { bx <- get bh; ar <- get bh; return (IfaceTupTc bx ar) }
810 _ -> do { ext <- get bh; return (IfaceTc ext) }
812 instance Binary IfacePredType where
813 put_ bh (IfaceClassP aa ab) = do
817 put_ bh (IfaceIParam ac ad) = do
821 put_ bh (IfaceEqPred ac ad) = do
830 return (IfaceClassP aa ab)
833 return (IfaceIParam ac ad)
836 return (IfaceEqPred ac ad)
838 -------------------------------------------------------------------------
839 -- IfaceExpr and friends
840 -------------------------------------------------------------------------
842 instance Binary IfaceExpr where
843 put_ bh (IfaceLcl aa) = do
846 put_ bh (IfaceType ab) = do
849 put_ bh (IfaceTuple ac ad) = do
853 put_ bh (IfaceLam ae af) = do
857 put_ bh (IfaceApp ag ah) = do
862 put_ bh (IfaceCase ai aj al ak) = do
869 put_ bh (IfaceLet al am) = do
873 put_ bh (IfaceNote an ao) = do
877 put_ bh (IfaceLit ap) = do
880 put_ bh (IfaceFCall as at) = do
884 put_ bh (IfaceExt aa) = do
887 put_ bh (IfaceCast ie ico) = do
897 return (IfaceType ab)
900 return (IfaceTuple ac ad)
903 return (IfaceLam ae af)
906 return (IfaceApp ag ah)
913 return (IfaceCase ai aj al ak)
916 return (IfaceLet al am)
919 return (IfaceNote an ao)
924 return (IfaceFCall as at)
925 10 -> do aa <- get bh
927 11 -> do ie <- get bh
929 return (IfaceCast ie ico)
931 instance Binary IfaceConAlt where
932 put_ bh IfaceDefault = do
934 put_ bh (IfaceDataAlt aa) = do
937 put_ bh (IfaceTupleAlt ab) = do
940 put_ bh (IfaceLitAlt ac) = do
946 0 -> do return IfaceDefault
948 return (IfaceDataAlt aa)
950 return (IfaceTupleAlt ab)
952 return (IfaceLitAlt ac)
954 instance Binary IfaceBinding where
955 put_ bh (IfaceNonRec aa ab) = do
959 put_ bh (IfaceRec ac) = do
967 return (IfaceNonRec aa ab)
971 instance Binary IfaceIdInfo where
972 put_ bh NoInfo = putByte bh 0
973 put_ bh (HasInfo i) = do
975 lazyPut bh i -- NB lazyPut
981 _ -> do info <- lazyGet bh -- NB lazyGet
982 return (HasInfo info)
984 instance Binary IfaceInfoItem where
985 put_ bh (HsArity aa) = do
988 put_ bh (HsStrictness ab) = do
991 put_ bh (HsUnfold ad) = do
994 put_ bh (HsInline ad) = do
997 put_ bh HsNoCafRefs = do
999 put_ bh (HsWorker ae af) = do
1006 0 -> do aa <- get bh
1008 1 -> do ab <- get bh
1009 return (HsStrictness ab)
1010 2 -> do ad <- get bh
1011 return (HsUnfold ad)
1012 3 -> do ad <- get bh
1013 return (HsInline ad)
1014 4 -> do return HsNoCafRefs
1015 _ -> do ae <- get bh
1017 return (HsWorker ae af)
1019 instance Binary IfaceNote where
1020 put_ bh (IfaceSCC aa) = do
1023 put_ bh IfaceInlineMe = do
1025 put_ bh (IfaceCoreNote s) = do
1031 0 -> do aa <- get bh
1032 return (IfaceSCC aa)
1033 3 -> do return IfaceInlineMe
1034 4 -> do ac <- get bh
1035 return (IfaceCoreNote ac)
1037 -------------------------------------------------------------------------
1038 -- IfaceDecl and friends
1039 -------------------------------------------------------------------------
1041 -- A bit of magic going on here: there's no need to store the OccName
1042 -- for a decl on the disk, since we can infer the namespace from the
1043 -- context; however it is useful to have the OccName in the IfaceDecl
1044 -- to avoid re-building it in various places. So we build the OccName
1045 -- when de-serialising.
1047 instance Binary IfaceDecl where
1048 put_ bh (IfaceId name ty idinfo) = do
1050 put_ bh (occNameFS name)
1053 put_ bh (IfaceForeign ae af) =
1054 error "Binary.put_(IfaceDecl): IfaceForeign"
1055 put_ bh (IfaceData a1 a2 a3 a4 a5 a6 a7 a8) = do
1057 put_ bh (occNameFS a1)
1065 put_ bh (IfaceSyn aq ar as at) = do
1067 put_ bh (occNameFS aq)
1071 put_ bh (IfaceClass a1 a2 a3 a4 a5 a6 a7) = do
1074 put_ bh (occNameFS a2)
1083 0 -> do name <- get bh
1086 occ <- return $! mkOccNameFS varName name
1087 return (IfaceId occ ty idinfo)
1088 1 -> error "Binary.get(TyClDecl): ForeignType"
1098 occ <- return $! mkOccNameFS tcName a1
1099 return (IfaceData occ a2 a3 a4 a5 a6 a7 a8)
1105 occ <- return $! mkOccNameFS tcName aq
1106 return (IfaceSyn occ ar as at)
1115 occ <- return $! mkOccNameFS clsName a2
1116 return (IfaceClass a1 occ a3 a4 a5 a6 a7)
1118 instance Binary IfaceInst where
1119 put_ bh (IfaceInst cls tys dfun flag orph) = do
1125 get bh = do cls <- get bh
1130 return (IfaceInst cls tys dfun flag orph)
1132 instance Binary IfaceFamInst where
1133 put_ bh (IfaceFamInst fam tys tycon) = do
1137 get bh = do fam <- get bh
1140 return (IfaceFamInst fam tys tycon)
1142 instance Binary OverlapFlag where
1143 put_ bh NoOverlap = putByte bh 0
1144 put_ bh OverlapOk = putByte bh 1
1145 put_ bh Incoherent = putByte bh 2
1146 get bh = do h <- getByte bh
1148 0 -> return NoOverlap
1149 1 -> return OverlapOk
1150 2 -> return Incoherent
1152 instance Binary IfaceConDecls where
1153 put_ bh IfAbstractTyCon = putByte bh 0
1154 put_ bh IfOpenDataTyCon = putByte bh 1
1155 put_ bh IfOpenNewTyCon = putByte bh 2
1156 put_ bh (IfDataTyCon cs) = do { putByte bh 3
1158 put_ bh (IfNewTyCon c) = do { putByte bh 4
1163 0 -> return IfAbstractTyCon
1164 1 -> return IfOpenDataTyCon
1165 2 -> return IfOpenNewTyCon
1166 3 -> do cs <- get bh
1167 return (IfDataTyCon cs)
1168 _ -> do aa <- get bh
1169 return (IfNewTyCon aa)
1171 instance Binary IfaceConDecl where
1172 put_ bh (IfCon a1 a2 a3 a4 a5 a6 a7 a8 a9) = do
1182 get bh = do a1 <- get bh
1191 return (IfCon a1 a2 a3 a4 a5 a6 a7 a8 a9)
1193 instance Binary IfaceClassOp where
1194 put_ bh (IfaceClassOp n def ty) = do
1195 put_ bh (occNameFS n)
1202 occ <- return $! mkOccNameFS varName n
1203 return (IfaceClassOp occ def ty)
1205 instance Binary IfaceRule where
1206 put_ bh (IfaceRule a1 a2 a3 a4 a5 a6 a7) = do
1222 return (IfaceRule a1 a2 a3 a4 a5 a6 a7)
1224 instance Binary IfaceVectInfo where
1225 put_ bh (IfaceVectInfo a1) = do
1229 return (IfaceVectInfo a1)