X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Fiface%2FBinIface.hs;h=b04e6e104edce58b087922ce3b97e887fd4a72f9;hp=864bbde39ac87f6d0f89a2e8e1c65af302dcd106;hb=388e3356f71daffa62f1d4157e1e07e4c68f218a;hpb=1118ecad5c51fcca4aa2d219a0ba2b759a73d567 diff --git a/compiler/iface/BinIface.hs b/compiler/iface/BinIface.hs index 864bbde..b04e6e1 100644 --- a/compiler/iface/BinIface.hs +++ b/compiler/iface/BinIface.hs @@ -102,8 +102,8 @@ readBinIface_ dflags checkHiWay traceBinIFaceReading hi_path update_nc = do -- are always 32 bits. -- if wORD_SIZE == 4 - then do Binary.get bh :: IO Word32; return () - else do Binary.get bh :: IO Word64; return () + then do _ <- Binary.get bh :: IO Word32; return () + else do _ <- Binary.get bh :: IO Word64; return () -- Check the interface file version and ways. check_ver <- get bh @@ -287,13 +287,13 @@ putName BinSymbolTable{ = do symtab_map <- readIORef symtab_map_ref case lookupUFM symtab_map name of - Just (off,_) -> put_ bh off + Just (off,_) -> put_ bh (fromIntegral off :: Word32) Nothing -> do off <- readFastMutInt symtab_next writeFastMutInt symtab_next (off+1) writeIORef symtab_map_ref $! addToUFM symtab_map name (off,name) - put_ bh off + put_ bh (fromIntegral off :: Word32) data BinSymbolTable = BinSymbolTable { @@ -310,10 +310,10 @@ putFastString BinDictionary { bin_dict_next = j_r, out <- readIORef out_r let uniq = getUnique f case lookupUFM out uniq of - Just (j, _) -> put_ bh j + Just (j, _) -> put_ bh (fromIntegral j :: Word32) Nothing -> do j <- readFastMutInt j_r - put_ bh j + put_ bh (fromIntegral j :: Word32) writeFastMutInt j_r (j + 1) writeIORef out_r $! addToUFM out uniq (j, f) @@ -883,6 +883,7 @@ instance Binary IfaceType where put_ bh (IfaceTyConApp IfaceUnliftedTypeKindTc []) = putByte bh 14 put_ bh (IfaceTyConApp IfaceUbxTupleKindTc []) = putByte bh 15 put_ bh (IfaceTyConApp IfaceArgTypeKindTc []) = putByte bh 16 + put_ bh (IfaceTyConApp (IfaceAnyTc k) []) = do { putByte bh 17; put_ bh k } -- Generic cases @@ -918,6 +919,7 @@ instance Binary IfaceType where 14 -> return (IfaceTyConApp IfaceUnliftedTypeKindTc []) 15 -> return (IfaceTyConApp IfaceUbxTupleKindTc []) 16 -> return (IfaceTyConApp IfaceArgTypeKindTc []) + 17 -> do { k <- get bh; return (IfaceTyConApp (IfaceAnyTc k) []) } 18 -> do { tc <- get bh; tys <- get bh; return (IfaceTyConApp (IfaceTc tc) tys) } _ -> do { tc <- get bh; tys <- get bh; return (IfaceTyConApp tc tys) } @@ -937,6 +939,7 @@ instance Binary IfaceTyCon where put_ bh IfaceArgTypeKindTc = putByte bh 10 put_ bh (IfaceTupTc bx ar) = do { putByte bh 11; put_ bh bx; put_ bh ar } put_ bh (IfaceTc ext) = do { putByte bh 12; put_ bh ext } + put_ bh (IfaceAnyTc k) = do { putByte bh 13; put_ bh k } get bh = do h <- getByte bh @@ -952,7 +955,8 @@ instance Binary IfaceTyCon where 9 -> return IfaceUbxTupleKindTc 10 -> return IfaceArgTypeKindTc 11 -> do { bx <- get bh; ar <- get bh; return (IfaceTupTc bx ar) } - _ -> do { ext <- get bh; return (IfaceTc ext) } + 12 -> do { ext <- get bh; return (IfaceTc ext) } + _ -> do { k <- get bh; return (IfaceAnyTc k) } instance Binary IfacePredType where put_ bh (IfaceClassP aa ab) = do