    {-# LANGUAGE TypeFamilies, DataKinds, GADTs, FlexibleInstances #-}
    {-# LANGUAGE CPP #-}
    {-# LANGUAGE ConstraintKinds #-}

    -- We export this type from this module instead of GHC.Stg.InferTags.Types
    -- because it's used by more than the analysis itself. For example in interface
    -- files where we record a tag signature for bindings.
    -- By putting the sig into it's own module we can avoid module loops.
    module GHC.Stg.InferTags.TagSig

    where

    import GHC.Prelude

    import GHC.Types.Var
    import GHC.Utils.Outputable
    import GHC.Utils.Binary
    import GHC.Utils.Panic.Plain

    data TagInfo
      = TagDunno            -- We don't know anything about the tag.
      | TagTuple [TagInfo]  -- Represents a function/thunk which when evaluated
                            -- will return a Unboxed tuple whos components have
                            -- the given TagInfos.
      | TagProper           -- Heap pointer to properly-tagged value
      | TagTagged           -- Bottom of the domain.
      deriving (TagInfo -> TagInfo -> Bool
    (TagInfo -> TagInfo -> Bool)
    -> (TagInfo -> TagInfo -> Bool) -> Eq TagInfo
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: TagInfo -> TagInfo -> Bool
    == :: TagInfo -> TagInfo -> Bool
    $c/= :: TagInfo -> TagInfo -> Bool
    /= :: TagInfo -> TagInfo -> Bool
    Eq)

    instance Outputable TagInfo where
      ppr :: TagInfo -> SDoc
    ppr TagInfo
    TagTagged      = String -> SDoc
    text String
    "TagTagged"
      ppr TagInfo
    TagDunno       = String -> SDoc
    text String
    "TagDunno"
      ppr TagInfo
    TagProper      = String -> SDoc
    text String
    "TagProper"
      ppr (TagTuple [TagInfo]
    tis) = String -> SDoc
    text String
    "TagTuple" SDoc -> SDoc -> SDoc
    <> SDoc -> SDoc
    brackets ((TagInfo -> SDoc) -> [TagInfo] -> SDoc
    forall a. (a -> SDoc) -> [a] -> SDoc
    pprWithCommas TagInfo -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr [TagInfo]
    tis)

    instance Binary TagInfo where
      put_ :: BinHandle -> TagInfo -> IO ()
    put_ BinHandle
    bh TagInfo
    TagDunno  = BinHandle -> Word8 -> IO ()
    putByte BinHandle
    bh Word8
    1
      put_ BinHandle
    bh (TagTuple [TagInfo]
    flds) = BinHandle -> Word8 -> IO ()
    putByte BinHandle
    bh Word8
    2 IO () -> IO () -> IO ()
    forall a b. IO a -> IO b -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> BinHandle -> [TagInfo] -> IO ()
    forall a. Binary a => BinHandle -> a -> IO ()
    put_ BinHandle
    bh [TagInfo]
    flds
      put_ BinHandle
    bh TagInfo
    TagProper = BinHandle -> Word8 -> IO ()
    putByte BinHandle
    bh Word8
    3
      put_ BinHandle
    bh TagInfo
    TagTagged = BinHandle -> Word8 -> IO ()
    putByte BinHandle
    bh Word8
    4

      get :: BinHandle -> IO TagInfo
    get BinHandle
    bh = do Word8
    tag <- BinHandle -> IO Word8
    getByte BinHandle
    bh
                  case Word8
    tag of Word8
    1 -> TagInfo -> IO TagInfo
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return TagInfo
    TagDunno
                              Word8
    2 -> [TagInfo] -> TagInfo
    TagTuple ([TagInfo] -> TagInfo) -> IO [TagInfo] -> IO TagInfo
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> BinHandle -> IO [TagInfo]
    forall a. Binary a => BinHandle -> IO a
    get BinHandle
    bh
                              Word8
    3 -> TagInfo -> IO TagInfo
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return TagInfo
    TagProper
                              Word8
    4 -> TagInfo -> IO TagInfo
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return TagInfo
    TagTagged
                              Word8
    _ -> String -> IO TagInfo
    forall a. String -> a
    panic (String
    "get TagInfo " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Word8 -> String
    forall a. Show a => a -> String
    show Word8
    tag)

    newtype TagSig  -- The signature for each binding, this is a newtype as we might
                    -- want to track more information in the future.
      = TagSig TagInfo
      deriving (TagSig -> TagSig -> Bool
    (TagSig -> TagSig -> Bool)
    -> (TagSig -> TagSig -> Bool) -> Eq TagSig
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: TagSig -> TagSig -> Bool
    == :: TagSig -> TagSig -> Bool
    $c/= :: TagSig -> TagSig -> Bool
    /= :: TagSig -> TagSig -> Bool
    Eq)

    instance Outputable TagSig where
      ppr :: TagSig -> SDoc
    ppr (TagSig TagInfo
    ti) = Char -> SDoc
    char Char
    '<' SDoc -> SDoc -> SDoc
    <> TagInfo -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr TagInfo
    ti SDoc -> SDoc -> SDoc
    <> Char -> SDoc
    char Char
    '>'
    instance OutputableBndr (Id,TagSig) where
      pprInfixOcc :: (Id, TagSig) -> SDoc
    pprInfixOcc  = (Id, TagSig) -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr
      pprPrefixOcc :: (Id, TagSig) -> SDoc
    pprPrefixOcc = (Id, TagSig) -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr

    instance Binary TagSig where
      put_ :: BinHandle -> TagSig -> IO ()
    put_ BinHandle
    bh (TagSig TagInfo
    sig) = BinHandle -> TagInfo -> IO ()
    forall a. Binary a => BinHandle -> a -> IO ()
    put_ BinHandle
    bh TagInfo
    sig
      get :: BinHandle -> IO TagSig
    get BinHandle
    bh = (TagInfo -> TagSig) -> IO (TagInfo -> TagSig)
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure TagInfo -> TagSig
    TagSig IO (TagInfo -> TagSig) -> IO TagInfo -> IO TagSig
    forall a b. IO (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> BinHandle -> IO TagInfo
    forall a. Binary a => BinHandle -> IO a
    get BinHandle
    bh

    isTaggedSig :: TagSig -> Bool
    isTaggedSig :: TagSig -> Bool
    isTaggedSig (TagSig TagInfo
    TagProper) = Bool
    True
    isTaggedSig (TagSig TagInfo
    TagTagged) = Bool
    True
    isTaggedSig TagSig
    _ = Bool
    False