X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Fiface%2FBinIface.hs;h=d79ec95f6afd698dab13b9bf2b217698a11bba87;hp=f32049ee09688cb6c1540a2cb263028bc9de5c63;hb=c1681a73fa4ca4cf8758264ae387ac09a9e900d8;hpb=4163e2a0d42200d184727892c965a59189992993 diff --git a/compiler/iface/BinIface.hs b/compiler/iface/BinIface.hs index f32049e..d79ec95 100644 --- a/compiler/iface/BinIface.hs +++ b/compiler/iface/BinIface.hs @@ -34,6 +34,7 @@ import Config import FastMutInt import Outputable +import Data.List import Data.Word import Data.Array import Data.IORef @@ -216,7 +217,7 @@ fromOnDiskName arr nc (pid, mod_name, occ) = let us = nsUniqs nc uniq = uniqFromSupply us - name = mkExternalName uniq mod occ noSrcLoc + name = mkExternalName uniq mod occ noSrcSpan new_cache = extendNameCache cache mod occ name in case splitUniqSupply us of { (us',_) -> @@ -293,7 +294,9 @@ instance Binary ModIface where mi_insts = insts, mi_fam_insts = fam_insts, mi_rules = rules, - mi_rule_vers = rule_vers }) = do + mi_rule_vers = rule_vers, + mi_vect_info = vect_info, + mi_hpc = hpc_info }) = do put_ bh mod put_ bh is_boot put_ bh mod_vers @@ -310,6 +313,8 @@ instance Binary ModIface where put_ bh fam_insts lazyPut bh rules put_ bh rule_vers + put_ bh vect_info + put_ bh hpc_info get bh = do mod_name <- get bh @@ -328,6 +333,8 @@ instance Binary ModIface where fam_insts <- {-# SCC "bin_fam_insts" #-} get bh rules <- {-# SCC "bin_rules" #-} lazyGet bh rule_vers <- get bh + vect_info <- get bh + hpc_info <- get bh return (ModIface { mi_module = mod_name, mi_boot = is_boot, @@ -346,6 +353,8 @@ instance Binary ModIface where mi_fam_insts = fam_insts, mi_rules = rules, mi_rule_vers = rule_vers, + mi_vect_info = vect_info, + mi_hpc = hpc_info, -- And build the cached values mi_dep_fn = mkIfaceDepCache deprecs, mi_fix_fn = mkIfaceFixCache fixities, @@ -690,6 +699,16 @@ instance Binary IfaceBndr where _ -> do ab <- get bh return (IfaceTvBndr ab) +instance Binary IfaceLetBndr where + put_ bh (IfLetBndr a b c) = do + put_ bh a + put_ bh b + put_ bh c + get bh = do a <- get bh + b <- get bh + c <- get bh + return (IfLetBndr a b c) + instance Binary IfaceType where put_ bh (IfaceForAllTy aa ab) = do putByte bh 0 @@ -874,6 +893,10 @@ instance Binary IfaceExpr where putByte bh 11 put_ bh ie put_ bh ico + put_ bh (IfaceTick m ix) = do + putByte bh 12 + put_ bh m + put_ bh ix get bh = do h <- getByte bh case h of @@ -913,6 +936,9 @@ instance Binary IfaceExpr where 11 -> do ie <- get bh ico <- get bh return (IfaceCast ie ico) + 12 -> do m <- get bh + ix <- get bh + return (IfaceTick m ix) instance Binary IfaceConAlt where put_ bh IfaceDefault = do @@ -1048,12 +1074,13 @@ instance Binary IfaceDecl where put_ bh a6 put_ bh a7 put_ bh a8 - put_ bh (IfaceSyn aq ar as at) = do + put_ bh (IfaceSyn a1 a2 a3 a4 a5) = do putByte bh 3 - put_ bh (occNameFS aq) - put_ bh ar - put_ bh as - put_ bh at + put_ bh (occNameFS a1) + put_ bh a2 + put_ bh a3 + put_ bh a4 + put_ bh a5 put_ bh (IfaceClass a1 a2 a3 a4 a5 a6 a7) = do putByte bh 4 put_ bh a1 @@ -1084,12 +1111,13 @@ instance Binary IfaceDecl where occ <- return $! mkOccNameFS tcName a1 return (IfaceData occ a2 a3 a4 a5 a6 a7 a8) 3 -> do - aq <- get bh - ar <- get bh - as <- get bh - at <- get bh - occ <- return $! mkOccNameFS tcName aq - return (IfaceSyn occ ar as at) + a1 <- get bh + a2 <- get bh + a3 <- get bh + a4 <- get bh + a5 <- get bh + occ <- return $! mkOccNameFS tcName a1 + return (IfaceSyn occ a2 a3 a4 a5) _ -> do a1 <- get bh a2 <- get bh @@ -1138,18 +1166,16 @@ instance Binary OverlapFlag where instance Binary IfaceConDecls where put_ bh IfAbstractTyCon = putByte bh 0 put_ bh IfOpenDataTyCon = putByte bh 1 - put_ bh IfOpenNewTyCon = putByte bh 2 - put_ bh (IfDataTyCon cs) = do { putByte bh 3 + put_ bh (IfDataTyCon cs) = do { putByte bh 2 ; put_ bh cs } - put_ bh (IfNewTyCon c) = do { putByte bh 4 + put_ bh (IfNewTyCon c) = do { putByte bh 3 ; put_ bh c } get bh = do h <- getByte bh case h of 0 -> return IfAbstractTyCon 1 -> return IfOpenDataTyCon - 2 -> return IfOpenNewTyCon - 3 -> do cs <- get bh + 2 -> do cs <- get bh return (IfDataTyCon cs) _ -> do aa <- get bh return (IfNewTyCon aa) @@ -1207,4 +1233,15 @@ instance Binary IfaceRule where a7 <- get bh return (IfaceRule a1 a2 a3 a4 a5 a6 a7) +instance Binary IfaceVectInfo where + put_ bh (IfaceVectInfo a1 a2 a3) = do + put_ bh a1 + put_ bh a2 + put_ bh a3 + get bh = do + a1 <- get bh + a2 <- get bh + a3 <- get bh + return (IfaceVectInfo a1 a2 a3) +