2 -- (c) The University of Glasgow 2002-2006
4 -- Binary interface file support.
7 -- The above warning supression flag is a temporary kludge.
8 -- While working on this module you are encouraged to remove it and fix
9 -- any warnings in the module. See
10 -- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
13 module BinIface ( writeBinIface, readBinIface, v_IgnoreHiWay ) where
15 #include "HsVersions.h"
48 import Control.Exception
51 -- ---------------------------------------------------------------------------
52 -- Reading and writing binary interface files
54 readBinIface :: FilePath -> TcRnIf a b ModIface
55 readBinIface hi_path = do
57 (new_nc, iface) <- ioToIOEnv $ readBinIface_ hi_path nc
61 readBinIface_ :: FilePath -> NameCache -> IO (NameCache, ModIface)
62 readBinIface_ hi_path nc = do
63 bh <- Binary.readBinMem hi_path
65 -- Read the magic number to check that this really is a GHC .hi file
66 -- (This magic number does not change when we change
67 -- GHC interface file format)
69 when (magic /= binaryInterfaceMagic) $
70 throwDyn (ProgramError (
71 "magic number mismatch: old/corrupt interface file?"))
73 -- Get the dictionary pointer. We won't attempt to actually
74 -- read the dictionary until we've done the version checks below,
75 -- just in case this isn't a valid interface. In retrospect the
76 -- version should have come before the dictionary pointer, but this
77 -- is the way it was done originally, and we can't change it now.
78 dict_p <- Binary.get bh -- Get the dictionary ptr
80 -- Check the interface file version and ways.
82 let our_ver = show opt_HiVersion
83 when (check_ver /= our_ver) $
84 -- This will be caught by readIface which will emit an error
85 -- msg containing the iface module name.
86 throwDyn (ProgramError (
87 "mismatched interface file versions: expected "
88 ++ our_ver ++ ", found " ++ check_ver))
91 ignore_way <- readIORef v_IgnoreHiWay
92 way_descr <- getWayDescr
93 when (not ignore_way && check_way /= way_descr) $
94 -- This will be caught by readIface
95 -- which will emit an error msg containing the iface module name.
96 throwDyn (ProgramError (
97 "mismatched interface file ways: expected "
98 ++ way_descr ++ ", found " ++ check_way))
100 -- Read the dictionary
101 -- The next word in the file is a pointer to where the dictionary is
102 -- (probably at the end of the file)
103 data_p <- tellBin bh -- Remember where we are now
105 dict <- getDictionary bh
106 seekBin bh data_p -- Back to where we were before
108 -- Initialise the user-data field of bh
109 ud <- newReadState dict
110 bh <- return (setUserData bh ud)
112 symtab_p <- Binary.get bh -- Get the symtab ptr
113 data_p <- tellBin bh -- Remember where we are now
115 (nc', symtab) <- getSymbolTable bh nc
116 seekBin bh data_p -- Back to where we were before
117 let ud = getUserData bh
118 bh <- return $! setUserData bh ud{ud_symtab = symtab}
123 writeBinIface :: DynFlags -> FilePath -> ModIface -> IO ()
124 writeBinIface dflags hi_path mod_iface = do
125 bh <- openBinMem initBinMemSize
126 put_ bh binaryInterfaceMagic
128 -- Remember where the dictionary pointer will go
129 dict_p_p <- tellBin bh
130 put_ bh dict_p_p -- Placeholder for ptr to dictionary
132 -- The version and way descriptor go next
133 put_ bh (show opt_HiVersion)
134 way_descr <- getWayDescr
137 -- Remember where the symbol table pointer will go
138 symtab_p_p <- tellBin bh
141 -- Make some intial state
144 -- Put the main thing,
145 bh <- return $ setUserData bh ud
148 -- Write the symtab pointer at the fornt of the file
149 symtab_p <- tellBin bh -- This is where the symtab will start
150 putAt bh symtab_p_p symtab_p -- Fill in the placeholder
151 seekBin bh symtab_p -- Seek back to the end of the file
153 -- Write the symbol table itself
154 symtab_next <- readFastMutInt (ud_symtab_next ud)
155 symtab_map <- readIORef (ud_symtab_map ud)
156 putSymbolTable bh symtab_next symtab_map
157 debugTraceMsg dflags 3 (text "writeBinIface:" <+> int symtab_next
160 -- NB. write the dictionary after the symbol table, because
161 -- writing the symbol table may create more dictionary entries.
163 -- Write the dictionary pointer at the fornt of the file
164 dict_p <- tellBin bh -- This is where the dictionary will start
165 putAt bh dict_p_p dict_p -- Fill in the placeholder
166 seekBin bh dict_p -- Seek back to the end of the file
168 -- Write the dictionary itself
169 dict_next <- readFastMutInt (ud_dict_next ud)
170 dict_map <- readIORef (ud_dict_map ud)
171 putDictionary bh dict_next dict_map
172 debugTraceMsg dflags 3 (text "writeBinIface:" <+> int dict_next
173 <+> text "dict entries")
175 -- And send the result to the file
176 writeBinMem bh hi_path
178 initBinMemSize = (1024*1024) :: Int
180 -- The *host* architecture version:
181 #include "MachDeps.h"
183 #if WORD_SIZE_IN_BITS == 32
184 binaryInterfaceMagic = 0x1face :: Word32
185 #elif WORD_SIZE_IN_BITS == 64
186 binaryInterfaceMagic = 0x1face64 :: Word32
189 -- -----------------------------------------------------------------------------
192 putSymbolTable :: BinHandle -> Int -> UniqFM (Int,Name) -> IO ()
193 putSymbolTable bh next_off symtab = do
195 let names = elems (array (0,next_off-1) (eltsUFM symtab))
196 mapM_ (\n -> serialiseName bh n symtab) names
198 getSymbolTable :: BinHandle -> NameCache -> IO (NameCache, Array Int Name)
199 getSymbolTable bh namecache = do
201 od_names <- sequence (replicate sz (get bh))
203 arr = listArray (0,sz-1) names
204 (namecache', names) =
205 mapAccumR (fromOnDiskName arr) namecache od_names
207 return (namecache', arr)
209 type OnDiskName = (PackageId, ModuleName, OccName)
216 fromOnDiskName arr nc (pid, mod_name, occ) =
218 mod = mkModule pid mod_name
221 case lookupOrigNameCache cache mod occ of
222 Just name -> (nc, name)
226 uniq = uniqFromSupply us
227 name = mkExternalName uniq mod occ noSrcSpan
228 new_cache = extendNameCache cache mod occ name
230 case splitUniqSupply us of { (us',_) ->
231 ( nc{ nsUniqs = us', nsNames = new_cache }, name )
234 serialiseName :: BinHandle -> Name -> UniqFM (Int,Name) -> IO ()
235 serialiseName bh name symtab = do
236 let mod = nameModule name
237 put_ bh (modulePackageId mod, moduleName mod, nameOccName name)
239 -- -----------------------------------------------------------------------------
240 -- All the binary instances
243 {-! for IPName derive: Binary !-}
244 {-! for Fixity derive: Binary !-}
245 {-! for FixityDirection derive: Binary !-}
246 {-! for Boxity derive: Binary !-}
247 {-! for StrictnessMark derive: Binary !-}
248 {-! for Activation derive: Binary !-}
251 {-! for Demand derive: Binary !-}
252 {-! for Demands derive: Binary !-}
253 {-! for DmdResult derive: Binary !-}
254 {-! for StrictSig derive: Binary !-}
257 {-! for DefMeth derive: Binary !-}
260 {-! for HsPred derive: Binary !-}
261 {-! for HsType derive: Binary !-}
262 {-! for TupCon derive: Binary !-}
263 {-! for HsTyVarBndr derive: Binary !-}
266 {-! for UfExpr derive: Binary !-}
267 {-! for UfConAlt derive: Binary !-}
268 {-! for UfBinding derive: Binary !-}
269 {-! for UfBinder derive: Binary !-}
270 {-! for HsIdInfo derive: Binary !-}
271 {-! for UfNote derive: Binary !-}
274 {-! for ConDetails derive: Binary !-}
275 {-! for BangType derive: Binary !-}
278 {-! for IsCafCC derive: Binary !-}
279 {-! for IsDupdCC derive: Binary !-}
280 {-! for CostCentre derive: Binary !-}
284 -- ---------------------------------------------------------------------------
285 -- Reading a binary interface into ParsedIface
287 instance Binary ModIface where
291 mi_mod_vers = mod_vers,
293 mi_finsts = hasFamInsts,
296 mi_exports = exports,
297 mi_exp_vers = exp_vers,
298 mi_fixities = fixities,
299 mi_deprecs = deprecs,
302 mi_fam_insts = fam_insts,
304 mi_rule_vers = rule_vers,
305 mi_vect_info = vect_info,
306 mi_hpc = hpc_info }) = do
331 hasFamInsts <- get bh
333 usages <- {-# SCC "bin_usages" #-} lazyGet bh
334 exports <- {-# SCC "bin_exports" #-} get bh
336 fixities <- {-# SCC "bin_fixities" #-} get bh
337 deprecs <- {-# SCC "bin_deprecs" #-} lazyGet bh
338 decls <- {-# SCC "bin_tycldecls" #-} get bh
339 insts <- {-# SCC "bin_insts" #-} get bh
340 fam_insts <- {-# SCC "bin_fam_insts" #-} get bh
341 rules <- {-# SCC "bin_rules" #-} lazyGet bh
346 mi_module = mod_name,
348 mi_mod_vers = mod_vers,
350 mi_finsts = hasFamInsts,
353 mi_exports = exports,
354 mi_exp_vers = exp_vers,
355 mi_fixities = fixities,
356 mi_deprecs = deprecs,
358 mi_globals = Nothing,
360 mi_fam_insts = fam_insts,
362 mi_rule_vers = rule_vers,
363 mi_vect_info = vect_info,
365 -- And build the cached values
366 mi_dep_fn = mkIfaceDepCache deprecs,
367 mi_fix_fn = mkIfaceFixCache fixities,
368 mi_ver_fn = mkIfaceVerCache decls })
370 GLOBAL_VAR(v_IgnoreHiWay, False, Bool)
372 getWayDescr :: IO String
374 tag <- readIORef v_Build_tag
375 if cGhcUnregisterised == "YES" then return ('u':tag) else return tag
376 -- if this is an unregisterised build, make sure our interfaces
377 -- can't be used by a registerised build.
379 -------------------------------------------------------------------------
380 -- Types from: HscTypes
381 -------------------------------------------------------------------------
383 instance Binary Dependencies where
384 put_ bh deps = do put_ bh (dep_mods deps)
385 put_ bh (dep_pkgs deps)
386 put_ bh (dep_orphs deps)
387 put_ bh (dep_finsts deps)
389 get bh = do ms <- get bh
393 return (Deps { dep_mods = ms, dep_pkgs = ps, dep_orphs = os,
396 instance (Binary name) => Binary (GenAvailInfo name) where
397 put_ bh (Avail aa) = do
400 put_ bh (AvailTC ab ac) = do
411 return (AvailTC ab ac)
413 instance Binary Usage where
415 put_ bh (usg_name usg)
416 put_ bh (usg_mod usg)
417 put_ bh (usg_exports usg)
418 put_ bh (usg_entities usg)
419 put_ bh (usg_rules usg)
427 return (Usage { usg_name = nm, usg_mod = mod,
428 usg_exports = exps, usg_entities = ents,
431 instance Binary a => Binary (Deprecs a) where
432 put_ bh NoDeprecs = putByte bh 0
433 put_ bh (DeprecAll t) = do
436 put_ bh (DeprecSome ts) = do
443 0 -> return NoDeprecs
445 return (DeprecAll aa)
447 return (DeprecSome aa)
449 -------------------------------------------------------------------------
450 -- Types from: BasicTypes
451 -------------------------------------------------------------------------
453 instance Binary Activation where
454 put_ bh NeverActive = do
456 put_ bh AlwaysActive = do
458 put_ bh (ActiveBefore aa) = do
461 put_ bh (ActiveAfter ab) = do
467 0 -> do return NeverActive
468 1 -> do return AlwaysActive
470 return (ActiveBefore aa)
472 return (ActiveAfter ab)
474 instance Binary StrictnessMark where
475 put_ bh MarkedStrict = do
477 put_ bh MarkedUnboxed = do
479 put_ bh NotMarkedStrict = do
484 0 -> do return MarkedStrict
485 1 -> do return MarkedUnboxed
486 _ -> do return NotMarkedStrict
488 instance Binary Boxity where
497 _ -> do return Unboxed
499 instance Binary TupCon where
500 put_ bh (TupCon ab ac) = do
506 return (TupCon ab ac)
508 instance Binary RecFlag where
509 put_ bh Recursive = do
511 put_ bh NonRecursive = do
516 0 -> do return Recursive
517 _ -> do return NonRecursive
519 instance Binary DefMeth where
520 put_ bh NoDefMeth = putByte bh 0
521 put_ bh DefMeth = putByte bh 1
522 put_ bh GenDefMeth = putByte bh 2
526 0 -> return NoDefMeth
528 _ -> return GenDefMeth
530 instance Binary FixityDirection where
540 0 -> do return InfixL
541 1 -> do return InfixR
542 _ -> do return InfixN
544 instance Binary Fixity where
545 put_ bh (Fixity aa ab) = do
551 return (Fixity aa ab)
553 instance (Binary name) => Binary (IPName name) where
554 put_ bh (IPName aa) = put_ bh aa
555 get bh = do aa <- get bh
558 -------------------------------------------------------------------------
559 -- Types from: Demand
560 -------------------------------------------------------------------------
562 instance Binary DmdType where
563 -- Ignore DmdEnv when spitting out the DmdType
564 put bh (DmdType _ ds dr) = do p <- put bh ds; put bh dr; return (castBin p)
565 get bh = do ds <- get bh; dr <- get bh; return (DmdType emptyVarEnv ds dr)
567 instance Binary Demand where
572 put_ bh (Call aa) = do
575 put_ bh (Eval ab) = do
578 put_ bh (Defer ac) = do
581 put_ bh (Box ad) = do
601 instance Binary Demands where
602 put_ bh (Poly aa) = do
605 put_ bh (Prod ab) = do
616 instance Binary DmdResult where
626 0 -> do return TopRes
627 1 -> do return RetCPR -- Really use RetCPR even if -fcpr-off
628 -- The wrapper was generated for CPR in
629 -- the imported module!
630 _ -> do return BotRes
632 instance Binary StrictSig where
633 put_ bh (StrictSig aa) = do
637 return (StrictSig aa)
640 -------------------------------------------------------------------------
641 -- Types from: CostCentre
642 -------------------------------------------------------------------------
644 instance Binary IsCafCC where
647 put_ bh NotCafCC = do
653 _ -> do return NotCafCC
655 instance Binary IsDupdCC where
656 put_ bh OriginalCC = do
663 0 -> do return OriginalCC
664 _ -> do return DupdCC
666 instance Binary CostCentre where
667 put_ bh NoCostCentre = do
669 put_ bh (NormalCC aa ab ac ad) = do
675 put_ bh (AllCafsCC ae) = do
681 0 -> do return NoCostCentre
686 return (NormalCC aa ab ac ad)
688 return (AllCafsCC ae)
690 -------------------------------------------------------------------------
691 -- IfaceTypes and friends
692 -------------------------------------------------------------------------
694 instance Binary IfaceBndr where
695 put_ bh (IfaceIdBndr aa) = do
698 put_ bh (IfaceTvBndr ab) = do
705 return (IfaceIdBndr aa)
707 return (IfaceTvBndr ab)
709 instance Binary IfaceLetBndr where
710 put_ bh (IfLetBndr a b c) = do
714 get bh = do a <- get bh
717 return (IfLetBndr a b c)
719 instance Binary IfaceType where
720 put_ bh (IfaceForAllTy aa ab) = do
724 put_ bh (IfaceTyVar ad) = do
727 put_ bh (IfaceAppTy ae af) = do
731 put_ bh (IfaceFunTy ag ah) = do
735 put_ bh (IfacePredTy aq) = do
739 -- Simple compression for common cases of TyConApp
740 put_ bh (IfaceTyConApp IfaceIntTc []) = putByte bh 6
741 put_ bh (IfaceTyConApp IfaceCharTc []) = putByte bh 7
742 put_ bh (IfaceTyConApp IfaceBoolTc []) = putByte bh 8
743 put_ bh (IfaceTyConApp IfaceListTc [ty]) = do { putByte bh 9; put_ bh ty }
744 -- Unit tuple and pairs
745 put_ bh (IfaceTyConApp (IfaceTupTc Boxed 0) []) = putByte bh 10
746 put_ bh (IfaceTyConApp (IfaceTupTc Boxed 2) [t1,t2]) = do { putByte bh 11; put_ bh t1; put_ bh t2 }
748 put_ bh (IfaceTyConApp IfaceLiftedTypeKindTc []) = putByte bh 12
749 put_ bh (IfaceTyConApp IfaceOpenTypeKindTc []) = putByte bh 13
750 put_ bh (IfaceTyConApp IfaceUnliftedTypeKindTc []) = putByte bh 14
751 put_ bh (IfaceTyConApp IfaceUbxTupleKindTc []) = putByte bh 15
752 put_ bh (IfaceTyConApp IfaceArgTypeKindTc []) = putByte bh 16
756 put_ bh (IfaceTyConApp (IfaceTc tc) tys) = do { putByte bh 18; put_ bh tc; put_ bh tys }
757 put_ bh (IfaceTyConApp tc tys) = do { putByte bh 19; put_ bh tc; put_ bh tys }
764 return (IfaceForAllTy aa ab)
766 return (IfaceTyVar ad)
769 return (IfaceAppTy ae af)
772 return (IfaceFunTy ag ah)
774 return (IfacePredTy ap)
776 -- Now the special cases for TyConApp
777 6 -> return (IfaceTyConApp IfaceIntTc [])
778 7 -> return (IfaceTyConApp IfaceCharTc [])
779 8 -> return (IfaceTyConApp IfaceBoolTc [])
780 9 -> do { ty <- get bh; return (IfaceTyConApp IfaceListTc [ty]) }
781 10 -> return (IfaceTyConApp (IfaceTupTc Boxed 0) [])
782 11 -> do { t1 <- get bh; t2 <- get bh; return (IfaceTyConApp (IfaceTupTc Boxed 2) [t1,t2]) }
783 12 -> return (IfaceTyConApp IfaceLiftedTypeKindTc [])
784 13 -> return (IfaceTyConApp IfaceOpenTypeKindTc [])
785 14 -> return (IfaceTyConApp IfaceUnliftedTypeKindTc [])
786 15 -> return (IfaceTyConApp IfaceUbxTupleKindTc [])
787 16 -> return (IfaceTyConApp IfaceArgTypeKindTc [])
789 18 -> do { tc <- get bh; tys <- get bh; return (IfaceTyConApp (IfaceTc tc) tys) }
790 _ -> do { tc <- get bh; tys <- get bh; return (IfaceTyConApp tc tys) }
792 instance Binary IfaceTyCon where
793 -- Int,Char,Bool can't show up here because they can't not be saturated
795 put_ bh IfaceIntTc = putByte bh 1
796 put_ bh IfaceBoolTc = putByte bh 2
797 put_ bh IfaceCharTc = putByte bh 3
798 put_ bh IfaceListTc = putByte bh 4
799 put_ bh IfacePArrTc = putByte bh 5
800 put_ bh IfaceLiftedTypeKindTc = putByte bh 6
801 put_ bh IfaceOpenTypeKindTc = putByte bh 7
802 put_ bh IfaceUnliftedTypeKindTc = putByte bh 8
803 put_ bh IfaceUbxTupleKindTc = putByte bh 9
804 put_ bh IfaceArgTypeKindTc = putByte bh 10
805 put_ bh (IfaceTupTc bx ar) = do { putByte bh 11; put_ bh bx; put_ bh ar }
806 put_ bh (IfaceTc ext) = do { putByte bh 12; put_ bh ext }
811 1 -> return IfaceIntTc
812 2 -> return IfaceBoolTc
813 3 -> return IfaceCharTc
814 4 -> return IfaceListTc
815 5 -> return IfacePArrTc
816 6 -> return IfaceLiftedTypeKindTc
817 7 -> return IfaceOpenTypeKindTc
818 8 -> return IfaceUnliftedTypeKindTc
819 9 -> return IfaceUbxTupleKindTc
820 10 -> return IfaceArgTypeKindTc
821 11 -> do { bx <- get bh; ar <- get bh; return (IfaceTupTc bx ar) }
822 _ -> do { ext <- get bh; return (IfaceTc ext) }
824 instance Binary IfacePredType where
825 put_ bh (IfaceClassP aa ab) = do
829 put_ bh (IfaceIParam ac ad) = do
833 put_ bh (IfaceEqPred ac ad) = do
842 return (IfaceClassP aa ab)
845 return (IfaceIParam ac ad)
848 return (IfaceEqPred ac ad)
850 -------------------------------------------------------------------------
851 -- IfaceExpr and friends
852 -------------------------------------------------------------------------
854 instance Binary IfaceExpr where
855 put_ bh (IfaceLcl aa) = do
858 put_ bh (IfaceType ab) = do
861 put_ bh (IfaceTuple ac ad) = do
865 put_ bh (IfaceLam ae af) = do
869 put_ bh (IfaceApp ag ah) = do
874 put_ bh (IfaceCase ai aj al ak) = do
881 put_ bh (IfaceLet al am) = do
885 put_ bh (IfaceNote an ao) = do
889 put_ bh (IfaceLit ap) = do
892 put_ bh (IfaceFCall as at) = do
896 put_ bh (IfaceExt aa) = do
899 put_ bh (IfaceCast ie ico) = do
903 put_ bh (IfaceTick m ix) = do
913 return (IfaceType ab)
916 return (IfaceTuple ac ad)
919 return (IfaceLam ae af)
922 return (IfaceApp ag ah)
929 return (IfaceCase ai aj al ak)
932 return (IfaceLet al am)
935 return (IfaceNote an ao)
940 return (IfaceFCall as at)
941 10 -> do aa <- get bh
943 11 -> do ie <- get bh
945 return (IfaceCast ie ico)
948 return (IfaceTick m ix)
950 instance Binary IfaceConAlt where
951 put_ bh IfaceDefault = do
953 put_ bh (IfaceDataAlt aa) = do
956 put_ bh (IfaceTupleAlt ab) = do
959 put_ bh (IfaceLitAlt ac) = do
965 0 -> do return IfaceDefault
967 return (IfaceDataAlt aa)
969 return (IfaceTupleAlt ab)
971 return (IfaceLitAlt ac)
973 instance Binary IfaceBinding where
974 put_ bh (IfaceNonRec aa ab) = do
978 put_ bh (IfaceRec ac) = do
986 return (IfaceNonRec aa ab)
990 instance Binary IfaceIdInfo where
991 put_ bh NoInfo = putByte bh 0
992 put_ bh (HasInfo i) = do
994 lazyPut bh i -- NB lazyPut
1000 _ -> do info <- lazyGet bh -- NB lazyGet
1001 return (HasInfo info)
1003 instance Binary IfaceInfoItem where
1004 put_ bh (HsArity aa) = do
1007 put_ bh (HsStrictness ab) = do
1010 put_ bh (HsUnfold ad) = do
1013 put_ bh (HsInline ad) = do
1016 put_ bh HsNoCafRefs = do
1018 put_ bh (HsWorker ae af) = do
1025 0 -> do aa <- get bh
1027 1 -> do ab <- get bh
1028 return (HsStrictness ab)
1029 2 -> do ad <- get bh
1030 return (HsUnfold ad)
1031 3 -> do ad <- get bh
1032 return (HsInline ad)
1033 4 -> do return HsNoCafRefs
1034 _ -> do ae <- get bh
1036 return (HsWorker ae af)
1038 instance Binary IfaceNote where
1039 put_ bh (IfaceSCC aa) = do
1042 put_ bh IfaceInlineMe = do
1044 put_ bh (IfaceCoreNote s) = do
1050 0 -> do aa <- get bh
1051 return (IfaceSCC aa)
1052 3 -> do return IfaceInlineMe
1053 4 -> do ac <- get bh
1054 return (IfaceCoreNote ac)
1056 -------------------------------------------------------------------------
1057 -- IfaceDecl and friends
1058 -------------------------------------------------------------------------
1060 -- A bit of magic going on here: there's no need to store the OccName
1061 -- for a decl on the disk, since we can infer the namespace from the
1062 -- context; however it is useful to have the OccName in the IfaceDecl
1063 -- to avoid re-building it in various places. So we build the OccName
1064 -- when de-serialising.
1066 instance Binary IfaceDecl where
1067 put_ bh (IfaceId name ty idinfo) = do
1069 put_ bh (occNameFS name)
1072 put_ bh (IfaceForeign ae af) =
1073 error "Binary.put_(IfaceDecl): IfaceForeign"
1074 put_ bh (IfaceData a1 a2 a3 a4 a5 a6 a7 a8) = do
1076 put_ bh (occNameFS a1)
1084 put_ bh (IfaceSyn a1 a2 a3 a4 a5) = do
1086 put_ bh (occNameFS a1)
1091 put_ bh (IfaceClass a1 a2 a3 a4 a5 a6 a7) = do
1094 put_ bh (occNameFS a2)
1103 0 -> do name <- get bh
1106 occ <- return $! mkOccNameFS varName name
1107 return (IfaceId occ ty idinfo)
1108 1 -> error "Binary.get(TyClDecl): ForeignType"
1118 occ <- return $! mkOccNameFS tcName a1
1119 return (IfaceData occ a2 a3 a4 a5 a6 a7 a8)
1126 occ <- return $! mkOccNameFS tcName a1
1127 return (IfaceSyn occ a2 a3 a4 a5)
1136 occ <- return $! mkOccNameFS clsName a2
1137 return (IfaceClass a1 occ a3 a4 a5 a6 a7)
1139 instance Binary IfaceInst where
1140 put_ bh (IfaceInst cls tys dfun flag orph) = do
1146 get bh = do cls <- get bh
1151 return (IfaceInst cls tys dfun flag orph)
1153 instance Binary IfaceFamInst where
1154 put_ bh (IfaceFamInst fam tys tycon) = do
1158 get bh = do fam <- get bh
1161 return (IfaceFamInst fam tys tycon)
1163 instance Binary OverlapFlag where
1164 put_ bh NoOverlap = putByte bh 0
1165 put_ bh OverlapOk = putByte bh 1
1166 put_ bh Incoherent = putByte bh 2
1167 get bh = do h <- getByte bh
1169 0 -> return NoOverlap
1170 1 -> return OverlapOk
1171 2 -> return Incoherent
1173 instance Binary IfaceConDecls where
1174 put_ bh IfAbstractTyCon = putByte bh 0
1175 put_ bh IfOpenDataTyCon = putByte bh 1
1176 put_ bh (IfDataTyCon cs) = do { putByte bh 2
1178 put_ bh (IfNewTyCon c) = do { putByte bh 3
1183 0 -> return IfAbstractTyCon
1184 1 -> return IfOpenDataTyCon
1185 2 -> do cs <- get bh
1186 return (IfDataTyCon cs)
1187 _ -> do aa <- get bh
1188 return (IfNewTyCon aa)
1190 instance Binary IfaceConDecl where
1191 put_ bh (IfCon a1 a2 a3 a4 a5 a6 a7 a8 a9) = do
1201 get bh = do a1 <- get bh
1210 return (IfCon a1 a2 a3 a4 a5 a6 a7 a8 a9)
1212 instance Binary IfaceClassOp where
1213 put_ bh (IfaceClassOp n def ty) = do
1214 put_ bh (occNameFS n)
1221 occ <- return $! mkOccNameFS varName n
1222 return (IfaceClassOp occ def ty)
1224 instance Binary IfaceRule where
1225 put_ bh (IfaceRule a1 a2 a3 a4 a5 a6 a7) = do
1241 return (IfaceRule a1 a2 a3 a4 a5 a6 a7)
1243 instance Binary IfaceVectInfo where
1244 put_ bh (IfaceVectInfo a1 a2 a3) = do
1252 return (IfaceVectInfo a1 a2 a3)