2 -- The above warning supression flag is a temporary kludge.
3 -- While working on this module you are encouraged to remove it and fix
4 -- any warnings in the module. See
5 -- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
9 -- (c) The University of Glasgow 2002-2006
11 -- Binary interface file support.
13 module BinIface ( writeBinIface, readBinIface, CheckHiWay(..) ) where
15 #include "HsVersions.h"
48 import Control.Exception
51 data CheckHiWay = CheckHiWay | IgnoreHiWay
54 -- ---------------------------------------------------------------------------
55 -- Reading and writing binary interface files
57 readBinIface :: CheckHiWay -> FilePath -> TcRnIf a b ModIface
58 readBinIface checkHiWay hi_path = do
60 (new_nc, iface) <- liftIO $ readBinIface_ checkHiWay hi_path nc
64 readBinIface_ :: CheckHiWay -> FilePath -> NameCache
65 -> IO (NameCache, ModIface)
66 readBinIface_ checkHiWay hi_path nc = do
67 bh <- Binary.readBinMem hi_path
69 -- Read the magic number to check that this really is a GHC .hi file
70 -- (This magic number does not change when we change
71 -- GHC interface file format)
73 when (magic /= binaryInterfaceMagic) $
74 throwDyn (ProgramError (
75 "magic number mismatch: old/corrupt interface file?"))
77 -- Get the dictionary pointer. We won't attempt to actually
78 -- read the dictionary until we've done the version checks below,
79 -- just in case this isn't a valid interface. In retrospect the
80 -- version should have come before the dictionary pointer, but this
81 -- is the way it was done originally, and we can't change it now.
82 dict_p <- Binary.get bh -- Get the dictionary ptr
84 -- Check the interface file version and ways.
86 let our_ver = show opt_HiVersion
87 when (check_ver /= our_ver) $
88 -- This will be caught by readIface which will emit an error
89 -- msg containing the iface module name.
90 throwDyn (ProgramError (
91 "mismatched interface file versions: expected "
92 ++ our_ver ++ ", found " ++ check_ver))
95 way_descr <- getWayDescr
96 when (checkHiWay == CheckHiWay && check_way /= way_descr) $
97 -- This will be caught by readIface
98 -- which will emit an error msg containing the iface module name.
99 throwDyn (ProgramError (
100 "mismatched interface file ways: expected "
101 ++ way_descr ++ ", found " ++ check_way))
103 -- Read the dictionary
104 -- The next word in the file is a pointer to where the dictionary is
105 -- (probably at the end of the file)
106 data_p <- tellBin bh -- Remember where we are now
108 dict <- getDictionary bh
109 seekBin bh data_p -- Back to where we were before
111 -- Initialise the user-data field of bh
112 ud <- newReadState dict
113 bh <- return (setUserData bh ud)
115 symtab_p <- Binary.get bh -- Get the symtab ptr
116 data_p <- tellBin bh -- Remember where we are now
118 (nc', symtab) <- getSymbolTable bh nc
119 seekBin bh data_p -- Back to where we were before
120 let ud = getUserData bh
121 bh <- return $! setUserData bh ud{ud_symtab = symtab}
126 writeBinIface :: DynFlags -> FilePath -> ModIface -> IO ()
127 writeBinIface dflags hi_path mod_iface = do
128 bh <- openBinMem initBinMemSize
129 put_ bh binaryInterfaceMagic
131 -- Remember where the dictionary pointer will go
132 dict_p_p <- tellBin bh
133 put_ bh dict_p_p -- Placeholder for ptr to dictionary
135 -- The version and way descriptor go next
136 put_ bh (show opt_HiVersion)
137 way_descr <- getWayDescr
140 -- Remember where the symbol table pointer will go
141 symtab_p_p <- tellBin bh
144 -- Make some intial state
147 -- Put the main thing,
148 bh <- return $ setUserData bh ud
151 -- Write the symtab pointer at the fornt of the file
152 symtab_p <- tellBin bh -- This is where the symtab will start
153 putAt bh symtab_p_p symtab_p -- Fill in the placeholder
154 seekBin bh symtab_p -- Seek back to the end of the file
156 -- Write the symbol table itself
157 symtab_next <- readFastMutInt (ud_symtab_next ud)
158 symtab_map <- readIORef (ud_symtab_map ud)
159 putSymbolTable bh symtab_next symtab_map
160 debugTraceMsg dflags 3 (text "writeBinIface:" <+> int symtab_next
163 -- NB. write the dictionary after the symbol table, because
164 -- writing the symbol table may create more dictionary entries.
166 -- Write the dictionary pointer at the fornt of the file
167 dict_p <- tellBin bh -- This is where the dictionary will start
168 putAt bh dict_p_p dict_p -- Fill in the placeholder
169 seekBin bh dict_p -- Seek back to the end of the file
171 -- Write the dictionary itself
172 dict_next <- readFastMutInt (ud_dict_next ud)
173 dict_map <- readIORef (ud_dict_map ud)
174 putDictionary bh dict_next dict_map
175 debugTraceMsg dflags 3 (text "writeBinIface:" <+> int dict_next
176 <+> text "dict entries")
178 -- And send the result to the file
179 writeBinMem bh hi_path
181 initBinMemSize = (1024*1024) :: Int
183 -- The *host* architecture version:
184 #include "MachDeps.h"
186 #if WORD_SIZE_IN_BITS == 32
187 binaryInterfaceMagic = 0x1face :: Word32
188 #elif WORD_SIZE_IN_BITS == 64
189 binaryInterfaceMagic = 0x1face64 :: Word32
192 -- -----------------------------------------------------------------------------
195 putSymbolTable :: BinHandle -> Int -> UniqFM (Int,Name) -> IO ()
196 putSymbolTable bh next_off symtab = do
198 let names = elems (array (0,next_off-1) (eltsUFM symtab))
199 mapM_ (\n -> serialiseName bh n symtab) names
201 getSymbolTable :: BinHandle -> NameCache -> IO (NameCache, Array Int Name)
202 getSymbolTable bh namecache = do
204 od_names <- sequence (replicate sz (get bh))
206 arr = listArray (0,sz-1) names
207 (namecache', names) =
208 mapAccumR (fromOnDiskName arr) namecache od_names
210 return (namecache', arr)
212 type OnDiskName = (PackageId, ModuleName, OccName)
219 fromOnDiskName arr nc (pid, mod_name, occ) =
221 mod = mkModule pid mod_name
224 case lookupOrigNameCache cache mod occ of
225 Just name -> (nc, name)
229 uniq = uniqFromSupply us
230 name = mkExternalName uniq mod occ noSrcSpan
231 new_cache = extendNameCache cache mod occ name
233 case splitUniqSupply us of { (us',_) ->
234 ( nc{ nsUniqs = us', nsNames = new_cache }, name )
237 serialiseName :: BinHandle -> Name -> UniqFM (Int,Name) -> IO ()
238 serialiseName bh name symtab = do
239 let mod = nameModule name
240 put_ bh (modulePackageId mod, moduleName mod, nameOccName name)
242 -- -----------------------------------------------------------------------------
243 -- All the binary instances
246 {-! for IPName derive: Binary !-}
247 {-! for Fixity derive: Binary !-}
248 {-! for FixityDirection derive: Binary !-}
249 {-! for Boxity derive: Binary !-}
250 {-! for StrictnessMark derive: Binary !-}
251 {-! for Activation derive: Binary !-}
254 {-! for Demand derive: Binary !-}
255 {-! for Demands derive: Binary !-}
256 {-! for DmdResult derive: Binary !-}
257 {-! for StrictSig derive: Binary !-}
260 {-! for DefMeth derive: Binary !-}
263 {-! for HsPred derive: Binary !-}
264 {-! for HsType derive: Binary !-}
265 {-! for TupCon derive: Binary !-}
266 {-! for HsTyVarBndr derive: Binary !-}
269 {-! for UfExpr derive: Binary !-}
270 {-! for UfConAlt derive: Binary !-}
271 {-! for UfBinding derive: Binary !-}
272 {-! for UfBinder derive: Binary !-}
273 {-! for HsIdInfo derive: Binary !-}
274 {-! for UfNote derive: Binary !-}
277 {-! for ConDetails derive: Binary !-}
278 {-! for BangType derive: Binary !-}
281 {-! for IsCafCC derive: Binary !-}
282 {-! for IsDupdCC derive: Binary !-}
283 {-! for CostCentre derive: Binary !-}
287 -- ---------------------------------------------------------------------------
288 -- Reading a binary interface into ParsedIface
290 instance Binary ModIface where
294 mi_mod_vers = mod_vers,
296 mi_finsts = hasFamInsts,
299 mi_exports = exports,
300 mi_exp_vers = exp_vers,
301 mi_fixities = fixities,
302 mi_deprecs = deprecs,
305 mi_fam_insts = fam_insts,
307 mi_rule_vers = rule_vers,
308 mi_vect_info = vect_info,
309 mi_hpc = hpc_info }) = do
334 hasFamInsts <- get bh
336 usages <- {-# SCC "bin_usages" #-} lazyGet bh
337 exports <- {-# SCC "bin_exports" #-} get bh
339 fixities <- {-# SCC "bin_fixities" #-} get bh
340 deprecs <- {-# SCC "bin_deprecs" #-} lazyGet bh
341 decls <- {-# SCC "bin_tycldecls" #-} get bh
342 insts <- {-# SCC "bin_insts" #-} get bh
343 fam_insts <- {-# SCC "bin_fam_insts" #-} get bh
344 rules <- {-# SCC "bin_rules" #-} lazyGet bh
349 mi_module = mod_name,
351 mi_mod_vers = mod_vers,
353 mi_finsts = hasFamInsts,
356 mi_exports = exports,
357 mi_exp_vers = exp_vers,
358 mi_fixities = fixities,
359 mi_deprecs = deprecs,
361 mi_globals = Nothing,
363 mi_fam_insts = fam_insts,
365 mi_rule_vers = rule_vers,
366 mi_vect_info = vect_info,
368 -- And build the cached values
369 mi_dep_fn = mkIfaceDepCache deprecs,
370 mi_fix_fn = mkIfaceFixCache fixities,
371 mi_ver_fn = mkIfaceVerCache decls })
373 getWayDescr :: IO String
375 tag <- readIORef v_Build_tag
376 if cGhcUnregisterised == "YES" then return ('u':tag) else return tag
377 -- if this is an unregisterised build, make sure our interfaces
378 -- can't be used by a registerised build.
380 -------------------------------------------------------------------------
381 -- Types from: HscTypes
382 -------------------------------------------------------------------------
384 instance Binary Dependencies where
385 put_ bh deps = do put_ bh (dep_mods deps)
386 put_ bh (dep_pkgs deps)
387 put_ bh (dep_orphs deps)
388 put_ bh (dep_finsts deps)
390 get bh = do ms <- get bh
394 return (Deps { dep_mods = ms, dep_pkgs = ps, dep_orphs = os,
397 instance (Binary name) => Binary (GenAvailInfo name) where
398 put_ bh (Avail aa) = do
401 put_ bh (AvailTC ab ac) = do
412 return (AvailTC ab ac)
414 instance Binary Usage where
416 put_ bh (usg_name usg)
417 put_ bh (usg_mod usg)
418 put_ bh (usg_exports usg)
419 put_ bh (usg_entities usg)
420 put_ bh (usg_rules usg)
428 return (Usage { usg_name = nm, usg_mod = mod,
429 usg_exports = exps, usg_entities = ents,
432 instance Binary Deprecations where
433 put_ bh NoDeprecs = putByte bh 0
434 put_ bh (DeprecAll t) = do
437 put_ bh (DeprecSome ts) = do
444 0 -> return NoDeprecs
446 return (DeprecAll aa)
448 return (DeprecSome aa)
450 -------------------------------------------------------------------------
451 -- Types from: BasicTypes
452 -------------------------------------------------------------------------
454 instance Binary Activation where
455 put_ bh NeverActive = do
457 put_ bh AlwaysActive = do
459 put_ bh (ActiveBefore aa) = do
462 put_ bh (ActiveAfter ab) = do
468 0 -> do return NeverActive
469 1 -> do return AlwaysActive
471 return (ActiveBefore aa)
473 return (ActiveAfter ab)
475 instance Binary StrictnessMark where
476 put_ bh MarkedStrict = do
478 put_ bh MarkedUnboxed = do
480 put_ bh NotMarkedStrict = do
485 0 -> do return MarkedStrict
486 1 -> do return MarkedUnboxed
487 _ -> do return NotMarkedStrict
489 instance Binary Boxity where
498 _ -> do return Unboxed
500 instance Binary TupCon where
501 put_ bh (TupCon ab ac) = do
507 return (TupCon ab ac)
509 instance Binary RecFlag where
510 put_ bh Recursive = do
512 put_ bh NonRecursive = do
517 0 -> do return Recursive
518 _ -> do return NonRecursive
520 instance Binary DefMeth where
521 put_ bh NoDefMeth = putByte bh 0
522 put_ bh DefMeth = putByte bh 1
523 put_ bh GenDefMeth = putByte bh 2
527 0 -> return NoDefMeth
529 _ -> return GenDefMeth
531 instance Binary FixityDirection where
541 0 -> do return InfixL
542 1 -> do return InfixR
543 _ -> do return InfixN
545 instance Binary Fixity where
546 put_ bh (Fixity aa ab) = do
552 return (Fixity aa ab)
554 instance (Binary name) => Binary (IPName name) where
555 put_ bh (IPName aa) = put_ bh aa
556 get bh = do aa <- get bh
559 -------------------------------------------------------------------------
560 -- Types from: Demand
561 -------------------------------------------------------------------------
563 instance Binary DmdType where
564 -- Ignore DmdEnv when spitting out the DmdType
565 put bh (DmdType _ ds dr) = do p <- put bh ds; put bh dr; return (castBin p)
566 get bh = do ds <- get bh; dr <- get bh; return (DmdType emptyVarEnv ds dr)
568 instance Binary Demand where
573 put_ bh (Call aa) = do
576 put_ bh (Eval ab) = do
579 put_ bh (Defer ac) = do
582 put_ bh (Box ad) = do
602 instance Binary Demands where
603 put_ bh (Poly aa) = do
606 put_ bh (Prod ab) = do
617 instance Binary DmdResult where
627 0 -> do return TopRes
628 1 -> do return RetCPR -- Really use RetCPR even if -fcpr-off
629 -- The wrapper was generated for CPR in
630 -- the imported module!
631 _ -> do return BotRes
633 instance Binary StrictSig where
634 put_ bh (StrictSig aa) = do
638 return (StrictSig aa)
641 -------------------------------------------------------------------------
642 -- Types from: CostCentre
643 -------------------------------------------------------------------------
645 instance Binary IsCafCC where
648 put_ bh NotCafCC = do
654 _ -> do return NotCafCC
656 instance Binary IsDupdCC where
657 put_ bh OriginalCC = do
664 0 -> do return OriginalCC
665 _ -> do return DupdCC
667 instance Binary CostCentre where
668 put_ bh NoCostCentre = do
670 put_ bh (NormalCC aa ab ac ad) = do
676 put_ bh (AllCafsCC ae) = do
682 0 -> do return NoCostCentre
687 return (NormalCC aa ab ac ad)
689 return (AllCafsCC ae)
691 -------------------------------------------------------------------------
692 -- IfaceTypes and friends
693 -------------------------------------------------------------------------
695 instance Binary IfaceBndr where
696 put_ bh (IfaceIdBndr aa) = do
699 put_ bh (IfaceTvBndr ab) = do
706 return (IfaceIdBndr aa)
708 return (IfaceTvBndr ab)
710 instance Binary IfaceLetBndr where
711 put_ bh (IfLetBndr a b c) = do
715 get bh = do a <- get bh
718 return (IfLetBndr a b c)
720 instance Binary IfaceType where
721 put_ bh (IfaceForAllTy aa ab) = do
725 put_ bh (IfaceTyVar ad) = do
728 put_ bh (IfaceAppTy ae af) = do
732 put_ bh (IfaceFunTy ag ah) = do
736 put_ bh (IfacePredTy aq) = do
740 -- Simple compression for common cases of TyConApp
741 put_ bh (IfaceTyConApp IfaceIntTc []) = putByte bh 6
742 put_ bh (IfaceTyConApp IfaceCharTc []) = putByte bh 7
743 put_ bh (IfaceTyConApp IfaceBoolTc []) = putByte bh 8
744 put_ bh (IfaceTyConApp IfaceListTc [ty]) = do { putByte bh 9; put_ bh ty }
745 -- Unit tuple and pairs
746 put_ bh (IfaceTyConApp (IfaceTupTc Boxed 0) []) = putByte bh 10
747 put_ bh (IfaceTyConApp (IfaceTupTc Boxed 2) [t1,t2]) = do { putByte bh 11; put_ bh t1; put_ bh t2 }
749 put_ bh (IfaceTyConApp IfaceLiftedTypeKindTc []) = putByte bh 12
750 put_ bh (IfaceTyConApp IfaceOpenTypeKindTc []) = putByte bh 13
751 put_ bh (IfaceTyConApp IfaceUnliftedTypeKindTc []) = putByte bh 14
752 put_ bh (IfaceTyConApp IfaceUbxTupleKindTc []) = putByte bh 15
753 put_ bh (IfaceTyConApp IfaceArgTypeKindTc []) = putByte bh 16
757 put_ bh (IfaceTyConApp (IfaceTc tc) tys) = do { putByte bh 18; put_ bh tc; put_ bh tys }
758 put_ bh (IfaceTyConApp tc tys) = do { putByte bh 19; put_ bh tc; put_ bh tys }
765 return (IfaceForAllTy aa ab)
767 return (IfaceTyVar ad)
770 return (IfaceAppTy ae af)
773 return (IfaceFunTy ag ah)
775 return (IfacePredTy ap)
777 -- Now the special cases for TyConApp
778 6 -> return (IfaceTyConApp IfaceIntTc [])
779 7 -> return (IfaceTyConApp IfaceCharTc [])
780 8 -> return (IfaceTyConApp IfaceBoolTc [])
781 9 -> do { ty <- get bh; return (IfaceTyConApp IfaceListTc [ty]) }
782 10 -> return (IfaceTyConApp (IfaceTupTc Boxed 0) [])
783 11 -> do { t1 <- get bh; t2 <- get bh; return (IfaceTyConApp (IfaceTupTc Boxed 2) [t1,t2]) }
784 12 -> return (IfaceTyConApp IfaceLiftedTypeKindTc [])
785 13 -> return (IfaceTyConApp IfaceOpenTypeKindTc [])
786 14 -> return (IfaceTyConApp IfaceUnliftedTypeKindTc [])
787 15 -> return (IfaceTyConApp IfaceUbxTupleKindTc [])
788 16 -> return (IfaceTyConApp IfaceArgTypeKindTc [])
790 18 -> do { tc <- get bh; tys <- get bh; return (IfaceTyConApp (IfaceTc tc) tys) }
791 _ -> do { tc <- get bh; tys <- get bh; return (IfaceTyConApp tc tys) }
793 instance Binary IfaceTyCon where
794 -- Int,Char,Bool can't show up here because they can't not be saturated
796 put_ bh IfaceIntTc = putByte bh 1
797 put_ bh IfaceBoolTc = putByte bh 2
798 put_ bh IfaceCharTc = putByte bh 3
799 put_ bh IfaceListTc = putByte bh 4
800 put_ bh IfacePArrTc = putByte bh 5
801 put_ bh IfaceLiftedTypeKindTc = putByte bh 6
802 put_ bh IfaceOpenTypeKindTc = putByte bh 7
803 put_ bh IfaceUnliftedTypeKindTc = putByte bh 8
804 put_ bh IfaceUbxTupleKindTc = putByte bh 9
805 put_ bh IfaceArgTypeKindTc = putByte bh 10
806 put_ bh (IfaceTupTc bx ar) = do { putByte bh 11; put_ bh bx; put_ bh ar }
807 put_ bh (IfaceTc ext) = do { putByte bh 12; put_ bh ext }
812 1 -> return IfaceIntTc
813 2 -> return IfaceBoolTc
814 3 -> return IfaceCharTc
815 4 -> return IfaceListTc
816 5 -> return IfacePArrTc
817 6 -> return IfaceLiftedTypeKindTc
818 7 -> return IfaceOpenTypeKindTc
819 8 -> return IfaceUnliftedTypeKindTc
820 9 -> return IfaceUbxTupleKindTc
821 10 -> return IfaceArgTypeKindTc
822 11 -> do { bx <- get bh; ar <- get bh; return (IfaceTupTc bx ar) }
823 _ -> do { ext <- get bh; return (IfaceTc ext) }
825 instance Binary IfacePredType where
826 put_ bh (IfaceClassP aa ab) = do
830 put_ bh (IfaceIParam ac ad) = do
834 put_ bh (IfaceEqPred ac ad) = do
843 return (IfaceClassP aa ab)
846 return (IfaceIParam ac ad)
849 return (IfaceEqPred ac ad)
851 -------------------------------------------------------------------------
852 -- IfaceExpr and friends
853 -------------------------------------------------------------------------
855 instance Binary IfaceExpr where
856 put_ bh (IfaceLcl aa) = do
859 put_ bh (IfaceType ab) = do
862 put_ bh (IfaceTuple ac ad) = do
866 put_ bh (IfaceLam ae af) = do
870 put_ bh (IfaceApp ag ah) = do
875 put_ bh (IfaceCase ai aj al ak) = do
882 put_ bh (IfaceLet al am) = do
886 put_ bh (IfaceNote an ao) = do
890 put_ bh (IfaceLit ap) = do
893 put_ bh (IfaceFCall as at) = do
897 put_ bh (IfaceExt aa) = do
900 put_ bh (IfaceCast ie ico) = do
904 put_ bh (IfaceTick m ix) = do
914 return (IfaceType ab)
917 return (IfaceTuple ac ad)
920 return (IfaceLam ae af)
923 return (IfaceApp ag ah)
930 return (IfaceCase ai aj al ak)
933 return (IfaceLet al am)
936 return (IfaceNote an ao)
941 return (IfaceFCall as at)
942 10 -> do aa <- get bh
944 11 -> do ie <- get bh
946 return (IfaceCast ie ico)
949 return (IfaceTick m ix)
951 instance Binary IfaceConAlt where
952 put_ bh IfaceDefault = do
954 put_ bh (IfaceDataAlt aa) = do
957 put_ bh (IfaceTupleAlt ab) = do
960 put_ bh (IfaceLitAlt ac) = do
966 0 -> do return IfaceDefault
968 return (IfaceDataAlt aa)
970 return (IfaceTupleAlt ab)
972 return (IfaceLitAlt ac)
974 instance Binary IfaceBinding where
975 put_ bh (IfaceNonRec aa ab) = do
979 put_ bh (IfaceRec ac) = do
987 return (IfaceNonRec aa ab)
991 instance Binary IfaceIdInfo where
992 put_ bh NoInfo = putByte bh 0
993 put_ bh (HasInfo i) = do
995 lazyPut bh i -- NB lazyPut
1001 _ -> do info <- lazyGet bh -- NB lazyGet
1002 return (HasInfo info)
1004 instance Binary IfaceInfoItem where
1005 put_ bh (HsArity aa) = do
1008 put_ bh (HsStrictness ab) = do
1011 put_ bh (HsUnfold ad) = do
1014 put_ bh (HsInline ad) = do
1017 put_ bh HsNoCafRefs = do
1019 put_ bh (HsWorker ae af) = do
1026 0 -> do aa <- get bh
1028 1 -> do ab <- get bh
1029 return (HsStrictness ab)
1030 2 -> do ad <- get bh
1031 return (HsUnfold ad)
1032 3 -> do ad <- get bh
1033 return (HsInline ad)
1034 4 -> do return HsNoCafRefs
1035 _ -> do ae <- get bh
1037 return (HsWorker ae af)
1039 instance Binary IfaceNote where
1040 put_ bh (IfaceSCC aa) = do
1043 put_ bh IfaceInlineMe = do
1045 put_ bh (IfaceCoreNote s) = do
1051 0 -> do aa <- get bh
1052 return (IfaceSCC aa)
1053 3 -> do return IfaceInlineMe
1054 4 -> do ac <- get bh
1055 return (IfaceCoreNote ac)
1057 -------------------------------------------------------------------------
1058 -- IfaceDecl and friends
1059 -------------------------------------------------------------------------
1061 -- A bit of magic going on here: there's no need to store the OccName
1062 -- for a decl on the disk, since we can infer the namespace from the
1063 -- context; however it is useful to have the OccName in the IfaceDecl
1064 -- to avoid re-building it in various places. So we build the OccName
1065 -- when de-serialising.
1067 instance Binary IfaceDecl where
1068 put_ bh (IfaceId name ty idinfo) = do
1070 put_ bh (occNameFS name)
1073 put_ bh (IfaceForeign ae af) =
1074 error "Binary.put_(IfaceDecl): IfaceForeign"
1075 put_ bh (IfaceData a1 a2 a3 a4 a5 a6 a7 a8) = do
1077 put_ bh (occNameFS a1)
1085 put_ bh (IfaceSyn a1 a2 a3 a4 a5) = do
1087 put_ bh (occNameFS a1)
1092 put_ bh (IfaceClass a1 a2 a3 a4 a5 a6 a7) = do
1095 put_ bh (occNameFS a2)
1104 0 -> do name <- get bh
1107 occ <- return $! mkOccNameFS varName name
1108 return (IfaceId occ ty idinfo)
1109 1 -> error "Binary.get(TyClDecl): ForeignType"
1119 occ <- return $! mkOccNameFS tcName a1
1120 return (IfaceData occ a2 a3 a4 a5 a6 a7 a8)
1127 occ <- return $! mkOccNameFS tcName a1
1128 return (IfaceSyn occ a2 a3 a4 a5)
1137 occ <- return $! mkOccNameFS clsName a2
1138 return (IfaceClass a1 occ a3 a4 a5 a6 a7)
1140 instance Binary IfaceInst where
1141 put_ bh (IfaceInst cls tys dfun flag orph) = do
1147 get bh = do cls <- get bh
1152 return (IfaceInst cls tys dfun flag orph)
1154 instance Binary IfaceFamInst where
1155 put_ bh (IfaceFamInst fam tys tycon) = do
1159 get bh = do fam <- get bh
1162 return (IfaceFamInst fam tys tycon)
1164 instance Binary OverlapFlag where
1165 put_ bh NoOverlap = putByte bh 0
1166 put_ bh OverlapOk = putByte bh 1
1167 put_ bh Incoherent = putByte bh 2
1168 get bh = do h <- getByte bh
1170 0 -> return NoOverlap
1171 1 -> return OverlapOk
1172 2 -> return Incoherent
1174 instance Binary IfaceConDecls where
1175 put_ bh IfAbstractTyCon = putByte bh 0
1176 put_ bh IfOpenDataTyCon = putByte bh 1
1177 put_ bh (IfDataTyCon cs) = do { putByte bh 2
1179 put_ bh (IfNewTyCon c) = do { putByte bh 3
1184 0 -> return IfAbstractTyCon
1185 1 -> return IfOpenDataTyCon
1186 2 -> do cs <- get bh
1187 return (IfDataTyCon cs)
1188 _ -> do aa <- get bh
1189 return (IfNewTyCon aa)
1191 instance Binary IfaceConDecl where
1192 put_ bh (IfCon a1 a2 a3 a4 a5 a6 a7 a8 a9) = do
1202 get bh = do a1 <- get bh
1211 return (IfCon a1 a2 a3 a4 a5 a6 a7 a8 a9)
1213 instance Binary IfaceClassOp where
1214 put_ bh (IfaceClassOp n def ty) = do
1215 put_ bh (occNameFS n)
1222 occ <- return $! mkOccNameFS varName n
1223 return (IfaceClassOp occ def ty)
1225 instance Binary IfaceRule where
1226 put_ bh (IfaceRule a1 a2 a3 a4 a5 a6 a7) = do
1242 return (IfaceRule a1 a2 a3 a4 a5 a6 a7)
1244 instance Binary IfaceVectInfo where
1245 put_ bh (IfaceVectInfo a1 a2 a3) = do
1253 return (IfaceVectInfo a1 a2 a3)