X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;ds=sidebyside;f=compiler%2Fiface%2FBinIface.hs;h=72a62a66de2e40a491dd59d6979f24bece3338b0;hb=9d0c8f842e35dde3d570580cf62a32779f66a6de;hp=7a274011b77f6174511d0a93464b8903b470918b;hpb=9ffadf219cbc4f8ec57264786df936a3cee88aec;p=ghc-hetmet.git diff --git a/compiler/iface/BinIface.hs b/compiler/iface/BinIface.hs index 7a27401..72a62a6 100644 --- a/compiler/iface/BinIface.hs +++ b/compiler/iface/BinIface.hs @@ -149,7 +149,7 @@ writeBinIface dflags hi_path mod_iface = do -- The version and way descriptor go next put_ bh (show opt_HiVersion) way_descr <- getWayDescr - put bh way_descr + put_ bh way_descr -- Remember where the symbol table pointer will go symtab_p_p <- tellBin bh @@ -578,6 +578,24 @@ instance Binary Activation where _ -> do ab <- get bh return (ActiveAfter ab) +instance Binary RuleMatchInfo where + put_ bh FunLike = putByte bh 0 + put_ bh ConLike = putByte bh 1 + get bh = do + h <- getByte bh + if h == 1 then return ConLike + else return FunLike + +instance Binary InlinePragma where + put_ bh (InlinePragma activation match_info) = do + put_ bh activation + put_ bh match_info + + get bh = do + act <- get bh + info <- get bh + return (InlinePragma act info) + instance Binary StrictnessMark where put_ bh MarkedStrict = putByte bh 0 put_ bh MarkedUnboxed = putByte bh 1 @@ -663,7 +681,7 @@ instance (Binary name) => Binary (IPName name) where instance Binary DmdType where -- Ignore DmdEnv when spitting out the DmdType - put bh (DmdType _ ds dr) = do p <- put bh ds; put bh dr; return (castBin p) + put bh (DmdType _ ds dr) = do p <- put bh ds; put_ bh dr; return (castBin p) get bh = do ds <- get bh; dr <- get bh; return (DmdType emptyVarEnv ds dr) instance Binary Demand where @@ -1092,15 +1110,16 @@ instance Binary IfaceBinding where return (IfaceRec ac) instance Binary IfaceIdDetails where - put_ bh IfVanillaId = putByte bh 0 - put_ bh (IfRecSelId b) = do { putByte bh 1; put_ bh b } - put_ bh IfDFunId = putByte bh 2 + put_ bh IfVanillaId = putByte bh 0 + put_ bh (IfRecSelId a b) = do { putByte bh 1; put_ bh a; put_ bh b } + put_ bh IfDFunId = putByte bh 2 get bh = do h <- getByte bh case h of 0 -> return IfVanillaId 1 -> do a <- get bh - return (IfRecSelId a) + b <- get bh + return (IfRecSelId a b) _ -> return IfDFunId instance Binary IfaceIdInfo where