X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Fiface%2FBinIface.hs;h=beb39c00f1a9b78a1df1126caede4d4fa3bff198;hp=b04e6e104edce58b087922ce3b97e887fd4a72f9;hb=2662dbc5b2c30fc11ccb99e7f9b2dba794d680ba;hpb=388e3356f71daffa62f1d4157e1e07e4c68f218a diff --git a/compiler/iface/BinIface.hs b/compiler/iface/BinIface.hs index b04e6e1..beb39c0 100644 --- a/compiler/iface/BinIface.hs +++ b/compiler/iface/BinIface.hs @@ -17,7 +17,7 @@ import TcRnMonad import IfaceEnv import HscTypes import BasicTypes -import NewDemand +import Demand import Annotations import IfaceSyn import Module @@ -335,7 +335,7 @@ data BinDictionary = BinDictionary { {-! for StrictnessMark derive: Binary !-} {-! for Activation derive: Binary !-} --- NewDemand +-- Demand {-! for Demand derive: Binary !-} {-! for Demands derive: Binary !-} {-! for DmdResult derive: Binary !-} @@ -600,14 +600,16 @@ instance Binary RuleMatchInfo where else return FunLike instance Binary InlinePragma where - put_ bh (InlinePragma activation match_info) = do - put_ bh activation - put_ bh match_info + put_ bh (InlinePragma a b c) = do + put_ bh a + put_ bh b + put_ bh c get bh = do - act <- get bh - info <- get bh - return (InlinePragma act info) + a <- get bh + b <- get bh + c <- get bh + return (InlinePragma a b c) instance Binary StrictnessMark where put_ bh MarkedStrict = putByte bh 0 @@ -1159,18 +1161,15 @@ instance Binary IfaceInfoItem where put_ bh (HsStrictness ab) = do putByte bh 1 put_ bh ab - put_ bh (HsUnfold ad) = do + put_ bh (HsUnfold lb ad) = do putByte bh 2 + put_ bh lb put_ bh ad put_ bh (HsInline ad) = do putByte bh 3 put_ bh ad put_ bh HsNoCafRefs = do putByte bh 4 - put_ bh (HsWorker ae af) = do - putByte bh 5 - put_ bh ae - put_ bh af get bh = do h <- getByte bh case h of @@ -1178,21 +1177,48 @@ instance Binary IfaceInfoItem where return (HsArity aa) 1 -> do ab <- get bh return (HsStrictness ab) - 2 -> do ad <- get bh - return (HsUnfold ad) + 2 -> do lb <- get bh + ad <- get bh + return (HsUnfold lb ad) 3 -> do ad <- get bh return (HsInline ad) - 4 -> do return HsNoCafRefs - _ -> do ae <- get bh - af <- get bh - return (HsWorker ae af) + _ -> do return HsNoCafRefs + +instance Binary IfaceUnfolding where + put_ bh (IfCoreUnfold e) = do + putByte bh 0 + put_ bh e + put_ bh (IfInlineRule a b e) = do + putByte bh 1 + put_ bh a + put_ bh b + put_ bh e + put_ bh (IfWrapper a n) = do + putByte bh 2 + put_ bh a + put_ bh n + put_ bh (IfDFunUnfold as) = do + putByte bh 3 + put_ bh as + get bh = do + h <- getByte bh + case h of + 0 -> do e <- get bh + return (IfCoreUnfold e) + 1 -> do a <- get bh + b <- get bh + e <- get bh + return (IfInlineRule a b e) + 2 -> do a <- get bh + n <- get bh + return (IfWrapper a n) + _ -> do as <- get bh + return (IfDFunUnfold as) instance Binary IfaceNote where put_ bh (IfaceSCC aa) = do putByte bh 0 put_ bh aa - put_ bh IfaceInlineMe = do - putByte bh 3 put_ bh (IfaceCoreNote s) = do putByte bh 4 put_ bh s @@ -1201,7 +1227,6 @@ instance Binary IfaceNote where case h of 0 -> do aa <- get bh return (IfaceSCC aa) - 3 -> do return IfaceInlineMe 4 -> do ac <- get bh return (IfaceCoreNote ac) _ -> panic ("get IfaceNote " ++ show h)