diff options
Diffstat (limited to 'compiler/GHC/Utils')
| -rw-r--r-- | compiler/GHC/Utils/Binary.hs | 23 | ||||
| -rw-r--r-- | compiler/GHC/Utils/Binary/Typeable.hs | 13 |
2 files changed, 26 insertions, 10 deletions
diff --git a/compiler/GHC/Utils/Binary.hs b/compiler/GHC/Utils/Binary.hs index 7534d65918..6ee06274d3 100644 --- a/compiler/GHC/Utils/Binary.hs +++ b/compiler/GHC/Utils/Binary.hs @@ -1,5 +1,7 @@ {-# LANGUAGE CPP #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE ScopedTypeVariables #-} @@ -81,7 +83,7 @@ module GHC.Utils.Binary FSTable, initFSTable, getDictFastString, putDictFastString, -- * Newtype wrappers - BinSpan(..), BinSrcSpan(..), BinLocated(..) + BinSpan(..), BinSrcSpan(..), BinLocated(..), SerialisableChar(..) ) where import GHC.Prelude @@ -125,6 +127,8 @@ import qualified Data.IntMap as IntMap import GHC.ForeignPtr ( unsafeWithForeignPtr ) #endif +import GHC.TypeError + type BinArray = ForeignPtr Word8 #if !MIN_VERSION_base(4,15,0) @@ -675,9 +679,20 @@ instance Binary Bool where put_ bh b = putByte bh (fromIntegral (fromEnum b)) get bh = do x <- getWord8 bh; return $! (toEnum (fromIntegral x)) -instance Binary Char where - put_ bh c = put_ bh (fromIntegral (ord c) :: Word32) - get bh = do x <- get bh; return $! (chr (fromIntegral (x :: Word32))) +instance (TypeError (Text "No instance for Binary Char" + :$$: Text "We don't want to serialise Strings into interface files" + :$$: Text "Use a compact representation like " :<>: ShowType FastString :<>: Text " instead" + :$$: Text "If you really want to serialise you can use " :<>: ShowType SerialisableChar) + ) + => Binary Char where + put_ = undefined + get = undefined + +newtype SerialisableChar = SerialisableChar { getSerialisedChar :: Char } + +instance Binary SerialisableChar where + put_ bh (SerialisableChar c) = put_ bh (fromIntegral (ord c) :: Word32) + get bh = do x <- get bh; return $! (SerialisableChar $ chr (fromIntegral (x :: Word32))) instance Binary Int where put_ bh i = put_ bh (fromIntegral i :: Int64) diff --git a/compiler/GHC/Utils/Binary/Typeable.hs b/compiler/GHC/Utils/Binary/Typeable.hs index 5734905ebd..bc2dd7da48 100644 --- a/compiler/GHC/Utils/Binary/Typeable.hs +++ b/compiler/GHC/Utils/Binary/Typeable.hs @@ -17,6 +17,7 @@ where import GHC.Prelude import GHC.Utils.Binary +import GHC.Data.FastString import GHC.Exts (RuntimeRep(..), VecCount(..), VecElem(..)) #if __GLASGOW_HASKELL__ >= 901 @@ -32,13 +33,13 @@ import Data.Kind (Type) instance Binary TyCon where put_ bh tc = do - put_ bh (tyConPackage tc) - put_ bh (tyConModule tc) - put_ bh (tyConName tc) + put_ bh (mkFastString $ tyConPackage tc) + put_ bh (mkFastString $ tyConModule tc) + put_ bh (mkFastString $ tyConName tc) put_ bh (tyConKindArgs tc) put_ bh (tyConKindRep tc) get bh = - mkTyCon <$> get bh <*> get bh <*> get bh <*> get bh <*> get bh + mkTyCon <$> (unpackFS <$> get bh) <*> (unpackFS <$> get bh) <*> (unpackFS <$> get bh) <*> get bh <*> get bh getSomeTypeRep :: BinHandle -> IO SomeTypeRep getSomeTypeRep bh = do @@ -157,7 +158,7 @@ instance Binary KindRep where put_ bh (KindRepApp a b) = putByte bh 2 >> put_ bh a >> put_ bh b put_ bh (KindRepFun a b) = putByte bh 3 >> put_ bh a >> put_ bh b put_ bh (KindRepTYPE r) = putByte bh 4 >> put_ bh r - put_ bh (KindRepTypeLit sort r) = putByte bh 5 >> put_ bh sort >> put_ bh r + put_ bh (KindRepTypeLit sort r) = putByte bh 5 >> put_ bh sort >> put_ bh (mkFastString r) get bh = do tag <- getByte bh @@ -167,7 +168,7 @@ instance Binary KindRep where 2 -> KindRepApp <$> get bh <*> get bh 3 -> KindRepFun <$> get bh <*> get bh 4 -> KindRepTYPE <$> get bh - 5 -> KindRepTypeLit <$> get bh <*> get bh + 5 -> KindRepTypeLit <$> get bh <*> (unpackFS <$> get bh) _ -> fail "Binary.putKindRep: invalid tag" instance Binary TypeLitSort where |