{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ScopedTypeVariables #-}
module GHC.Iface.Ext.Types where
import GHC.Prelude
import GHC.Settings.Config
import GHC.Utils.Binary
import GHC.Data.FastString
import GHC.Builtin.Utils
import GHC.Iface.Type
import GHC.Unit.Module ( ModuleName, Module )
import GHC.Types.Name
import GHC.Utils.Outputable hiding ( (<>) )
import GHC.Types.SrcLoc
import GHC.Types.Avail
import GHC.Types.Unique
import qualified GHC.Utils.Outputable as O ( (<>) )
import GHC.Utils.Panic
import qualified Data.Array as A
import qualified Data.Map as M
import qualified Data.Set as S
import Data.ByteString ( ByteString )
import Data.Data ( Typeable, Data )
import Data.Semigroup ( Semigroup(..) )
import Data.Word ( Word8 )
import Control.Applicative ( (<|>) )
import Data.Coerce ( coerce )
import Data.Function ( on )
import qualified Data.Semigroup as S
type Span = RealSrcSpan
hieVersion :: Integer
hieVersion :: Integer
hieVersion = String -> Integer
forall a. Read a => String -> a
read (String
cProjectVersionInt String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
cProjectPatchLevel) :: Integer
data HieFile = HieFile
{ HieFile -> String
hie_hs_file :: FilePath
, HieFile -> Module
hie_module :: Module
, HieFile -> Array Int HieTypeFlat
hie_types :: A.Array TypeIndex HieTypeFlat
, HieFile -> HieASTs Int
hie_asts :: HieASTs TypeIndex
, HieFile -> [AvailInfo]
hie_exports :: [AvailInfo]
, HieFile -> ByteString
hie_hs_src :: ByteString
}
instance Binary HieFile where
put_ :: BinHandle -> HieFile -> IO ()
put_ BinHandle
bh HieFile
hf = do
BinHandle -> String -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ HieFile -> String
hie_hs_file HieFile
hf
BinHandle -> Module -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh (Module -> IO ()) -> Module -> IO ()
forall a b. (a -> b) -> a -> b
$ HieFile -> Module
hie_module HieFile
hf
BinHandle -> Array Int HieTypeFlat -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh (Array Int HieTypeFlat -> IO ()) -> Array Int HieTypeFlat -> IO ()
forall a b. (a -> b) -> a -> b
$ HieFile -> Array Int HieTypeFlat
hie_types HieFile
hf
BinHandle -> HieASTs Int -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh (HieASTs Int -> IO ()) -> HieASTs Int -> IO ()
forall a b. (a -> b) -> a -> b
$ HieFile -> HieASTs Int
hie_asts HieFile
hf
BinHandle -> [AvailInfo] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh ([AvailInfo] -> IO ()) -> [AvailInfo] -> IO ()
forall a b. (a -> b) -> a -> b
$ HieFile -> [AvailInfo]
hie_exports HieFile
hf
BinHandle -> ByteString -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ HieFile -> ByteString
hie_hs_src HieFile
hf
get :: BinHandle -> IO HieFile
get BinHandle
bh = String
-> Module
-> Array Int HieTypeFlat
-> HieASTs Int
-> [AvailInfo]
-> ByteString
-> HieFile
HieFile
(String
-> Module
-> Array Int HieTypeFlat
-> HieASTs Int
-> [AvailInfo]
-> ByteString
-> HieFile)
-> IO String
-> IO
(Module
-> Array Int HieTypeFlat
-> HieASTs Int
-> [AvailInfo]
-> ByteString
-> HieFile)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO String
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
IO
(Module
-> Array Int HieTypeFlat
-> HieASTs Int
-> [AvailInfo]
-> ByteString
-> HieFile)
-> IO Module
-> IO
(Array Int HieTypeFlat
-> HieASTs Int -> [AvailInfo] -> ByteString -> HieFile)
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 Module
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
IO
(Array Int HieTypeFlat
-> HieASTs Int -> [AvailInfo] -> ByteString -> HieFile)
-> IO (Array Int HieTypeFlat)
-> IO (HieASTs Int -> [AvailInfo] -> ByteString -> HieFile)
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 (Array Int HieTypeFlat)
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
IO (HieASTs Int -> [AvailInfo] -> ByteString -> HieFile)
-> IO (HieASTs Int) -> IO ([AvailInfo] -> ByteString -> HieFile)
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 (HieASTs Int)
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
IO ([AvailInfo] -> ByteString -> HieFile)
-> IO [AvailInfo] -> IO (ByteString -> HieFile)
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 [AvailInfo]
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
IO (ByteString -> HieFile) -> IO ByteString -> IO HieFile
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 ByteString
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
type TypeIndex = Int
data HieType a
= HTyVarTy Name
| HAppTy a (HieArgs a)
| HTyConApp IfaceTyCon (HieArgs a)
| HForAllTy ((Name, a),ForAllTyFlag) a
| HFunTy a a a
| HQualTy a a
| HLitTy IfaceTyLit
| HCastTy a
| HCoercionTy
deriving ((forall a b. (a -> b) -> HieType a -> HieType b)
-> (forall a b. a -> HieType b -> HieType a) -> Functor HieType
forall a b. a -> HieType b -> HieType a
forall a b. (a -> b) -> HieType a -> HieType b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> HieType a -> HieType b
fmap :: forall a b. (a -> b) -> HieType a -> HieType b
$c<$ :: forall a b. a -> HieType b -> HieType a
<$ :: forall a b. a -> HieType b -> HieType a
Functor, (forall m. Monoid m => HieType m -> m)
-> (forall m a. Monoid m => (a -> m) -> HieType a -> m)
-> (forall m a. Monoid m => (a -> m) -> HieType a -> m)
-> (forall a b. (a -> b -> b) -> b -> HieType a -> b)
-> (forall a b. (a -> b -> b) -> b -> HieType a -> b)
-> (forall b a. (b -> a -> b) -> b -> HieType a -> b)
-> (forall b a. (b -> a -> b) -> b -> HieType a -> b)
-> (forall a. (a -> a -> a) -> HieType a -> a)
-> (forall a. (a -> a -> a) -> HieType a -> a)
-> (forall a. HieType a -> [a])
-> (forall a. HieType a -> Bool)
-> (forall a. HieType a -> Int)
-> (forall a. Eq a => a -> HieType a -> Bool)
-> (forall a. Ord a => HieType a -> a)
-> (forall a. Ord a => HieType a -> a)
-> (forall a. Num a => HieType a -> a)
-> (forall a. Num a => HieType a -> a)
-> Foldable HieType
forall a. Eq a => a -> HieType a -> Bool
forall a. Num a => HieType a -> a
forall a. Ord a => HieType a -> a
forall m. Monoid m => HieType m -> m
forall a. HieType a -> Bool
forall a. HieType a -> Int
forall a. HieType a -> [a]
forall a. (a -> a -> a) -> HieType a -> a
forall m a. Monoid m => (a -> m) -> HieType a -> m
forall b a. (b -> a -> b) -> b -> HieType a -> b
forall a b. (a -> b -> b) -> b -> HieType a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall m. Monoid m => HieType m -> m
fold :: forall m. Monoid m => HieType m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> HieType a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> HieType a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> HieType a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> HieType a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> HieType a -> b
foldr :: forall a b. (a -> b -> b) -> b -> HieType a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> HieType a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> HieType a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> HieType a -> b
foldl :: forall b a. (b -> a -> b) -> b -> HieType a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> HieType a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> HieType a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> HieType a -> a
foldr1 :: forall a. (a -> a -> a) -> HieType a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> HieType a -> a
foldl1 :: forall a. (a -> a -> a) -> HieType a -> a
$ctoList :: forall a. HieType a -> [a]
toList :: forall a. HieType a -> [a]
$cnull :: forall a. HieType a -> Bool
null :: forall a. HieType a -> Bool
$clength :: forall a. HieType a -> Int
length :: forall a. HieType a -> Int
$celem :: forall a. Eq a => a -> HieType a -> Bool
elem :: forall a. Eq a => a -> HieType a -> Bool
$cmaximum :: forall a. Ord a => HieType a -> a
maximum :: forall a. Ord a => HieType a -> a
$cminimum :: forall a. Ord a => HieType a -> a
minimum :: forall a. Ord a => HieType a -> a
$csum :: forall a. Num a => HieType a -> a
sum :: forall a. Num a => HieType a -> a
$cproduct :: forall a. Num a => HieType a -> a
product :: forall a. Num a => HieType a -> a
Foldable, Functor HieType
Foldable HieType
(Functor HieType, Foldable HieType) =>
(forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> HieType a -> f (HieType b))
-> (forall (f :: * -> *) a.
Applicative f =>
HieType (f a) -> f (HieType a))
-> (forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> HieType a -> m (HieType b))
-> (forall (m :: * -> *) a.
Monad m =>
HieType (m a) -> m (HieType a))
-> Traversable HieType
forall (t :: * -> *).
(Functor t, Foldable t) =>
(forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => HieType (m a) -> m (HieType a)
forall (f :: * -> *) a.
Applicative f =>
HieType (f a) -> f (HieType a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> HieType a -> m (HieType b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> HieType a -> f (HieType b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> HieType a -> f (HieType b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> HieType a -> f (HieType b)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
HieType (f a) -> f (HieType a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
HieType (f a) -> f (HieType a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> HieType a -> m (HieType b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> HieType a -> m (HieType b)
$csequence :: forall (m :: * -> *) a. Monad m => HieType (m a) -> m (HieType a)
sequence :: forall (m :: * -> *) a. Monad m => HieType (m a) -> m (HieType a)
Traversable, HieType a -> HieType a -> Bool
(HieType a -> HieType a -> Bool)
-> (HieType a -> HieType a -> Bool) -> Eq (HieType a)
forall a. Eq a => HieType a -> HieType a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => HieType a -> HieType a -> Bool
== :: HieType a -> HieType a -> Bool
$c/= :: forall a. Eq a => HieType a -> HieType a -> Bool
/= :: HieType a -> HieType a -> Bool
Eq)
type HieTypeFlat = HieType TypeIndex
newtype HieTypeFix = Roll (HieType (HieTypeFix))
deriving HieTypeFix -> HieTypeFix -> Bool
(HieTypeFix -> HieTypeFix -> Bool)
-> (HieTypeFix -> HieTypeFix -> Bool) -> Eq HieTypeFix
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: HieTypeFix -> HieTypeFix -> Bool
== :: HieTypeFix -> HieTypeFix -> Bool
$c/= :: HieTypeFix -> HieTypeFix -> Bool
/= :: HieTypeFix -> HieTypeFix -> Bool
Eq
instance Binary (HieType TypeIndex) where
put_ :: BinHandle -> HieTypeFlat -> IO ()
put_ BinHandle
bh (HTyVarTy Name
n) = do
BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
0
BinHandle -> Name -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Name
n
put_ BinHandle
bh (HAppTy Int
a HieArgs Int
b) = do
BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
1
BinHandle -> Int -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Int
a
BinHandle -> HieArgs Int -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh HieArgs Int
b
put_ BinHandle
bh (HTyConApp IfaceTyCon
n HieArgs Int
xs) = do
BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
2
BinHandle -> IfaceTyCon -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceTyCon
n
BinHandle -> HieArgs Int -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh HieArgs Int
xs
put_ BinHandle
bh (HForAllTy ((Name, Int), ForAllTyFlag)
bndr Int
a) = do
BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
3
BinHandle -> ((Name, Int), ForAllTyFlag) -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh ((Name, Int), ForAllTyFlag)
bndr
BinHandle -> Int -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Int
a
put_ BinHandle
bh (HFunTy Int
w Int
a Int
b) = do
BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
4
BinHandle -> Int -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Int
w
BinHandle -> Int -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Int
a
BinHandle -> Int -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Int
b
put_ BinHandle
bh (HQualTy Int
a Int
b) = do
BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
5
BinHandle -> Int -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Int
a
BinHandle -> Int -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Int
b
put_ BinHandle
bh (HLitTy IfaceTyLit
l) = do
BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
6
BinHandle -> IfaceTyLit -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceTyLit
l
put_ BinHandle
bh (HCastTy Int
a) = do
BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
7
BinHandle -> Int -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Int
a
put_ BinHandle
bh (HieTypeFlat
HCoercionTy) = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
8
get :: BinHandle -> IO HieTypeFlat
get BinHandle
bh = do
(Word8
t :: Word8) <- BinHandle -> IO Word8
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
case Word8
t of
Word8
0 -> Name -> HieTypeFlat
forall a. Name -> HieType a
HTyVarTy (Name -> HieTypeFlat) -> IO Name -> IO HieTypeFlat
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO Name
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
Word8
1 -> Int -> HieArgs Int -> HieTypeFlat
forall a. a -> HieArgs a -> HieType a
HAppTy (Int -> HieArgs Int -> HieTypeFlat)
-> IO Int -> IO (HieArgs Int -> HieTypeFlat)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO Int
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh IO (HieArgs Int -> HieTypeFlat)
-> IO (HieArgs Int) -> IO HieTypeFlat
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 (HieArgs Int)
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
Word8
2 -> IfaceTyCon -> HieArgs Int -> HieTypeFlat
forall a. IfaceTyCon -> HieArgs a -> HieType a
HTyConApp (IfaceTyCon -> HieArgs Int -> HieTypeFlat)
-> IO IfaceTyCon -> IO (HieArgs Int -> HieTypeFlat)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO IfaceTyCon
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh IO (HieArgs Int -> HieTypeFlat)
-> IO (HieArgs Int) -> IO HieTypeFlat
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 (HieArgs Int)
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
Word8
3 -> ((Name, Int), ForAllTyFlag) -> Int -> HieTypeFlat
forall a. ((Name, a), ForAllTyFlag) -> a -> HieType a
HForAllTy (((Name, Int), ForAllTyFlag) -> Int -> HieTypeFlat)
-> IO ((Name, Int), ForAllTyFlag) -> IO (Int -> HieTypeFlat)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO ((Name, Int), ForAllTyFlag)
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh IO (Int -> HieTypeFlat) -> IO Int -> IO HieTypeFlat
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 Int
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
Word8
4 -> Int -> Int -> Int -> HieTypeFlat
forall a. a -> a -> a -> HieType a
HFunTy (Int -> Int -> Int -> HieTypeFlat)
-> IO Int -> IO (Int -> Int -> HieTypeFlat)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO Int
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh IO (Int -> Int -> HieTypeFlat) -> IO Int -> IO (Int -> HieTypeFlat)
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 Int
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh IO (Int -> HieTypeFlat) -> IO Int -> IO HieTypeFlat
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 Int
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
Word8
5 -> Int -> Int -> HieTypeFlat
forall a. a -> a -> HieType a
HQualTy (Int -> Int -> HieTypeFlat) -> IO Int -> IO (Int -> HieTypeFlat)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO Int
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh IO (Int -> HieTypeFlat) -> IO Int -> IO HieTypeFlat
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 Int
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
Word8
6 -> IfaceTyLit -> HieTypeFlat
forall a. IfaceTyLit -> HieType a
HLitTy (IfaceTyLit -> HieTypeFlat) -> IO IfaceTyLit -> IO HieTypeFlat
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO IfaceTyLit
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
Word8
7 -> Int -> HieTypeFlat
forall a. a -> HieType a
HCastTy (Int -> HieTypeFlat) -> IO Int -> IO HieTypeFlat
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO Int
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
Word8
8 -> HieTypeFlat -> IO HieTypeFlat
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return HieTypeFlat
forall a. HieType a
HCoercionTy
Word8
_ -> String -> IO HieTypeFlat
forall a. HasCallStack => String -> a
panic String
"Binary (HieArgs Int): invalid tag"
newtype HieArgs a = HieArgs [(Bool,a)]
deriving ((forall a b. (a -> b) -> HieArgs a -> HieArgs b)
-> (forall a b. a -> HieArgs b -> HieArgs a) -> Functor HieArgs
forall a b. a -> HieArgs b -> HieArgs a
forall a b. (a -> b) -> HieArgs a -> HieArgs b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> HieArgs a -> HieArgs b
fmap :: forall a b. (a -> b) -> HieArgs a -> HieArgs b
$c<$ :: forall a b. a -> HieArgs b -> HieArgs a
<$ :: forall a b. a -> HieArgs b -> HieArgs a
Functor, (forall m. Monoid m => HieArgs m -> m)
-> (forall m a. Monoid m => (a -> m) -> HieArgs a -> m)
-> (forall m a. Monoid m => (a -> m) -> HieArgs a -> m)
-> (forall a b. (a -> b -> b) -> b -> HieArgs a -> b)
-> (forall a b. (a -> b -> b) -> b -> HieArgs a -> b)
-> (forall b a. (b -> a -> b) -> b -> HieArgs a -> b)
-> (forall b a. (b -> a -> b) -> b -> HieArgs a -> b)
-> (forall a. (a -> a -> a) -> HieArgs a -> a)
-> (forall a. (a -> a -> a) -> HieArgs a -> a)
-> (forall a. HieArgs a -> [a])
-> (forall a. HieArgs a -> Bool)
-> (forall a. HieArgs a -> Int)
-> (forall a. Eq a => a -> HieArgs a -> Bool)
-> (forall a. Ord a => HieArgs a -> a)
-> (forall a. Ord a => HieArgs a -> a)
-> (forall a. Num a => HieArgs a -> a)
-> (forall a. Num a => HieArgs a -> a)
-> Foldable HieArgs
forall a. Eq a => a -> HieArgs a -> Bool
forall a. Num a => HieArgs a -> a
forall a. Ord a => HieArgs a -> a
forall m. Monoid m => HieArgs m -> m
forall a. HieArgs a -> Bool
forall a. HieArgs a -> Int
forall a. HieArgs a -> [a]
forall a. (a -> a -> a) -> HieArgs a -> a
forall m a. Monoid m => (a -> m) -> HieArgs a -> m
forall b a. (b -> a -> b) -> b -> HieArgs a -> b
forall a b. (a -> b -> b) -> b -> HieArgs a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall m. Monoid m => HieArgs m -> m
fold :: forall m. Monoid m => HieArgs m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> HieArgs a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> HieArgs a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> HieArgs a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> HieArgs a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> HieArgs a -> b
foldr :: forall a b. (a -> b -> b) -> b -> HieArgs a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> HieArgs a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> HieArgs a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> HieArgs a -> b
foldl :: forall b a. (b -> a -> b) -> b -> HieArgs a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> HieArgs a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> HieArgs a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> HieArgs a -> a
foldr1 :: forall a. (a -> a -> a) -> HieArgs a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> HieArgs a -> a
foldl1 :: forall a. (a -> a -> a) -> HieArgs a -> a
$ctoList :: forall a. HieArgs a -> [a]
toList :: forall a. HieArgs a -> [a]
$cnull :: forall a. HieArgs a -> Bool
null :: forall a. HieArgs a -> Bool
$clength :: forall a. HieArgs a -> Int
length :: forall a. HieArgs a -> Int
$celem :: forall a. Eq a => a -> HieArgs a -> Bool
elem :: forall a. Eq a => a -> HieArgs a -> Bool
$cmaximum :: forall a. Ord a => HieArgs a -> a
maximum :: forall a. Ord a => HieArgs a -> a
$cminimum :: forall a. Ord a => HieArgs a -> a
minimum :: forall a. Ord a => HieArgs a -> a
$csum :: forall a. Num a => HieArgs a -> a
sum :: forall a. Num a => HieArgs a -> a
$cproduct :: forall a. Num a => HieArgs a -> a
product :: forall a. Num a => HieArgs a -> a
Foldable, Functor HieArgs
Foldable HieArgs
(Functor HieArgs, Foldable HieArgs) =>
(forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> HieArgs a -> f (HieArgs b))
-> (forall (f :: * -> *) a.
Applicative f =>
HieArgs (f a) -> f (HieArgs a))
-> (forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> HieArgs a -> m (HieArgs b))
-> (forall (m :: * -> *) a.
Monad m =>
HieArgs (m a) -> m (HieArgs a))
-> Traversable HieArgs
forall (t :: * -> *).
(Functor t, Foldable t) =>
(forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => HieArgs (m a) -> m (HieArgs a)
forall (f :: * -> *) a.
Applicative f =>
HieArgs (f a) -> f (HieArgs a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> HieArgs a -> m (HieArgs b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> HieArgs a -> f (HieArgs b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> HieArgs a -> f (HieArgs b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> HieArgs a -> f (HieArgs b)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
HieArgs (f a) -> f (HieArgs a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
HieArgs (f a) -> f (HieArgs a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> HieArgs a -> m (HieArgs b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> HieArgs a -> m (HieArgs b)
$csequence :: forall (m :: * -> *) a. Monad m => HieArgs (m a) -> m (HieArgs a)
sequence :: forall (m :: * -> *) a. Monad m => HieArgs (m a) -> m (HieArgs a)
Traversable, HieArgs a -> HieArgs a -> Bool
(HieArgs a -> HieArgs a -> Bool)
-> (HieArgs a -> HieArgs a -> Bool) -> Eq (HieArgs a)
forall a. Eq a => HieArgs a -> HieArgs a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => HieArgs a -> HieArgs a -> Bool
== :: HieArgs a -> HieArgs a -> Bool
$c/= :: forall a. Eq a => HieArgs a -> HieArgs a -> Bool
/= :: HieArgs a -> HieArgs a -> Bool
Eq)
instance Binary (HieArgs TypeIndex) where
put_ :: BinHandle -> HieArgs Int -> IO ()
put_ BinHandle
bh (HieArgs [(Bool, Int)]
xs) = BinHandle -> [(Bool, Int)] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [(Bool, Int)]
xs
get :: BinHandle -> IO (HieArgs Int)
get BinHandle
bh = [(Bool, Int)] -> HieArgs Int
forall a. [(Bool, a)] -> HieArgs a
HieArgs ([(Bool, Int)] -> HieArgs Int)
-> IO [(Bool, Int)] -> IO (HieArgs Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO [(Bool, Int)]
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
type HiePath = LexicalFastString
{-# COMPLETE HiePath #-}
pattern HiePath :: FastString -> HiePath
pattern $mHiePath :: forall {r}. HiePath -> (FastString -> r) -> ((# #) -> r) -> r
$bHiePath :: FastString -> HiePath
HiePath fs = LexicalFastString fs
newtype HieASTs a = HieASTs { forall a. HieASTs a -> Map HiePath (HieAST a)
getAsts :: M.Map HiePath (HieAST a) }
deriving ((forall a b. (a -> b) -> HieASTs a -> HieASTs b)
-> (forall a b. a -> HieASTs b -> HieASTs a) -> Functor HieASTs
forall a b. a -> HieASTs b -> HieASTs a
forall a b. (a -> b) -> HieASTs a -> HieASTs b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> HieASTs a -> HieASTs b
fmap :: forall a b. (a -> b) -> HieASTs a -> HieASTs b
$c<$ :: forall a b. a -> HieASTs b -> HieASTs a
<$ :: forall a b. a -> HieASTs b -> HieASTs a
Functor, (forall m. Monoid m => HieASTs m -> m)
-> (forall m a. Monoid m => (a -> m) -> HieASTs a -> m)
-> (forall m a. Monoid m => (a -> m) -> HieASTs a -> m)
-> (forall a b. (a -> b -> b) -> b -> HieASTs a -> b)
-> (forall a b. (a -> b -> b) -> b -> HieASTs a -> b)
-> (forall b a. (b -> a -> b) -> b -> HieASTs a -> b)
-> (forall b a. (b -> a -> b) -> b -> HieASTs a -> b)
-> (forall a. (a -> a -> a) -> HieASTs a -> a)
-> (forall a. (a -> a -> a) -> HieASTs a -> a)
-> (forall a. HieASTs a -> [a])
-> (forall a. HieASTs a -> Bool)
-> (forall a. HieASTs a -> Int)
-> (forall a. Eq a => a -> HieASTs a -> Bool)
-> (forall a. Ord a => HieASTs a -> a)
-> (forall a. Ord a => HieASTs a -> a)
-> (forall a. Num a => HieASTs a -> a)
-> (forall a. Num a => HieASTs a -> a)
-> Foldable HieASTs
forall a. Eq a => a -> HieASTs a -> Bool
forall a. Num a => HieASTs a -> a
forall a. Ord a => HieASTs a -> a
forall m. Monoid m => HieASTs m -> m
forall a. HieASTs a -> Bool
forall a. HieASTs a -> Int
forall a. HieASTs a -> [a]
forall a. (a -> a -> a) -> HieASTs a -> a
forall m a. Monoid m => (a -> m) -> HieASTs a -> m
forall b a. (b -> a -> b) -> b -> HieASTs a -> b
forall a b. (a -> b -> b) -> b -> HieASTs a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall m. Monoid m => HieASTs m -> m
fold :: forall m. Monoid m => HieASTs m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> HieASTs a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> HieASTs a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> HieASTs a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> HieASTs a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> HieASTs a -> b
foldr :: forall a b. (a -> b -> b) -> b -> HieASTs a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> HieASTs a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> HieASTs a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> HieASTs a -> b
foldl :: forall b a. (b -> a -> b) -> b -> HieASTs a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> HieASTs a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> HieASTs a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> HieASTs a -> a
foldr1 :: forall a. (a -> a -> a) -> HieASTs a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> HieASTs a -> a
foldl1 :: forall a. (a -> a -> a) -> HieASTs a -> a
$ctoList :: forall a. HieASTs a -> [a]
toList :: forall a. HieASTs a -> [a]
$cnull :: forall a. HieASTs a -> Bool
null :: forall a. HieASTs a -> Bool
$clength :: forall a. HieASTs a -> Int
length :: forall a. HieASTs a -> Int
$celem :: forall a. Eq a => a -> HieASTs a -> Bool
elem :: forall a. Eq a => a -> HieASTs a -> Bool
$cmaximum :: forall a. Ord a => HieASTs a -> a
maximum :: forall a. Ord a => HieASTs a -> a
$cminimum :: forall a. Ord a => HieASTs a -> a
minimum :: forall a. Ord a => HieASTs a -> a
$csum :: forall a. Num a => HieASTs a -> a
sum :: forall a. Num a => HieASTs a -> a
$cproduct :: forall a. Num a => HieASTs a -> a
product :: forall a. Num a => HieASTs a -> a
Foldable, Functor HieASTs
Foldable HieASTs
(Functor HieASTs, Foldable HieASTs) =>
(forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> HieASTs a -> f (HieASTs b))
-> (forall (f :: * -> *) a.
Applicative f =>
HieASTs (f a) -> f (HieASTs a))
-> (forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> HieASTs a -> m (HieASTs b))
-> (forall (m :: * -> *) a.
Monad m =>
HieASTs (m a) -> m (HieASTs a))
-> Traversable HieASTs
forall (t :: * -> *).
(Functor t, Foldable t) =>
(forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => HieASTs (m a) -> m (HieASTs a)
forall (f :: * -> *) a.
Applicative f =>
HieASTs (f a) -> f (HieASTs a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> HieASTs a -> m (HieASTs b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> HieASTs a -> f (HieASTs b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> HieASTs a -> f (HieASTs b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> HieASTs a -> f (HieASTs b)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
HieASTs (f a) -> f (HieASTs a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
HieASTs (f a) -> f (HieASTs a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> HieASTs a -> m (HieASTs b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> HieASTs a -> m (HieASTs b)
$csequence :: forall (m :: * -> *) a. Monad m => HieASTs (m a) -> m (HieASTs a)
sequence :: forall (m :: * -> *) a. Monad m => HieASTs (m a) -> m (HieASTs a)
Traversable)
instance Binary (HieASTs TypeIndex) where
put_ :: BinHandle -> HieASTs Int -> IO ()
put_ BinHandle
bh HieASTs Int
asts = BinHandle -> [(HiePath, HieAST Int)] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh ([(HiePath, HieAST Int)] -> IO ())
-> [(HiePath, HieAST Int)] -> IO ()
forall a b. (a -> b) -> a -> b
$ Map HiePath (HieAST Int) -> [(HiePath, HieAST Int)]
forall k a. Map k a -> [(k, a)]
M.toAscList (Map HiePath (HieAST Int) -> [(HiePath, HieAST Int)])
-> Map HiePath (HieAST Int) -> [(HiePath, HieAST Int)]
forall a b. (a -> b) -> a -> b
$ HieASTs Int -> Map HiePath (HieAST Int)
forall a. HieASTs a -> Map HiePath (HieAST a)
getAsts HieASTs Int
asts
get :: BinHandle -> IO (HieASTs Int)
get BinHandle
bh = Map HiePath (HieAST Int) -> HieASTs Int
forall a. Map HiePath (HieAST a) -> HieASTs a
HieASTs (Map HiePath (HieAST Int) -> HieASTs Int)
-> IO (Map HiePath (HieAST Int)) -> IO (HieASTs Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([(HiePath, HieAST Int)] -> Map HiePath (HieAST Int))
-> IO [(HiePath, HieAST Int)] -> IO (Map HiePath (HieAST Int))
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(HiePath, HieAST Int)] -> Map HiePath (HieAST Int)
forall k a. [(k, a)] -> Map k a
M.fromDistinctAscList (BinHandle -> IO [(HiePath, HieAST Int)]
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh)
instance Outputable a => Outputable (HieASTs a) where
ppr :: HieASTs a -> SDoc
ppr (HieASTs Map HiePath (HieAST a)
asts) = (HiePath -> HieAST a -> SDoc -> SDoc)
-> SDoc -> Map HiePath (HieAST a) -> SDoc
forall k a b. (k -> a -> b -> b) -> b -> Map k a -> b
M.foldrWithKey HiePath -> HieAST a -> SDoc -> SDoc
forall {a} {a}.
(Outputable a, Outputable a) =>
a -> a -> SDoc -> SDoc
go SDoc
"" Map HiePath (HieAST a)
asts
where
go :: a -> a -> SDoc -> SDoc
go a
k a
a SDoc
rest = [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat ([SDoc] -> SDoc) -> [SDoc] -> SDoc
forall a b. (a -> b) -> a -> b
$
[ SDoc
"File: " SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
O.<> a -> SDoc
forall a. Outputable a => a -> SDoc
ppr a
k
, a -> SDoc
forall a. Outputable a => a -> SDoc
ppr a
a
, SDoc
rest
]
data HieAST a =
Node
{ forall a. HieAST a -> SourcedNodeInfo a
sourcedNodeInfo :: SourcedNodeInfo a
, forall a. HieAST a -> Span
nodeSpan :: Span
, forall a. HieAST a -> [HieAST a]
nodeChildren :: [HieAST a]
} deriving ((forall a b. (a -> b) -> HieAST a -> HieAST b)
-> (forall a b. a -> HieAST b -> HieAST a) -> Functor HieAST
forall a b. a -> HieAST b -> HieAST a
forall a b. (a -> b) -> HieAST a -> HieAST b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> HieAST a -> HieAST b
fmap :: forall a b. (a -> b) -> HieAST a -> HieAST b
$c<$ :: forall a b. a -> HieAST b -> HieAST a
<$ :: forall a b. a -> HieAST b -> HieAST a
Functor, (forall m. Monoid m => HieAST m -> m)
-> (forall m a. Monoid m => (a -> m) -> HieAST a -> m)
-> (forall m a. Monoid m => (a -> m) -> HieAST a -> m)
-> (forall a b. (a -> b -> b) -> b -> HieAST a -> b)
-> (forall a b. (a -> b -> b) -> b -> HieAST a -> b)
-> (forall b a. (b -> a -> b) -> b -> HieAST a -> b)
-> (forall b a. (b -> a -> b) -> b -> HieAST a -> b)
-> (forall a. (a -> a -> a) -> HieAST a -> a)
-> (forall a. (a -> a -> a) -> HieAST a -> a)
-> (forall a. HieAST a -> [a])
-> (forall a. HieAST a -> Bool)
-> (forall a. HieAST a -> Int)
-> (forall a. Eq a => a -> HieAST a -> Bool)
-> (forall a. Ord a => HieAST a -> a)
-> (forall a. Ord a => HieAST a -> a)
-> (forall a. Num a => HieAST a -> a)
-> (forall a. Num a => HieAST a -> a)
-> Foldable HieAST
forall a. Eq a => a -> HieAST a -> Bool
forall a. Num a => HieAST a -> a
forall a. Ord a => HieAST a -> a
forall m. Monoid m => HieAST m -> m
forall a. HieAST a -> Bool
forall a. HieAST a -> Int
forall a. HieAST a -> [a]
forall a. (a -> a -> a) -> HieAST a -> a
forall m a. Monoid m => (a -> m) -> HieAST a -> m
forall b a. (b -> a -> b) -> b -> HieAST a -> b
forall a b. (a -> b -> b) -> b -> HieAST a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall m. Monoid m => HieAST m -> m
fold :: forall m. Monoid m => HieAST m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> HieAST a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> HieAST a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> HieAST a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> HieAST a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> HieAST a -> b
foldr :: forall a b. (a -> b -> b) -> b -> HieAST a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> HieAST a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> HieAST a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> HieAST a -> b
foldl :: forall b a. (b -> a -> b) -> b -> HieAST a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> HieAST a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> HieAST a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> HieAST a -> a
foldr1 :: forall a. (a -> a -> a) -> HieAST a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> HieAST a -> a
foldl1 :: forall a. (a -> a -> a) -> HieAST a -> a
$ctoList :: forall a. HieAST a -> [a]
toList :: forall a. HieAST a -> [a]
$cnull :: forall a. HieAST a -> Bool
null :: forall a. HieAST a -> Bool
$clength :: forall a. HieAST a -> Int
length :: forall a. HieAST a -> Int
$celem :: forall a. Eq a => a -> HieAST a -> Bool
elem :: forall a. Eq a => a -> HieAST a -> Bool
$cmaximum :: forall a. Ord a => HieAST a -> a
maximum :: forall a. Ord a => HieAST a -> a
$cminimum :: forall a. Ord a => HieAST a -> a
minimum :: forall a. Ord a => HieAST a -> a
$csum :: forall a. Num a => HieAST a -> a
sum :: forall a. Num a => HieAST a -> a
$cproduct :: forall a. Num a => HieAST a -> a
product :: forall a. Num a => HieAST a -> a
Foldable, Functor HieAST
Foldable HieAST
(Functor HieAST, Foldable HieAST) =>
(forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> HieAST a -> f (HieAST b))
-> (forall (f :: * -> *) a.
Applicative f =>
HieAST (f a) -> f (HieAST a))
-> (forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> HieAST a -> m (HieAST b))
-> (forall (m :: * -> *) a.
Monad m =>
HieAST (m a) -> m (HieAST a))
-> Traversable HieAST
forall (t :: * -> *).
(Functor t, Foldable t) =>
(forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => HieAST (m a) -> m (HieAST a)
forall (f :: * -> *) a.
Applicative f =>
HieAST (f a) -> f (HieAST a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> HieAST a -> m (HieAST b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> HieAST a -> f (HieAST b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> HieAST a -> f (HieAST b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> HieAST a -> f (HieAST b)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
HieAST (f a) -> f (HieAST a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
HieAST (f a) -> f (HieAST a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> HieAST a -> m (HieAST b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> HieAST a -> m (HieAST b)
$csequence :: forall (m :: * -> *) a. Monad m => HieAST (m a) -> m (HieAST a)
sequence :: forall (m :: * -> *) a. Monad m => HieAST (m a) -> m (HieAST a)
Traversable)
instance Binary (HieAST TypeIndex) where
put_ :: BinHandle -> HieAST Int -> IO ()
put_ BinHandle
bh HieAST Int
ast = do
BinHandle -> SourcedNodeInfo Int -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh (SourcedNodeInfo Int -> IO ()) -> SourcedNodeInfo Int -> IO ()
forall a b. (a -> b) -> a -> b
$ HieAST Int -> SourcedNodeInfo Int
forall a. HieAST a -> SourcedNodeInfo a
sourcedNodeInfo HieAST Int
ast
BinHandle -> BinSpan -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh (BinSpan -> IO ()) -> BinSpan -> IO ()
forall a b. (a -> b) -> a -> b
$ Span -> BinSpan
BinSpan (Span -> BinSpan) -> Span -> BinSpan
forall a b. (a -> b) -> a -> b
$ HieAST Int -> Span
forall a. HieAST a -> Span
nodeSpan HieAST Int
ast
BinHandle -> [HieAST Int] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh ([HieAST Int] -> IO ()) -> [HieAST Int] -> IO ()
forall a b. (a -> b) -> a -> b
$ HieAST Int -> [HieAST Int]
forall a. HieAST a -> [HieAST a]
nodeChildren HieAST Int
ast
get :: BinHandle -> IO (HieAST Int)
get BinHandle
bh = SourcedNodeInfo Int -> Span -> [HieAST Int] -> HieAST Int
forall a. SourcedNodeInfo a -> Span -> [HieAST a] -> HieAST a
Node
(SourcedNodeInfo Int -> Span -> [HieAST Int] -> HieAST Int)
-> IO (SourcedNodeInfo Int)
-> IO (Span -> [HieAST Int] -> HieAST Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO (SourcedNodeInfo Int)
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
IO (Span -> [HieAST Int] -> HieAST Int)
-> IO Span -> IO ([HieAST Int] -> HieAST Int)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (BinSpan -> Span
unBinSpan (BinSpan -> Span) -> IO BinSpan -> IO Span
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO BinSpan
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh)
IO ([HieAST Int] -> HieAST Int)
-> IO [HieAST Int] -> IO (HieAST Int)
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 [HieAST Int]
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
instance Outputable a => Outputable (HieAST a) where
ppr :: HieAST a -> SDoc
ppr (Node SourcedNodeInfo a
ni Span
sp [HieAST a]
ch) = SDoc -> Int -> SDoc -> SDoc
hang SDoc
header Int
2 SDoc
rest
where
header :: SDoc
header = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Node@" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
O.<> Span -> SDoc
forall a. Outputable a => a -> SDoc
ppr Span
sp SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
O.<> SDoc
":" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SourcedNodeInfo a -> SDoc
forall a. Outputable a => a -> SDoc
ppr SourcedNodeInfo a
ni
rest :: SDoc
rest = [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat ((HieAST a -> SDoc) -> [HieAST a] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map HieAST a -> SDoc
forall a. Outputable a => a -> SDoc
ppr [HieAST a]
ch)
newtype SourcedNodeInfo a = SourcedNodeInfo { forall a. SourcedNodeInfo a -> Map NodeOrigin (NodeInfo a)
getSourcedNodeInfo :: (M.Map NodeOrigin (NodeInfo a)) }
deriving ((forall a b. (a -> b) -> SourcedNodeInfo a -> SourcedNodeInfo b)
-> (forall a b. a -> SourcedNodeInfo b -> SourcedNodeInfo a)
-> Functor SourcedNodeInfo
forall a b. a -> SourcedNodeInfo b -> SourcedNodeInfo a
forall a b. (a -> b) -> SourcedNodeInfo a -> SourcedNodeInfo b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> SourcedNodeInfo a -> SourcedNodeInfo b
fmap :: forall a b. (a -> b) -> SourcedNodeInfo a -> SourcedNodeInfo b
$c<$ :: forall a b. a -> SourcedNodeInfo b -> SourcedNodeInfo a
<$ :: forall a b. a -> SourcedNodeInfo b -> SourcedNodeInfo a
Functor, (forall m. Monoid m => SourcedNodeInfo m -> m)
-> (forall m a. Monoid m => (a -> m) -> SourcedNodeInfo a -> m)
-> (forall m a. Monoid m => (a -> m) -> SourcedNodeInfo a -> m)
-> (forall a b. (a -> b -> b) -> b -> SourcedNodeInfo a -> b)
-> (forall a b. (a -> b -> b) -> b -> SourcedNodeInfo a -> b)
-> (forall b a. (b -> a -> b) -> b -> SourcedNodeInfo a -> b)
-> (forall b a. (b -> a -> b) -> b -> SourcedNodeInfo a -> b)
-> (forall a. (a -> a -> a) -> SourcedNodeInfo a -> a)
-> (forall a. (a -> a -> a) -> SourcedNodeInfo a -> a)
-> (forall a. SourcedNodeInfo a -> [a])
-> (forall a. SourcedNodeInfo a -> Bool)
-> (forall a. SourcedNodeInfo a -> Int)
-> (forall a. Eq a => a -> SourcedNodeInfo a -> Bool)
-> (forall a. Ord a => SourcedNodeInfo a -> a)
-> (forall a. Ord a => SourcedNodeInfo a -> a)
-> (forall a. Num a => SourcedNodeInfo a -> a)
-> (forall a. Num a => SourcedNodeInfo a -> a)
-> Foldable SourcedNodeInfo
forall a. Eq a => a -> SourcedNodeInfo a -> Bool
forall a. Num a => SourcedNodeInfo a -> a
forall a. Ord a => SourcedNodeInfo a -> a
forall m. Monoid m => SourcedNodeInfo m -> m
forall a. SourcedNodeInfo a -> Bool
forall a. SourcedNodeInfo a -> Int
forall a. SourcedNodeInfo a -> [a]
forall a. (a -> a -> a) -> SourcedNodeInfo a -> a
forall m a. Monoid m => (a -> m) -> SourcedNodeInfo a -> m
forall b a. (b -> a -> b) -> b -> SourcedNodeInfo a -> b
forall a b. (a -> b -> b) -> b -> SourcedNodeInfo a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall m. Monoid m => SourcedNodeInfo m -> m
fold :: forall m. Monoid m => SourcedNodeInfo m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> SourcedNodeInfo a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> SourcedNodeInfo a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> SourcedNodeInfo a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> SourcedNodeInfo a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> SourcedNodeInfo a -> b
foldr :: forall a b. (a -> b -> b) -> b -> SourcedNodeInfo a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> SourcedNodeInfo a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> SourcedNodeInfo a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> SourcedNodeInfo a -> b
foldl :: forall b a. (b -> a -> b) -> b -> SourcedNodeInfo a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> SourcedNodeInfo a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> SourcedNodeInfo a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> SourcedNodeInfo a -> a
foldr1 :: forall a. (a -> a -> a) -> SourcedNodeInfo a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> SourcedNodeInfo a -> a
foldl1 :: forall a. (a -> a -> a) -> SourcedNodeInfo a -> a
$ctoList :: forall a. SourcedNodeInfo a -> [a]
toList :: forall a. SourcedNodeInfo a -> [a]
$cnull :: forall a. SourcedNodeInfo a -> Bool
null :: forall a. SourcedNodeInfo a -> Bool
$clength :: forall a. SourcedNodeInfo a -> Int
length :: forall a. SourcedNodeInfo a -> Int
$celem :: forall a. Eq a => a -> SourcedNodeInfo a -> Bool
elem :: forall a. Eq a => a -> SourcedNodeInfo a -> Bool
$cmaximum :: forall a. Ord a => SourcedNodeInfo a -> a
maximum :: forall a. Ord a => SourcedNodeInfo a -> a
$cminimum :: forall a. Ord a => SourcedNodeInfo a -> a
minimum :: forall a. Ord a => SourcedNodeInfo a -> a
$csum :: forall a. Num a => SourcedNodeInfo a -> a
sum :: forall a. Num a => SourcedNodeInfo a -> a
$cproduct :: forall a. Num a => SourcedNodeInfo a -> a
product :: forall a. Num a => SourcedNodeInfo a -> a
Foldable, Functor SourcedNodeInfo
Foldable SourcedNodeInfo
(Functor SourcedNodeInfo, Foldable SourcedNodeInfo) =>
(forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> SourcedNodeInfo a -> f (SourcedNodeInfo b))
-> (forall (f :: * -> *) a.
Applicative f =>
SourcedNodeInfo (f a) -> f (SourcedNodeInfo a))
-> (forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> SourcedNodeInfo a -> m (SourcedNodeInfo b))
-> (forall (m :: * -> *) a.
Monad m =>
SourcedNodeInfo (m a) -> m (SourcedNodeInfo a))
-> Traversable SourcedNodeInfo
forall (t :: * -> *).
(Functor t, Foldable t) =>
(forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
SourcedNodeInfo (m a) -> m (SourcedNodeInfo a)
forall (f :: * -> *) a.
Applicative f =>
SourcedNodeInfo (f a) -> f (SourcedNodeInfo a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> SourcedNodeInfo a -> m (SourcedNodeInfo b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> SourcedNodeInfo a -> f (SourcedNodeInfo b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> SourcedNodeInfo a -> f (SourcedNodeInfo b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> SourcedNodeInfo a -> f (SourcedNodeInfo b)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
SourcedNodeInfo (f a) -> f (SourcedNodeInfo a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
SourcedNodeInfo (f a) -> f (SourcedNodeInfo a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> SourcedNodeInfo a -> m (SourcedNodeInfo b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> SourcedNodeInfo a -> m (SourcedNodeInfo b)
$csequence :: forall (m :: * -> *) a.
Monad m =>
SourcedNodeInfo (m a) -> m (SourcedNodeInfo a)
sequence :: forall (m :: * -> *) a.
Monad m =>
SourcedNodeInfo (m a) -> m (SourcedNodeInfo a)
Traversable)
instance Binary (SourcedNodeInfo TypeIndex) where
put_ :: BinHandle -> SourcedNodeInfo Int -> IO ()
put_ BinHandle
bh SourcedNodeInfo Int
asts = BinHandle -> [(NodeOrigin, NodeInfo Int)] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh ([(NodeOrigin, NodeInfo Int)] -> IO ())
-> [(NodeOrigin, NodeInfo Int)] -> IO ()
forall a b. (a -> b) -> a -> b
$ Map NodeOrigin (NodeInfo Int) -> [(NodeOrigin, NodeInfo Int)]
forall k a. Map k a -> [(k, a)]
M.toAscList (Map NodeOrigin (NodeInfo Int) -> [(NodeOrigin, NodeInfo Int)])
-> Map NodeOrigin (NodeInfo Int) -> [(NodeOrigin, NodeInfo Int)]
forall a b. (a -> b) -> a -> b
$ SourcedNodeInfo Int -> Map NodeOrigin (NodeInfo Int)
forall a. SourcedNodeInfo a -> Map NodeOrigin (NodeInfo a)
getSourcedNodeInfo SourcedNodeInfo Int
asts
get :: BinHandle -> IO (SourcedNodeInfo Int)
get BinHandle
bh = Map NodeOrigin (NodeInfo Int) -> SourcedNodeInfo Int
forall a. Map NodeOrigin (NodeInfo a) -> SourcedNodeInfo a
SourcedNodeInfo (Map NodeOrigin (NodeInfo Int) -> SourcedNodeInfo Int)
-> IO (Map NodeOrigin (NodeInfo Int)) -> IO (SourcedNodeInfo Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([(NodeOrigin, NodeInfo Int)] -> Map NodeOrigin (NodeInfo Int))
-> IO [(NodeOrigin, NodeInfo Int)]
-> IO (Map NodeOrigin (NodeInfo Int))
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(NodeOrigin, NodeInfo Int)] -> Map NodeOrigin (NodeInfo Int)
forall k a. [(k, a)] -> Map k a
M.fromDistinctAscList (BinHandle -> IO [(NodeOrigin, NodeInfo Int)]
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh)
instance Outputable a => Outputable (SourcedNodeInfo a) where
ppr :: SourcedNodeInfo a -> SDoc
ppr (SourcedNodeInfo Map NodeOrigin (NodeInfo a)
asts) = (NodeOrigin -> NodeInfo a -> SDoc -> SDoc)
-> SDoc -> Map NodeOrigin (NodeInfo a) -> SDoc
forall k a b. (k -> a -> b -> b) -> b -> Map k a -> b
M.foldrWithKey NodeOrigin -> NodeInfo a -> SDoc -> SDoc
forall {a} {a}.
(Outputable a, Outputable a) =>
a -> a -> SDoc -> SDoc
go SDoc
"" Map NodeOrigin (NodeInfo a)
asts
where
go :: a -> a -> SDoc -> SDoc
go a
k a
a SDoc
rest = [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat ([SDoc] -> SDoc) -> [SDoc] -> SDoc
forall a b. (a -> b) -> a -> b
$
[ SDoc
"Source: " SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
O.<> a -> SDoc
forall a. Outputable a => a -> SDoc
ppr a
k
, a -> SDoc
forall a. Outputable a => a -> SDoc
ppr a
a
, SDoc
rest
]
data NodeOrigin
= SourceInfo
| GeneratedInfo
deriving (NodeOrigin -> NodeOrigin -> Bool
(NodeOrigin -> NodeOrigin -> Bool)
-> (NodeOrigin -> NodeOrigin -> Bool) -> Eq NodeOrigin
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NodeOrigin -> NodeOrigin -> Bool
== :: NodeOrigin -> NodeOrigin -> Bool
$c/= :: NodeOrigin -> NodeOrigin -> Bool
/= :: NodeOrigin -> NodeOrigin -> Bool
Eq, Int -> NodeOrigin
NodeOrigin -> Int
NodeOrigin -> [NodeOrigin]
NodeOrigin -> NodeOrigin
NodeOrigin -> NodeOrigin -> [NodeOrigin]
NodeOrigin -> NodeOrigin -> NodeOrigin -> [NodeOrigin]
(NodeOrigin -> NodeOrigin)
-> (NodeOrigin -> NodeOrigin)
-> (Int -> NodeOrigin)
-> (NodeOrigin -> Int)
-> (NodeOrigin -> [NodeOrigin])
-> (NodeOrigin -> NodeOrigin -> [NodeOrigin])
-> (NodeOrigin -> NodeOrigin -> [NodeOrigin])
-> (NodeOrigin -> NodeOrigin -> NodeOrigin -> [NodeOrigin])
-> Enum NodeOrigin
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: NodeOrigin -> NodeOrigin
succ :: NodeOrigin -> NodeOrigin
$cpred :: NodeOrigin -> NodeOrigin
pred :: NodeOrigin -> NodeOrigin
$ctoEnum :: Int -> NodeOrigin
toEnum :: Int -> NodeOrigin
$cfromEnum :: NodeOrigin -> Int
fromEnum :: NodeOrigin -> Int
$cenumFrom :: NodeOrigin -> [NodeOrigin]
enumFrom :: NodeOrigin -> [NodeOrigin]
$cenumFromThen :: NodeOrigin -> NodeOrigin -> [NodeOrigin]
enumFromThen :: NodeOrigin -> NodeOrigin -> [NodeOrigin]
$cenumFromTo :: NodeOrigin -> NodeOrigin -> [NodeOrigin]
enumFromTo :: NodeOrigin -> NodeOrigin -> [NodeOrigin]
$cenumFromThenTo :: NodeOrigin -> NodeOrigin -> NodeOrigin -> [NodeOrigin]
enumFromThenTo :: NodeOrigin -> NodeOrigin -> NodeOrigin -> [NodeOrigin]
Enum, Eq NodeOrigin
Eq NodeOrigin =>
(NodeOrigin -> NodeOrigin -> Ordering)
-> (NodeOrigin -> NodeOrigin -> Bool)
-> (NodeOrigin -> NodeOrigin -> Bool)
-> (NodeOrigin -> NodeOrigin -> Bool)
-> (NodeOrigin -> NodeOrigin -> Bool)
-> (NodeOrigin -> NodeOrigin -> NodeOrigin)
-> (NodeOrigin -> NodeOrigin -> NodeOrigin)
-> Ord NodeOrigin
NodeOrigin -> NodeOrigin -> Bool
NodeOrigin -> NodeOrigin -> Ordering
NodeOrigin -> NodeOrigin -> NodeOrigin
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: NodeOrigin -> NodeOrigin -> Ordering
compare :: NodeOrigin -> NodeOrigin -> Ordering
$c< :: NodeOrigin -> NodeOrigin -> Bool
< :: NodeOrigin -> NodeOrigin -> Bool
$c<= :: NodeOrigin -> NodeOrigin -> Bool
<= :: NodeOrigin -> NodeOrigin -> Bool
$c> :: NodeOrigin -> NodeOrigin -> Bool
> :: NodeOrigin -> NodeOrigin -> Bool
$c>= :: NodeOrigin -> NodeOrigin -> Bool
>= :: NodeOrigin -> NodeOrigin -> Bool
$cmax :: NodeOrigin -> NodeOrigin -> NodeOrigin
max :: NodeOrigin -> NodeOrigin -> NodeOrigin
$cmin :: NodeOrigin -> NodeOrigin -> NodeOrigin
min :: NodeOrigin -> NodeOrigin -> NodeOrigin
Ord)
instance Outputable NodeOrigin where
ppr :: NodeOrigin -> SDoc
ppr NodeOrigin
SourceInfo = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"From source"
ppr NodeOrigin
GeneratedInfo = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"generated by ghc"
instance Binary NodeOrigin where
put_ :: BinHandle -> NodeOrigin -> IO ()
put_ BinHandle
bh NodeOrigin
b = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (NodeOrigin -> Int
forall a. Enum a => a -> Int
fromEnum NodeOrigin
b))
get :: BinHandle -> IO NodeOrigin
get BinHandle
bh = do Word8
x <- BinHandle -> IO Word8
getByte BinHandle
bh; NodeOrigin -> IO NodeOrigin
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NodeOrigin -> IO NodeOrigin) -> NodeOrigin -> IO NodeOrigin
forall a b. (a -> b) -> a -> b
$! (Int -> NodeOrigin
forall a. Enum a => Int -> a
toEnum (Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
x))
data NodeAnnotation = NodeAnnotation
{ NodeAnnotation -> FastString
nodeAnnotConstr :: !FastString
, NodeAnnotation -> FastString
nodeAnnotType :: !FastString
}
deriving (NodeAnnotation -> NodeAnnotation -> Bool
(NodeAnnotation -> NodeAnnotation -> Bool)
-> (NodeAnnotation -> NodeAnnotation -> Bool) -> Eq NodeAnnotation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NodeAnnotation -> NodeAnnotation -> Bool
== :: NodeAnnotation -> NodeAnnotation -> Bool
$c/= :: NodeAnnotation -> NodeAnnotation -> Bool
/= :: NodeAnnotation -> NodeAnnotation -> Bool
Eq)
instance Ord NodeAnnotation where
compare :: NodeAnnotation -> NodeAnnotation -> Ordering
compare (NodeAnnotation FastString
c0 FastString
t0) (NodeAnnotation FastString
c1 FastString
t1)
= [Ordering] -> Ordering
forall a. Monoid a => [a] -> a
mconcat [FastString -> FastString -> Ordering
lexicalCompareFS FastString
c0 FastString
c1, FastString -> FastString -> Ordering
lexicalCompareFS FastString
t0 FastString
t1]
instance Outputable NodeAnnotation where
ppr :: NodeAnnotation -> SDoc
ppr (NodeAnnotation FastString
c FastString
t) = (FastString, FastString) -> SDoc
forall a. Outputable a => a -> SDoc
ppr (FastString
c,FastString
t)
instance Binary NodeAnnotation where
put_ :: BinHandle -> NodeAnnotation -> IO ()
put_ BinHandle
bh (NodeAnnotation FastString
c FastString
t) = do
BinHandle -> FastString -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh FastString
c
BinHandle -> FastString -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh FastString
t
get :: BinHandle -> IO NodeAnnotation
get BinHandle
bh = FastString -> FastString -> NodeAnnotation
NodeAnnotation
(FastString -> FastString -> NodeAnnotation)
-> IO FastString -> IO (FastString -> NodeAnnotation)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO FastString
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
IO (FastString -> NodeAnnotation)
-> IO FastString -> IO NodeAnnotation
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 FastString
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
data NodeInfo a = NodeInfo
{ forall a. NodeInfo a -> Set NodeAnnotation
nodeAnnotations :: S.Set NodeAnnotation
, forall a. NodeInfo a -> [a]
nodeType :: [a]
, forall a. NodeInfo a -> NodeIdentifiers a
nodeIdentifiers :: NodeIdentifiers a
} deriving ((forall a b. (a -> b) -> NodeInfo a -> NodeInfo b)
-> (forall a b. a -> NodeInfo b -> NodeInfo a) -> Functor NodeInfo
forall a b. a -> NodeInfo b -> NodeInfo a
forall a b. (a -> b) -> NodeInfo a -> NodeInfo b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> NodeInfo a -> NodeInfo b
fmap :: forall a b. (a -> b) -> NodeInfo a -> NodeInfo b
$c<$ :: forall a b. a -> NodeInfo b -> NodeInfo a
<$ :: forall a b. a -> NodeInfo b -> NodeInfo a
Functor, (forall m. Monoid m => NodeInfo m -> m)
-> (forall m a. Monoid m => (a -> m) -> NodeInfo a -> m)
-> (forall m a. Monoid m => (a -> m) -> NodeInfo a -> m)
-> (forall a b. (a -> b -> b) -> b -> NodeInfo a -> b)
-> (forall a b. (a -> b -> b) -> b -> NodeInfo a -> b)
-> (forall b a. (b -> a -> b) -> b -> NodeInfo a -> b)
-> (forall b a. (b -> a -> b) -> b -> NodeInfo a -> b)
-> (forall a. (a -> a -> a) -> NodeInfo a -> a)
-> (forall a. (a -> a -> a) -> NodeInfo a -> a)
-> (forall a. NodeInfo a -> [a])
-> (forall a. NodeInfo a -> Bool)
-> (forall a. NodeInfo a -> Int)
-> (forall a. Eq a => a -> NodeInfo a -> Bool)
-> (forall a. Ord a => NodeInfo a -> a)
-> (forall a. Ord a => NodeInfo a -> a)
-> (forall a. Num a => NodeInfo a -> a)
-> (forall a. Num a => NodeInfo a -> a)
-> Foldable NodeInfo
forall a. Eq a => a -> NodeInfo a -> Bool
forall a. Num a => NodeInfo a -> a
forall a. Ord a => NodeInfo a -> a
forall m. Monoid m => NodeInfo m -> m
forall a. NodeInfo a -> Bool
forall a. NodeInfo a -> Int
forall a. NodeInfo a -> [a]
forall a. (a -> a -> a) -> NodeInfo a -> a
forall m a. Monoid m => (a -> m) -> NodeInfo a -> m
forall b a. (b -> a -> b) -> b -> NodeInfo a -> b
forall a b. (a -> b -> b) -> b -> NodeInfo a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall m. Monoid m => NodeInfo m -> m
fold :: forall m. Monoid m => NodeInfo m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> NodeInfo a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> NodeInfo a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> NodeInfo a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> NodeInfo a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> NodeInfo a -> b
foldr :: forall a b. (a -> b -> b) -> b -> NodeInfo a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> NodeInfo a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> NodeInfo a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> NodeInfo a -> b
foldl :: forall b a. (b -> a -> b) -> b -> NodeInfo a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> NodeInfo a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> NodeInfo a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> NodeInfo a -> a
foldr1 :: forall a. (a -> a -> a) -> NodeInfo a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> NodeInfo a -> a
foldl1 :: forall a. (a -> a -> a) -> NodeInfo a -> a
$ctoList :: forall a. NodeInfo a -> [a]
toList :: forall a. NodeInfo a -> [a]
$cnull :: forall a. NodeInfo a -> Bool
null :: forall a. NodeInfo a -> Bool
$clength :: forall a. NodeInfo a -> Int
length :: forall a. NodeInfo a -> Int
$celem :: forall a. Eq a => a -> NodeInfo a -> Bool
elem :: forall a. Eq a => a -> NodeInfo a -> Bool
$cmaximum :: forall a. Ord a => NodeInfo a -> a
maximum :: forall a. Ord a => NodeInfo a -> a
$cminimum :: forall a. Ord a => NodeInfo a -> a
minimum :: forall a. Ord a => NodeInfo a -> a
$csum :: forall a. Num a => NodeInfo a -> a
sum :: forall a. Num a => NodeInfo a -> a
$cproduct :: forall a. Num a => NodeInfo a -> a
product :: forall a. Num a => NodeInfo a -> a
Foldable, Functor NodeInfo
Foldable NodeInfo
(Functor NodeInfo, Foldable NodeInfo) =>
(forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> NodeInfo a -> f (NodeInfo b))
-> (forall (f :: * -> *) a.
Applicative f =>
NodeInfo (f a) -> f (NodeInfo a))
-> (forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> NodeInfo a -> m (NodeInfo b))
-> (forall (m :: * -> *) a.
Monad m =>
NodeInfo (m a) -> m (NodeInfo a))
-> Traversable NodeInfo
forall (t :: * -> *).
(Functor t, Foldable t) =>
(forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => NodeInfo (m a) -> m (NodeInfo a)
forall (f :: * -> *) a.
Applicative f =>
NodeInfo (f a) -> f (NodeInfo a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> NodeInfo a -> m (NodeInfo b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> NodeInfo a -> f (NodeInfo b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> NodeInfo a -> f (NodeInfo b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> NodeInfo a -> f (NodeInfo b)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
NodeInfo (f a) -> f (NodeInfo a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
NodeInfo (f a) -> f (NodeInfo a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> NodeInfo a -> m (NodeInfo b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> NodeInfo a -> m (NodeInfo b)
$csequence :: forall (m :: * -> *) a. Monad m => NodeInfo (m a) -> m (NodeInfo a)
sequence :: forall (m :: * -> *) a. Monad m => NodeInfo (m a) -> m (NodeInfo a)
Traversable)
instance Binary (NodeInfo TypeIndex) where
put_ :: BinHandle -> NodeInfo Int -> IO ()
put_ BinHandle
bh NodeInfo Int
ni = do
BinHandle -> [NodeAnnotation] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh ([NodeAnnotation] -> IO ()) -> [NodeAnnotation] -> IO ()
forall a b. (a -> b) -> a -> b
$ Set NodeAnnotation -> [NodeAnnotation]
forall a. Set a -> [a]
S.toAscList (Set NodeAnnotation -> [NodeAnnotation])
-> Set NodeAnnotation -> [NodeAnnotation]
forall a b. (a -> b) -> a -> b
$ NodeInfo Int -> Set NodeAnnotation
forall a. NodeInfo a -> Set NodeAnnotation
nodeAnnotations NodeInfo Int
ni
BinHandle -> [Int] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh ([Int] -> IO ()) -> [Int] -> IO ()
forall a b. (a -> b) -> a -> b
$ NodeInfo Int -> [Int]
forall a. NodeInfo a -> [a]
nodeType NodeInfo Int
ni
BinHandle -> [(Identifier, IdentifierDetails Int)] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh ([(Identifier, IdentifierDetails Int)] -> IO ())
-> [(Identifier, IdentifierDetails Int)] -> IO ()
forall a b. (a -> b) -> a -> b
$ Map Identifier (IdentifierDetails Int)
-> [(Identifier, IdentifierDetails Int)]
forall k a. Map k a -> [(k, a)]
M.toList (Map Identifier (IdentifierDetails Int)
-> [(Identifier, IdentifierDetails Int)])
-> Map Identifier (IdentifierDetails Int)
-> [(Identifier, IdentifierDetails Int)]
forall a b. (a -> b) -> a -> b
$ NodeInfo Int -> Map Identifier (IdentifierDetails Int)
forall a. NodeInfo a -> NodeIdentifiers a
nodeIdentifiers NodeInfo Int
ni
get :: BinHandle -> IO (NodeInfo Int)
get BinHandle
bh = Set NodeAnnotation
-> [Int] -> Map Identifier (IdentifierDetails Int) -> NodeInfo Int
forall a.
Set NodeAnnotation -> [a] -> NodeIdentifiers a -> NodeInfo a
NodeInfo
(Set NodeAnnotation
-> [Int] -> Map Identifier (IdentifierDetails Int) -> NodeInfo Int)
-> IO (Set NodeAnnotation)
-> IO
([Int] -> Map Identifier (IdentifierDetails Int) -> NodeInfo Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([NodeAnnotation] -> Set NodeAnnotation)
-> IO [NodeAnnotation] -> IO (Set NodeAnnotation)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([NodeAnnotation] -> Set NodeAnnotation
forall a. [a] -> Set a
S.fromDistinctAscList) (BinHandle -> IO [NodeAnnotation]
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh)
IO
([Int] -> Map Identifier (IdentifierDetails Int) -> NodeInfo Int)
-> IO [Int]
-> IO (Map Identifier (IdentifierDetails Int) -> NodeInfo Int)
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 [Int]
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
IO (Map Identifier (IdentifierDetails Int) -> NodeInfo Int)
-> IO (Map Identifier (IdentifierDetails Int)) -> IO (NodeInfo Int)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ([(Identifier, IdentifierDetails Int)]
-> Map Identifier (IdentifierDetails Int))
-> IO [(Identifier, IdentifierDetails Int)]
-> IO (Map Identifier (IdentifierDetails Int))
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([(Identifier, IdentifierDetails Int)]
-> Map Identifier (IdentifierDetails Int)
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList) (BinHandle -> IO [(Identifier, IdentifierDetails Int)]
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh)
instance Outputable a => Outputable (NodeInfo a) where
ppr :: NodeInfo a -> SDoc
ppr (NodeInfo Set NodeAnnotation
anns [a]
typs NodeIdentifiers a
idents) = SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
braces (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
fsep ([SDoc] -> SDoc) -> [SDoc] -> SDoc
forall a b. (a -> b) -> a -> b
$ SDoc -> [SDoc] -> [SDoc]
forall doc. IsLine doc => doc -> [doc] -> [doc]
punctuate SDoc
", "
[ SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
parens (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"annotations:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Set NodeAnnotation -> SDoc
forall a. Outputable a => a -> SDoc
ppr Set NodeAnnotation
anns)
, SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
parens (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"types:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [a] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [a]
typs)
, SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
parens (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"identifier info:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> NodeIdentifiers a -> SDoc
forall a. Outputable a => NodeIdentifiers a -> SDoc
pprNodeIdents NodeIdentifiers a
idents)
]
pprNodeIdents :: Outputable a => NodeIdentifiers a -> SDoc
pprNodeIdents :: forall a. Outputable a => NodeIdentifiers a -> SDoc
pprNodeIdents NodeIdentifiers a
ni = SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
braces (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
fsep ([SDoc] -> SDoc) -> [SDoc] -> SDoc
forall a b. (a -> b) -> a -> b
$ SDoc -> [SDoc] -> [SDoc]
forall doc. IsLine doc => doc -> [doc] -> [doc]
punctuate SDoc
", " ([SDoc] -> [SDoc]) -> [SDoc] -> [SDoc]
forall a b. (a -> b) -> a -> b
$ ((Identifier, IdentifierDetails a) -> SDoc)
-> [(Identifier, IdentifierDetails a)] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (Identifier, IdentifierDetails a) -> SDoc
forall {a}. Outputable a => (Identifier, a) -> SDoc
go ([(Identifier, IdentifierDetails a)] -> [SDoc])
-> [(Identifier, IdentifierDetails a)] -> [SDoc]
forall a b. (a -> b) -> a -> b
$ NodeIdentifiers a -> [(Identifier, IdentifierDetails a)]
forall k a. Map k a -> [(k, a)]
M.toList NodeIdentifiers a
ni
where
go :: (Identifier, a) -> SDoc
go (Identifier
i,a
id) = SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
parens (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hsep ([SDoc] -> SDoc) -> [SDoc] -> SDoc
forall a b. (a -> b) -> a -> b
$ SDoc -> [SDoc] -> [SDoc]
forall doc. IsLine doc => doc -> [doc] -> [doc]
punctuate SDoc
", " [Identifier -> SDoc
pprIdentifier Identifier
i, a -> SDoc
forall a. Outputable a => a -> SDoc
ppr a
id]
pprIdentifier :: Identifier -> SDoc
pprIdentifier :: Identifier -> SDoc
pprIdentifier (Left ModuleName
mod) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"module" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> ModuleName -> SDoc
forall a. Outputable a => a -> SDoc
ppr ModuleName
mod
pprIdentifier (Right Name
name) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"name" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
name
type Identifier = Either ModuleName Name
type NodeIdentifiers a = M.Map Identifier (IdentifierDetails a)
data IdentifierDetails a = IdentifierDetails
{ forall a. IdentifierDetails a -> Maybe a
identType :: Maybe a
, forall a. IdentifierDetails a -> Set ContextInfo
identInfo :: S.Set ContextInfo
} deriving (IdentifierDetails a -> IdentifierDetails a -> Bool
(IdentifierDetails a -> IdentifierDetails a -> Bool)
-> (IdentifierDetails a -> IdentifierDetails a -> Bool)
-> Eq (IdentifierDetails a)
forall a.
Eq a =>
IdentifierDetails a -> IdentifierDetails a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a.
Eq a =>
IdentifierDetails a -> IdentifierDetails a -> Bool
== :: IdentifierDetails a -> IdentifierDetails a -> Bool
$c/= :: forall a.
Eq a =>
IdentifierDetails a -> IdentifierDetails a -> Bool
/= :: IdentifierDetails a -> IdentifierDetails a -> Bool
Eq, (forall a b.
(a -> b) -> IdentifierDetails a -> IdentifierDetails b)
-> (forall a b. a -> IdentifierDetails b -> IdentifierDetails a)
-> Functor IdentifierDetails
forall a b. a -> IdentifierDetails b -> IdentifierDetails a
forall a b. (a -> b) -> IdentifierDetails a -> IdentifierDetails b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> IdentifierDetails a -> IdentifierDetails b
fmap :: forall a b. (a -> b) -> IdentifierDetails a -> IdentifierDetails b
$c<$ :: forall a b. a -> IdentifierDetails b -> IdentifierDetails a
<$ :: forall a b. a -> IdentifierDetails b -> IdentifierDetails a
Functor, (forall m. Monoid m => IdentifierDetails m -> m)
-> (forall m a. Monoid m => (a -> m) -> IdentifierDetails a -> m)
-> (forall m a. Monoid m => (a -> m) -> IdentifierDetails a -> m)
-> (forall a b. (a -> b -> b) -> b -> IdentifierDetails a -> b)
-> (forall a b. (a -> b -> b) -> b -> IdentifierDetails a -> b)
-> (forall b a. (b -> a -> b) -> b -> IdentifierDetails a -> b)
-> (forall b a. (b -> a -> b) -> b -> IdentifierDetails a -> b)
-> (forall a. (a -> a -> a) -> IdentifierDetails a -> a)
-> (forall a. (a -> a -> a) -> IdentifierDetails a -> a)
-> (forall a. IdentifierDetails a -> [a])
-> (forall a. IdentifierDetails a -> Bool)
-> (forall a. IdentifierDetails a -> Int)
-> (forall a. Eq a => a -> IdentifierDetails a -> Bool)
-> (forall a. Ord a => IdentifierDetails a -> a)
-> (forall a. Ord a => IdentifierDetails a -> a)
-> (forall a. Num a => IdentifierDetails a -> a)
-> (forall a. Num a => IdentifierDetails a -> a)
-> Foldable IdentifierDetails
forall a. Eq a => a -> IdentifierDetails a -> Bool
forall a. Num a => IdentifierDetails a -> a
forall a. Ord a => IdentifierDetails a -> a
forall m. Monoid m => IdentifierDetails m -> m
forall a. IdentifierDetails a -> Bool
forall a. IdentifierDetails a -> Int
forall a. IdentifierDetails a -> [a]
forall a. (a -> a -> a) -> IdentifierDetails a -> a
forall m a. Monoid m => (a -> m) -> IdentifierDetails a -> m
forall b a. (b -> a -> b) -> b -> IdentifierDetails a -> b
forall a b. (a -> b -> b) -> b -> IdentifierDetails a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall m. Monoid m => IdentifierDetails m -> m
fold :: forall m. Monoid m => IdentifierDetails m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> IdentifierDetails a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> IdentifierDetails a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> IdentifierDetails a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> IdentifierDetails a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> IdentifierDetails a -> b
foldr :: forall a b. (a -> b -> b) -> b -> IdentifierDetails a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> IdentifierDetails a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> IdentifierDetails a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> IdentifierDetails a -> b
foldl :: forall b a. (b -> a -> b) -> b -> IdentifierDetails a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> IdentifierDetails a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> IdentifierDetails a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> IdentifierDetails a -> a
foldr1 :: forall a. (a -> a -> a) -> IdentifierDetails a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> IdentifierDetails a -> a
foldl1 :: forall a. (a -> a -> a) -> IdentifierDetails a -> a
$ctoList :: forall a. IdentifierDetails a -> [a]
toList :: forall a. IdentifierDetails a -> [a]
$cnull :: forall a. IdentifierDetails a -> Bool
null :: forall a. IdentifierDetails a -> Bool
$clength :: forall a. IdentifierDetails a -> Int
length :: forall a. IdentifierDetails a -> Int
$celem :: forall a. Eq a => a -> IdentifierDetails a -> Bool
elem :: forall a. Eq a => a -> IdentifierDetails a -> Bool
$cmaximum :: forall a. Ord a => IdentifierDetails a -> a
maximum :: forall a. Ord a => IdentifierDetails a -> a
$cminimum :: forall a. Ord a => IdentifierDetails a -> a
minimum :: forall a. Ord a => IdentifierDetails a -> a
$csum :: forall a. Num a => IdentifierDetails a -> a
sum :: forall a. Num a => IdentifierDetails a -> a
$cproduct :: forall a. Num a => IdentifierDetails a -> a
product :: forall a. Num a => IdentifierDetails a -> a
Foldable, Functor IdentifierDetails
Foldable IdentifierDetails
(Functor IdentifierDetails, Foldable IdentifierDetails) =>
(forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> IdentifierDetails a -> f (IdentifierDetails b))
-> (forall (f :: * -> *) a.
Applicative f =>
IdentifierDetails (f a) -> f (IdentifierDetails a))
-> (forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> IdentifierDetails a -> m (IdentifierDetails b))
-> (forall (m :: * -> *) a.
Monad m =>
IdentifierDetails (m a) -> m (IdentifierDetails a))
-> Traversable IdentifierDetails
forall (t :: * -> *).
(Functor t, Foldable t) =>
(forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
IdentifierDetails (m a) -> m (IdentifierDetails a)
forall (f :: * -> *) a.
Applicative f =>
IdentifierDetails (f a) -> f (IdentifierDetails a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> IdentifierDetails a -> m (IdentifierDetails b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> IdentifierDetails a -> f (IdentifierDetails b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> IdentifierDetails a -> f (IdentifierDetails b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> IdentifierDetails a -> f (IdentifierDetails b)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
IdentifierDetails (f a) -> f (IdentifierDetails a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
IdentifierDetails (f a) -> f (IdentifierDetails a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> IdentifierDetails a -> m (IdentifierDetails b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> IdentifierDetails a -> m (IdentifierDetails b)
$csequence :: forall (m :: * -> *) a.
Monad m =>
IdentifierDetails (m a) -> m (IdentifierDetails a)
sequence :: forall (m :: * -> *) a.
Monad m =>
IdentifierDetails (m a) -> m (IdentifierDetails a)
Traversable)
instance Outputable a => Outputable (IdentifierDetails a) where
ppr :: IdentifierDetails a -> SDoc
ppr IdentifierDetails a
x = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Details: " SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Maybe a -> SDoc
forall a. Outputable a => a -> SDoc
ppr (IdentifierDetails a -> Maybe a
forall a. IdentifierDetails a -> Maybe a
identType IdentifierDetails a
x) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Set ContextInfo -> SDoc
forall a. Outputable a => a -> SDoc
ppr (IdentifierDetails a -> Set ContextInfo
forall a. IdentifierDetails a -> Set ContextInfo
identInfo IdentifierDetails a
x)
instance Semigroup (IdentifierDetails a) where
IdentifierDetails a
d1 <> :: IdentifierDetails a -> IdentifierDetails a -> IdentifierDetails a
<> IdentifierDetails a
d2 = Maybe a -> Set ContextInfo -> IdentifierDetails a
forall a. Maybe a -> Set ContextInfo -> IdentifierDetails a
IdentifierDetails (IdentifierDetails a -> Maybe a
forall a. IdentifierDetails a -> Maybe a
identType IdentifierDetails a
d1 Maybe a -> Maybe a -> Maybe a
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> IdentifierDetails a -> Maybe a
forall a. IdentifierDetails a -> Maybe a
identType IdentifierDetails a
d2)
(Set ContextInfo -> Set ContextInfo -> Set ContextInfo
forall a. Ord a => Set a -> Set a -> Set a
S.union (IdentifierDetails a -> Set ContextInfo
forall a. IdentifierDetails a -> Set ContextInfo
identInfo IdentifierDetails a
d1) (IdentifierDetails a -> Set ContextInfo
forall a. IdentifierDetails a -> Set ContextInfo
identInfo IdentifierDetails a
d2))
instance Monoid (IdentifierDetails a) where
mempty :: IdentifierDetails a
mempty = Maybe a -> Set ContextInfo -> IdentifierDetails a
forall a. Maybe a -> Set ContextInfo -> IdentifierDetails a
IdentifierDetails Maybe a
forall a. Maybe a
Nothing Set ContextInfo
forall a. Set a
S.empty
instance Binary (IdentifierDetails TypeIndex) where
put_ :: BinHandle -> IdentifierDetails Int -> IO ()
put_ BinHandle
bh IdentifierDetails Int
dets = do
BinHandle -> Maybe Int -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh (Maybe Int -> IO ()) -> Maybe Int -> IO ()
forall a b. (a -> b) -> a -> b
$ IdentifierDetails Int -> Maybe Int
forall a. IdentifierDetails a -> Maybe a
identType IdentifierDetails Int
dets
BinHandle -> [ContextInfo] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh ([ContextInfo] -> IO ()) -> [ContextInfo] -> IO ()
forall a b. (a -> b) -> a -> b
$ Set ContextInfo -> [ContextInfo]
forall a. Set a -> [a]
S.toList (Set ContextInfo -> [ContextInfo])
-> Set ContextInfo -> [ContextInfo]
forall a b. (a -> b) -> a -> b
$ IdentifierDetails Int -> Set ContextInfo
forall a. IdentifierDetails a -> Set ContextInfo
identInfo IdentifierDetails Int
dets
get :: BinHandle -> IO (IdentifierDetails Int)
get BinHandle
bh = Maybe Int -> Set ContextInfo -> IdentifierDetails Int
forall a. Maybe a -> Set ContextInfo -> IdentifierDetails a
IdentifierDetails
(Maybe Int -> Set ContextInfo -> IdentifierDetails Int)
-> IO (Maybe Int) -> IO (Set ContextInfo -> IdentifierDetails Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO (Maybe Int)
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
IO (Set ContextInfo -> IdentifierDetails Int)
-> IO (Set ContextInfo) -> IO (IdentifierDetails Int)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ([ContextInfo] -> Set ContextInfo)
-> IO [ContextInfo] -> IO (Set ContextInfo)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [ContextInfo] -> Set ContextInfo
forall a. [a] -> Set a
S.fromDistinctAscList (BinHandle -> IO [ContextInfo]
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh)
data ContextInfo
= Use
| MatchBind
| IEThing IEType
| TyDecl
| ValBind
BindType
Scope
(Maybe Span)
| PatternBind
Scope
Scope
(Maybe Span)
| ClassTyDecl (Maybe Span)
| Decl
DeclType
(Maybe Span)
| TyVarBind Scope TyVarScope
| RecField RecFieldContext (Maybe Span)
| EvidenceVarBind
EvVarSource
Scope
(Maybe Span)
| EvidenceVarUse
deriving (ContextInfo -> ContextInfo -> Bool
(ContextInfo -> ContextInfo -> Bool)
-> (ContextInfo -> ContextInfo -> Bool) -> Eq ContextInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ContextInfo -> ContextInfo -> Bool
== :: ContextInfo -> ContextInfo -> Bool
$c/= :: ContextInfo -> ContextInfo -> Bool
/= :: ContextInfo -> ContextInfo -> Bool
Eq, Eq ContextInfo
Eq ContextInfo =>
(ContextInfo -> ContextInfo -> Ordering)
-> (ContextInfo -> ContextInfo -> Bool)
-> (ContextInfo -> ContextInfo -> Bool)
-> (ContextInfo -> ContextInfo -> Bool)
-> (ContextInfo -> ContextInfo -> Bool)
-> (ContextInfo -> ContextInfo -> ContextInfo)
-> (ContextInfo -> ContextInfo -> ContextInfo)
-> Ord ContextInfo
ContextInfo -> ContextInfo -> Bool
ContextInfo -> ContextInfo -> Ordering
ContextInfo -> ContextInfo -> ContextInfo
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ContextInfo -> ContextInfo -> Ordering
compare :: ContextInfo -> ContextInfo -> Ordering
$c< :: ContextInfo -> ContextInfo -> Bool
< :: ContextInfo -> ContextInfo -> Bool
$c<= :: ContextInfo -> ContextInfo -> Bool
<= :: ContextInfo -> ContextInfo -> Bool
$c> :: ContextInfo -> ContextInfo -> Bool
> :: ContextInfo -> ContextInfo -> Bool
$c>= :: ContextInfo -> ContextInfo -> Bool
>= :: ContextInfo -> ContextInfo -> Bool
$cmax :: ContextInfo -> ContextInfo -> ContextInfo
max :: ContextInfo -> ContextInfo -> ContextInfo
$cmin :: ContextInfo -> ContextInfo -> ContextInfo
min :: ContextInfo -> ContextInfo -> ContextInfo
Ord)
instance Outputable ContextInfo where
ppr :: ContextInfo -> SDoc
ppr (ContextInfo
Use) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"usage"
ppr (ContextInfo
MatchBind) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"LHS of a match group"
ppr (IEThing IEType
x) = IEType -> SDoc
forall a. Outputable a => a -> SDoc
ppr IEType
x
ppr (ContextInfo
TyDecl) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"bound in a type signature declaration"
ppr (ValBind BindType
t Scope
sc Maybe Span
sp) =
BindType -> SDoc
forall a. Outputable a => a -> SDoc
ppr BindType
t SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"value bound with scope:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Scope -> SDoc
forall a. Outputable a => a -> SDoc
ppr Scope
sc SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Maybe Span -> SDoc
pprBindSpan Maybe Span
sp
ppr (PatternBind Scope
sc1 Scope
sc2 Maybe Span
sp) =
String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"bound in a pattern with scope:"
SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Scope -> SDoc
forall a. Outputable a => a -> SDoc
ppr Scope
sc1 SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
"," SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Scope -> SDoc
forall a. Outputable a => a -> SDoc
ppr Scope
sc2
SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Maybe Span -> SDoc
pprBindSpan Maybe Span
sp
ppr (ClassTyDecl Maybe Span
sp) =
String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"bound in a class type declaration" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Maybe Span -> SDoc
pprBindSpan Maybe Span
sp
ppr (Decl DeclType
d Maybe Span
sp) =
String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"declaration of" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> DeclType -> SDoc
forall a. Outputable a => a -> SDoc
ppr DeclType
d SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Maybe Span -> SDoc
pprBindSpan Maybe Span
sp
ppr (TyVarBind Scope
sc1 TyVarScope
sc2) =
String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"type variable binding with scope:"
SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Scope -> SDoc
forall a. Outputable a => a -> SDoc
ppr Scope
sc1 SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
"," SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> TyVarScope -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyVarScope
sc2
ppr (RecField RecFieldContext
ctx Maybe Span
sp) =
String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"record field" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> RecFieldContext -> SDoc
forall a. Outputable a => a -> SDoc
ppr RecFieldContext
ctx SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Maybe Span -> SDoc
pprBindSpan Maybe Span
sp
ppr (EvidenceVarBind EvVarSource
ctx Scope
sc Maybe Span
sp) =
String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"evidence variable" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> EvVarSource -> SDoc
forall a. Outputable a => a -> SDoc
ppr EvVarSource
ctx
SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ SDoc
"with scope:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Scope -> SDoc
forall a. Outputable a => a -> SDoc
ppr Scope
sc
SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ Maybe Span -> SDoc
pprBindSpan Maybe Span
sp
ppr (ContextInfo
EvidenceVarUse) =
String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"usage of evidence variable"
pprBindSpan :: Maybe Span -> SDoc
pprBindSpan :: Maybe Span -> SDoc
pprBindSpan Maybe Span
Nothing = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
""
pprBindSpan (Just Span
sp) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"bound at:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Span -> SDoc
forall a. Outputable a => a -> SDoc
ppr Span
sp
instance Binary ContextInfo where
put_ :: BinHandle -> ContextInfo -> IO ()
put_ BinHandle
bh ContextInfo
Use = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
0
put_ BinHandle
bh (IEThing IEType
t) = do
BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
1
BinHandle -> IEType -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IEType
t
put_ BinHandle
bh ContextInfo
TyDecl = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
2
put_ BinHandle
bh (ValBind BindType
bt Scope
sc Maybe Span
msp) = do
BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
3
BinHandle -> BindType -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh BindType
bt
BinHandle -> Scope -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Scope
sc
BinHandle -> Maybe BinSpan -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh (Maybe BinSpan -> IO ()) -> Maybe BinSpan -> IO ()
forall a b. (a -> b) -> a -> b
$ Span -> BinSpan
BinSpan (Span -> BinSpan) -> Maybe Span -> Maybe BinSpan
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Span
msp
put_ BinHandle
bh (PatternBind Scope
a Scope
b Maybe Span
c) = do
BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
4
BinHandle -> Scope -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Scope
a
BinHandle -> Scope -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Scope
b
BinHandle -> Maybe BinSpan -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh (Maybe BinSpan -> IO ()) -> Maybe BinSpan -> IO ()
forall a b. (a -> b) -> a -> b
$ Span -> BinSpan
BinSpan (Span -> BinSpan) -> Maybe Span -> Maybe BinSpan
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Span
c
put_ BinHandle
bh (ClassTyDecl Maybe Span
sp) = do
BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
5
BinHandle -> Maybe BinSpan -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh (Maybe BinSpan -> IO ()) -> Maybe BinSpan -> IO ()
forall a b. (a -> b) -> a -> b
$ Span -> BinSpan
BinSpan (Span -> BinSpan) -> Maybe Span -> Maybe BinSpan
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Span
sp
put_ BinHandle
bh (Decl DeclType
a Maybe Span
b) = do
BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
6
BinHandle -> DeclType -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh DeclType
a
BinHandle -> Maybe BinSpan -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh (Maybe BinSpan -> IO ()) -> Maybe BinSpan -> IO ()
forall a b. (a -> b) -> a -> b
$ Span -> BinSpan
BinSpan (Span -> BinSpan) -> Maybe Span -> Maybe BinSpan
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Span
b
put_ BinHandle
bh (TyVarBind Scope
a TyVarScope
b) = do
BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
7
BinHandle -> Scope -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Scope
a
BinHandle -> TyVarScope -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh TyVarScope
b
put_ BinHandle
bh (RecField RecFieldContext
a Maybe Span
b) = do
BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
8
BinHandle -> RecFieldContext -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh RecFieldContext
a
BinHandle -> Maybe BinSpan -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh (Maybe BinSpan -> IO ()) -> Maybe BinSpan -> IO ()
forall a b. (a -> b) -> a -> b
$ Span -> BinSpan
BinSpan (Span -> BinSpan) -> Maybe Span -> Maybe BinSpan
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Span
b
put_ BinHandle
bh ContextInfo
MatchBind = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
9
put_ BinHandle
bh (EvidenceVarBind EvVarSource
a Scope
b Maybe Span
c) = do
BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
10
BinHandle -> EvVarSource -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh EvVarSource
a
BinHandle -> Scope -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Scope
b
BinHandle -> Maybe BinSpan -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh (Maybe BinSpan -> IO ()) -> Maybe BinSpan -> IO ()
forall a b. (a -> b) -> a -> b
$ Span -> BinSpan
BinSpan (Span -> BinSpan) -> Maybe Span -> Maybe BinSpan
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Span
c
put_ BinHandle
bh ContextInfo
EvidenceVarUse = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
11
get :: BinHandle -> IO ContextInfo
get BinHandle
bh = do
(Word8
t :: Word8) <- BinHandle -> IO Word8
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
case Word8
t of
Word8
0 -> ContextInfo -> IO ContextInfo
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ContextInfo
Use
Word8
1 -> IEType -> ContextInfo
IEThing (IEType -> ContextInfo) -> IO IEType -> IO ContextInfo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO IEType
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
Word8
2 -> ContextInfo -> IO ContextInfo
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ContextInfo
TyDecl
Word8
3 -> BindType -> Scope -> Maybe Span -> ContextInfo
ValBind (BindType -> Scope -> Maybe Span -> ContextInfo)
-> IO BindType -> IO (Scope -> Maybe Span -> ContextInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO BindType
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh IO (Scope -> Maybe Span -> ContextInfo)
-> IO Scope -> IO (Maybe Span -> ContextInfo)
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 Scope
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh IO (Maybe Span -> ContextInfo) -> IO (Maybe Span) -> IO ContextInfo
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((BinSpan -> Span) -> Maybe BinSpan -> Maybe Span
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap BinSpan -> Span
unBinSpan (Maybe BinSpan -> Maybe Span)
-> IO (Maybe BinSpan) -> IO (Maybe Span)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO (Maybe BinSpan)
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh)
Word8
4 -> Scope -> Scope -> Maybe Span -> ContextInfo
PatternBind (Scope -> Scope -> Maybe Span -> ContextInfo)
-> IO Scope -> IO (Scope -> Maybe Span -> ContextInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO Scope
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh IO (Scope -> Maybe Span -> ContextInfo)
-> IO Scope -> IO (Maybe Span -> ContextInfo)
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 Scope
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh IO (Maybe Span -> ContextInfo) -> IO (Maybe Span) -> IO ContextInfo
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((BinSpan -> Span) -> Maybe BinSpan -> Maybe Span
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap BinSpan -> Span
unBinSpan (Maybe BinSpan -> Maybe Span)
-> IO (Maybe BinSpan) -> IO (Maybe Span)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO (Maybe BinSpan)
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh)
Word8
5 -> Maybe Span -> ContextInfo
ClassTyDecl (Maybe Span -> ContextInfo) -> IO (Maybe Span) -> IO ContextInfo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((BinSpan -> Span) -> Maybe BinSpan -> Maybe Span
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap BinSpan -> Span
unBinSpan (Maybe BinSpan -> Maybe Span)
-> IO (Maybe BinSpan) -> IO (Maybe Span)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO (Maybe BinSpan)
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh)
Word8
6 -> DeclType -> Maybe Span -> ContextInfo
Decl (DeclType -> Maybe Span -> ContextInfo)
-> IO DeclType -> IO (Maybe Span -> ContextInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO DeclType
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh IO (Maybe Span -> ContextInfo) -> IO (Maybe Span) -> IO ContextInfo
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((BinSpan -> Span) -> Maybe BinSpan -> Maybe Span
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap BinSpan -> Span
unBinSpan (Maybe BinSpan -> Maybe Span)
-> IO (Maybe BinSpan) -> IO (Maybe Span)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO (Maybe BinSpan)
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh)
Word8
7 -> Scope -> TyVarScope -> ContextInfo
TyVarBind (Scope -> TyVarScope -> ContextInfo)
-> IO Scope -> IO (TyVarScope -> ContextInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO Scope
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh IO (TyVarScope -> ContextInfo) -> IO TyVarScope -> IO ContextInfo
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 TyVarScope
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
Word8
8 -> RecFieldContext -> Maybe Span -> ContextInfo
RecField (RecFieldContext -> Maybe Span -> ContextInfo)
-> IO RecFieldContext -> IO (Maybe Span -> ContextInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO RecFieldContext
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh IO (Maybe Span -> ContextInfo) -> IO (Maybe Span) -> IO ContextInfo
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((BinSpan -> Span) -> Maybe BinSpan -> Maybe Span
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap BinSpan -> Span
unBinSpan (Maybe BinSpan -> Maybe Span)
-> IO (Maybe BinSpan) -> IO (Maybe Span)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO (Maybe BinSpan)
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh)
Word8
9 -> ContextInfo -> IO ContextInfo
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ContextInfo
MatchBind
Word8
10 -> EvVarSource -> Scope -> Maybe Span -> ContextInfo
EvidenceVarBind (EvVarSource -> Scope -> Maybe Span -> ContextInfo)
-> IO EvVarSource -> IO (Scope -> Maybe Span -> ContextInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO EvVarSource
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh IO (Scope -> Maybe Span -> ContextInfo)
-> IO Scope -> IO (Maybe Span -> ContextInfo)
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 Scope
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh IO (Maybe Span -> ContextInfo) -> IO (Maybe Span) -> IO ContextInfo
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((BinSpan -> Span) -> Maybe BinSpan -> Maybe Span
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap BinSpan -> Span
unBinSpan (Maybe BinSpan -> Maybe Span)
-> IO (Maybe BinSpan) -> IO (Maybe Span)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO (Maybe BinSpan)
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh)
Word8
11 -> ContextInfo -> IO ContextInfo
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ContextInfo
EvidenceVarUse
Word8
_ -> String -> IO ContextInfo
forall a. HasCallStack => String -> a
panic String
"Binary ContextInfo: invalid tag"
data EvVarSource
= EvPatternBind
| EvSigBind
| EvWrapperBind
| EvImplicitBind
| EvInstBind { EvVarSource -> Bool
isSuperInst :: Bool, EvVarSource -> Name
cls :: Name }
| EvLetBind EvBindDeps
deriving (EvVarSource -> EvVarSource -> Bool
(EvVarSource -> EvVarSource -> Bool)
-> (EvVarSource -> EvVarSource -> Bool) -> Eq EvVarSource
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: EvVarSource -> EvVarSource -> Bool
== :: EvVarSource -> EvVarSource -> Bool
$c/= :: EvVarSource -> EvVarSource -> Bool
/= :: EvVarSource -> EvVarSource -> Bool
Eq,Eq EvVarSource
Eq EvVarSource =>
(EvVarSource -> EvVarSource -> Ordering)
-> (EvVarSource -> EvVarSource -> Bool)
-> (EvVarSource -> EvVarSource -> Bool)
-> (EvVarSource -> EvVarSource -> Bool)
-> (EvVarSource -> EvVarSource -> Bool)
-> (EvVarSource -> EvVarSource -> EvVarSource)
-> (EvVarSource -> EvVarSource -> EvVarSource)
-> Ord EvVarSource
EvVarSource -> EvVarSource -> Bool
EvVarSource -> EvVarSource -> Ordering
EvVarSource -> EvVarSource -> EvVarSource
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: EvVarSource -> EvVarSource -> Ordering
compare :: EvVarSource -> EvVarSource -> Ordering
$c< :: EvVarSource -> EvVarSource -> Bool
< :: EvVarSource -> EvVarSource -> Bool
$c<= :: EvVarSource -> EvVarSource -> Bool
<= :: EvVarSource -> EvVarSource -> Bool
$c> :: EvVarSource -> EvVarSource -> Bool
> :: EvVarSource -> EvVarSource -> Bool
$c>= :: EvVarSource -> EvVarSource -> Bool
>= :: EvVarSource -> EvVarSource -> Bool
$cmax :: EvVarSource -> EvVarSource -> EvVarSource
max :: EvVarSource -> EvVarSource -> EvVarSource
$cmin :: EvVarSource -> EvVarSource -> EvVarSource
min :: EvVarSource -> EvVarSource -> EvVarSource
Ord)
instance Binary EvVarSource where
put_ :: BinHandle -> EvVarSource -> IO ()
put_ BinHandle
bh EvVarSource
EvPatternBind = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
0
put_ BinHandle
bh EvVarSource
EvSigBind = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
1
put_ BinHandle
bh EvVarSource
EvWrapperBind = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
2
put_ BinHandle
bh EvVarSource
EvImplicitBind = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
3
put_ BinHandle
bh (EvInstBind Bool
b Name
cls) = do
BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
4
BinHandle -> Bool -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Bool
b
BinHandle -> Name -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Name
cls
put_ BinHandle
bh (EvLetBind EvBindDeps
deps) = do
BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
5
BinHandle -> EvBindDeps -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh EvBindDeps
deps
get :: BinHandle -> IO EvVarSource
get BinHandle
bh = do
(Word8
t :: Word8) <- BinHandle -> IO Word8
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
case Word8
t of
Word8
0 -> EvVarSource -> IO EvVarSource
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure EvVarSource
EvPatternBind
Word8
1 -> EvVarSource -> IO EvVarSource
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure EvVarSource
EvSigBind
Word8
2 -> EvVarSource -> IO EvVarSource
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure EvVarSource
EvWrapperBind
Word8
3 -> EvVarSource -> IO EvVarSource
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure EvVarSource
EvImplicitBind
Word8
4 -> Bool -> Name -> EvVarSource
EvInstBind (Bool -> Name -> EvVarSource)
-> IO Bool -> IO (Name -> EvVarSource)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO Bool
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh IO (Name -> EvVarSource) -> IO Name -> IO EvVarSource
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 Name
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
Word8
5 -> EvBindDeps -> EvVarSource
EvLetBind (EvBindDeps -> EvVarSource) -> IO EvBindDeps -> IO EvVarSource
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO EvBindDeps
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
Word8
_ -> String -> IO EvVarSource
forall a. HasCallStack => String -> a
panic String
"Binary EvVarSource: invalid tag"
instance Outputable EvVarSource where
ppr :: EvVarSource -> SDoc
ppr EvVarSource
EvPatternBind = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"bound by a pattern"
ppr EvVarSource
EvSigBind = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"bound by a type signature"
ppr EvVarSource
EvWrapperBind = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"bound by a HsWrapper"
ppr EvVarSource
EvImplicitBind = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"bound by an implicit variable binding"
ppr (EvInstBind Bool
False Name
cls) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"bound by an instance of class" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
cls
ppr (EvInstBind Bool
True Name
cls) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"bound due to a superclass of " SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
cls
ppr (EvLetBind EvBindDeps
deps) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"bound by a let, depending on:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> EvBindDeps -> SDoc
forall a. Outputable a => a -> SDoc
ppr EvBindDeps
deps
newtype EvBindDeps = EvBindDeps { EvBindDeps -> [Name]
getEvBindDeps :: [Name] }
deriving EvBindDeps -> SDoc
(EvBindDeps -> SDoc) -> Outputable EvBindDeps
forall a. (a -> SDoc) -> Outputable a
$cppr :: EvBindDeps -> SDoc
ppr :: EvBindDeps -> SDoc
Outputable
instance Eq EvBindDeps where
== :: EvBindDeps -> EvBindDeps -> Bool
(==) = ([Name] -> [Name] -> Bool) -> EvBindDeps -> EvBindDeps -> Bool
forall a b. Coercible a b => a -> b
coerce ([HieName] -> [HieName] -> Bool
forall a. Eq a => a -> a -> Bool
(==) ([HieName] -> [HieName] -> Bool)
-> ([Name] -> [HieName]) -> [Name] -> [Name] -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (Name -> HieName) -> [Name] -> [HieName]
forall a b. (a -> b) -> [a] -> [b]
map Name -> HieName
toHieName)
instance Ord EvBindDeps where
compare :: EvBindDeps -> EvBindDeps -> Ordering
compare = ([Name] -> [Name] -> Ordering)
-> EvBindDeps -> EvBindDeps -> Ordering
forall a b. Coercible a b => a -> b
coerce ([HieName] -> [HieName] -> Ordering
forall a. Ord a => a -> a -> Ordering
compare ([HieName] -> [HieName] -> Ordering)
-> ([Name] -> [HieName]) -> [Name] -> [Name] -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (Name -> HieName) -> [Name] -> [HieName]
forall a b. (a -> b) -> [a] -> [b]
map Name -> HieName
toHieName)
instance Binary EvBindDeps where
put_ :: BinHandle -> EvBindDeps -> IO ()
put_ BinHandle
bh (EvBindDeps [Name]
xs) = BinHandle -> [Name] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [Name]
xs
get :: BinHandle -> IO EvBindDeps
get BinHandle
bh = [Name] -> EvBindDeps
EvBindDeps ([Name] -> EvBindDeps) -> IO [Name] -> IO EvBindDeps
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO [Name]
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
data IEType
= Import
| ImportAs
| ImportHiding
| Export
deriving (IEType -> IEType -> Bool
(IEType -> IEType -> Bool)
-> (IEType -> IEType -> Bool) -> Eq IEType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: IEType -> IEType -> Bool
== :: IEType -> IEType -> Bool
$c/= :: IEType -> IEType -> Bool
/= :: IEType -> IEType -> Bool
Eq, Int -> IEType
IEType -> Int
IEType -> [IEType]
IEType -> IEType
IEType -> IEType -> [IEType]
IEType -> IEType -> IEType -> [IEType]
(IEType -> IEType)
-> (IEType -> IEType)
-> (Int -> IEType)
-> (IEType -> Int)
-> (IEType -> [IEType])
-> (IEType -> IEType -> [IEType])
-> (IEType -> IEType -> [IEType])
-> (IEType -> IEType -> IEType -> [IEType])
-> Enum IEType
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: IEType -> IEType
succ :: IEType -> IEType
$cpred :: IEType -> IEType
pred :: IEType -> IEType
$ctoEnum :: Int -> IEType
toEnum :: Int -> IEType
$cfromEnum :: IEType -> Int
fromEnum :: IEType -> Int
$cenumFrom :: IEType -> [IEType]
enumFrom :: IEType -> [IEType]
$cenumFromThen :: IEType -> IEType -> [IEType]
enumFromThen :: IEType -> IEType -> [IEType]
$cenumFromTo :: IEType -> IEType -> [IEType]
enumFromTo :: IEType -> IEType -> [IEType]
$cenumFromThenTo :: IEType -> IEType -> IEType -> [IEType]
enumFromThenTo :: IEType -> IEType -> IEType -> [IEType]
Enum, Eq IEType
Eq IEType =>
(IEType -> IEType -> Ordering)
-> (IEType -> IEType -> Bool)
-> (IEType -> IEType -> Bool)
-> (IEType -> IEType -> Bool)
-> (IEType -> IEType -> Bool)
-> (IEType -> IEType -> IEType)
-> (IEType -> IEType -> IEType)
-> Ord IEType
IEType -> IEType -> Bool
IEType -> IEType -> Ordering
IEType -> IEType -> IEType
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: IEType -> IEType -> Ordering
compare :: IEType -> IEType -> Ordering
$c< :: IEType -> IEType -> Bool
< :: IEType -> IEType -> Bool
$c<= :: IEType -> IEType -> Bool
<= :: IEType -> IEType -> Bool
$c> :: IEType -> IEType -> Bool
> :: IEType -> IEType -> Bool
$c>= :: IEType -> IEType -> Bool
>= :: IEType -> IEType -> Bool
$cmax :: IEType -> IEType -> IEType
max :: IEType -> IEType -> IEType
$cmin :: IEType -> IEType -> IEType
min :: IEType -> IEType -> IEType
Ord)
instance Outputable IEType where
ppr :: IEType -> SDoc
ppr IEType
Import = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"import"
ppr IEType
ImportAs = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"import as"
ppr IEType
ImportHiding = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"import hiding"
ppr IEType
Export = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"export"
instance Binary IEType where
put_ :: BinHandle -> IEType -> IO ()
put_ BinHandle
bh IEType
b = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (IEType -> Int
forall a. Enum a => a -> Int
fromEnum IEType
b))
get :: BinHandle -> IO IEType
get BinHandle
bh = do Word8
x <- BinHandle -> IO Word8
getByte BinHandle
bh; IEType -> IO IEType
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (IEType -> IO IEType) -> IEType -> IO IEType
forall a b. (a -> b) -> a -> b
$! (Int -> IEType
forall a. Enum a => Int -> a
toEnum (Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
x))
data RecFieldContext
= RecFieldDecl
| RecFieldAssign
| RecFieldMatch
| RecFieldOcc
deriving (RecFieldContext -> RecFieldContext -> Bool
(RecFieldContext -> RecFieldContext -> Bool)
-> (RecFieldContext -> RecFieldContext -> Bool)
-> Eq RecFieldContext
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RecFieldContext -> RecFieldContext -> Bool
== :: RecFieldContext -> RecFieldContext -> Bool
$c/= :: RecFieldContext -> RecFieldContext -> Bool
/= :: RecFieldContext -> RecFieldContext -> Bool
Eq, Int -> RecFieldContext
RecFieldContext -> Int
RecFieldContext -> [RecFieldContext]
RecFieldContext -> RecFieldContext
RecFieldContext -> RecFieldContext -> [RecFieldContext]
RecFieldContext
-> RecFieldContext -> RecFieldContext -> [RecFieldContext]
(RecFieldContext -> RecFieldContext)
-> (RecFieldContext -> RecFieldContext)
-> (Int -> RecFieldContext)
-> (RecFieldContext -> Int)
-> (RecFieldContext -> [RecFieldContext])
-> (RecFieldContext -> RecFieldContext -> [RecFieldContext])
-> (RecFieldContext -> RecFieldContext -> [RecFieldContext])
-> (RecFieldContext
-> RecFieldContext -> RecFieldContext -> [RecFieldContext])
-> Enum RecFieldContext
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: RecFieldContext -> RecFieldContext
succ :: RecFieldContext -> RecFieldContext
$cpred :: RecFieldContext -> RecFieldContext
pred :: RecFieldContext -> RecFieldContext
$ctoEnum :: Int -> RecFieldContext
toEnum :: Int -> RecFieldContext
$cfromEnum :: RecFieldContext -> Int
fromEnum :: RecFieldContext -> Int
$cenumFrom :: RecFieldContext -> [RecFieldContext]
enumFrom :: RecFieldContext -> [RecFieldContext]
$cenumFromThen :: RecFieldContext -> RecFieldContext -> [RecFieldContext]
enumFromThen :: RecFieldContext -> RecFieldContext -> [RecFieldContext]
$cenumFromTo :: RecFieldContext -> RecFieldContext -> [RecFieldContext]
enumFromTo :: RecFieldContext -> RecFieldContext -> [RecFieldContext]
$cenumFromThenTo :: RecFieldContext
-> RecFieldContext -> RecFieldContext -> [RecFieldContext]
enumFromThenTo :: RecFieldContext
-> RecFieldContext -> RecFieldContext -> [RecFieldContext]
Enum, Eq RecFieldContext
Eq RecFieldContext =>
(RecFieldContext -> RecFieldContext -> Ordering)
-> (RecFieldContext -> RecFieldContext -> Bool)
-> (RecFieldContext -> RecFieldContext -> Bool)
-> (RecFieldContext -> RecFieldContext -> Bool)
-> (RecFieldContext -> RecFieldContext -> Bool)
-> (RecFieldContext -> RecFieldContext -> RecFieldContext)
-> (RecFieldContext -> RecFieldContext -> RecFieldContext)
-> Ord RecFieldContext
RecFieldContext -> RecFieldContext -> Bool
RecFieldContext -> RecFieldContext -> Ordering
RecFieldContext -> RecFieldContext -> RecFieldContext
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: RecFieldContext -> RecFieldContext -> Ordering
compare :: RecFieldContext -> RecFieldContext -> Ordering
$c< :: RecFieldContext -> RecFieldContext -> Bool
< :: RecFieldContext -> RecFieldContext -> Bool
$c<= :: RecFieldContext -> RecFieldContext -> Bool
<= :: RecFieldContext -> RecFieldContext -> Bool
$c> :: RecFieldContext -> RecFieldContext -> Bool
> :: RecFieldContext -> RecFieldContext -> Bool
$c>= :: RecFieldContext -> RecFieldContext -> Bool
>= :: RecFieldContext -> RecFieldContext -> Bool
$cmax :: RecFieldContext -> RecFieldContext -> RecFieldContext
max :: RecFieldContext -> RecFieldContext -> RecFieldContext
$cmin :: RecFieldContext -> RecFieldContext -> RecFieldContext
min :: RecFieldContext -> RecFieldContext -> RecFieldContext
Ord)
instance Outputable RecFieldContext where
ppr :: RecFieldContext -> SDoc
ppr RecFieldContext
RecFieldDecl = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"declaration"
ppr RecFieldContext
RecFieldAssign = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"assignment"
ppr RecFieldContext
RecFieldMatch = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"pattern match"
ppr RecFieldContext
RecFieldOcc = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"occurrence"
instance Binary RecFieldContext where
put_ :: BinHandle -> RecFieldContext -> IO ()
put_ BinHandle
bh RecFieldContext
b = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (RecFieldContext -> Int
forall a. Enum a => a -> Int
fromEnum RecFieldContext
b))
get :: BinHandle -> IO RecFieldContext
get BinHandle
bh = do Word8
x <- BinHandle -> IO Word8
getByte BinHandle
bh; RecFieldContext -> IO RecFieldContext
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RecFieldContext -> IO RecFieldContext)
-> RecFieldContext -> IO RecFieldContext
forall a b. (a -> b) -> a -> b
$! (Int -> RecFieldContext
forall a. Enum a => Int -> a
toEnum (Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
x))
data BindType
= RegularBind
| InstanceBind
deriving (BindType -> BindType -> Bool
(BindType -> BindType -> Bool)
-> (BindType -> BindType -> Bool) -> Eq BindType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BindType -> BindType -> Bool
== :: BindType -> BindType -> Bool
$c/= :: BindType -> BindType -> Bool
/= :: BindType -> BindType -> Bool
Eq, Eq BindType
Eq BindType =>
(BindType -> BindType -> Ordering)
-> (BindType -> BindType -> Bool)
-> (BindType -> BindType -> Bool)
-> (BindType -> BindType -> Bool)
-> (BindType -> BindType -> Bool)
-> (BindType -> BindType -> BindType)
-> (BindType -> BindType -> BindType)
-> Ord BindType
BindType -> BindType -> Bool
BindType -> BindType -> Ordering
BindType -> BindType -> BindType
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: BindType -> BindType -> Ordering
compare :: BindType -> BindType -> Ordering
$c< :: BindType -> BindType -> Bool
< :: BindType -> BindType -> Bool
$c<= :: BindType -> BindType -> Bool
<= :: BindType -> BindType -> Bool
$c> :: BindType -> BindType -> Bool
> :: BindType -> BindType -> Bool
$c>= :: BindType -> BindType -> Bool
>= :: BindType -> BindType -> Bool
$cmax :: BindType -> BindType -> BindType
max :: BindType -> BindType -> BindType
$cmin :: BindType -> BindType -> BindType
min :: BindType -> BindType -> BindType
Ord, Int -> BindType
BindType -> Int
BindType -> [BindType]
BindType -> BindType
BindType -> BindType -> [BindType]
BindType -> BindType -> BindType -> [BindType]
(BindType -> BindType)
-> (BindType -> BindType)
-> (Int -> BindType)
-> (BindType -> Int)
-> (BindType -> [BindType])
-> (BindType -> BindType -> [BindType])
-> (BindType -> BindType -> [BindType])
-> (BindType -> BindType -> BindType -> [BindType])
-> Enum BindType
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: BindType -> BindType
succ :: BindType -> BindType
$cpred :: BindType -> BindType
pred :: BindType -> BindType
$ctoEnum :: Int -> BindType
toEnum :: Int -> BindType
$cfromEnum :: BindType -> Int
fromEnum :: BindType -> Int
$cenumFrom :: BindType -> [BindType]
enumFrom :: BindType -> [BindType]
$cenumFromThen :: BindType -> BindType -> [BindType]
enumFromThen :: BindType -> BindType -> [BindType]
$cenumFromTo :: BindType -> BindType -> [BindType]
enumFromTo :: BindType -> BindType -> [BindType]
$cenumFromThenTo :: BindType -> BindType -> BindType -> [BindType]
enumFromThenTo :: BindType -> BindType -> BindType -> [BindType]
Enum)
instance Outputable BindType where
ppr :: BindType -> SDoc
ppr BindType
RegularBind = SDoc
"regular"
ppr BindType
InstanceBind = SDoc
"instance"
instance Binary BindType where
put_ :: BinHandle -> BindType -> IO ()
put_ BinHandle
bh BindType
b = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (BindType -> Int
forall a. Enum a => a -> Int
fromEnum BindType
b))
get :: BinHandle -> IO BindType
get BinHandle
bh = do Word8
x <- BinHandle -> IO Word8
getByte BinHandle
bh; BindType -> IO BindType
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (BindType -> IO BindType) -> BindType -> IO BindType
forall a b. (a -> b) -> a -> b
$! (Int -> BindType
forall a. Enum a => Int -> a
toEnum (Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
x))
data DeclType
= FamDec
| SynDec
| DataDec
| ConDec
| PatSynDec
| ClassDec
| InstDec
deriving (DeclType -> DeclType -> Bool
(DeclType -> DeclType -> Bool)
-> (DeclType -> DeclType -> Bool) -> Eq DeclType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DeclType -> DeclType -> Bool
== :: DeclType -> DeclType -> Bool
$c/= :: DeclType -> DeclType -> Bool
/= :: DeclType -> DeclType -> Bool
Eq, Eq DeclType
Eq DeclType =>
(DeclType -> DeclType -> Ordering)
-> (DeclType -> DeclType -> Bool)
-> (DeclType -> DeclType -> Bool)
-> (DeclType -> DeclType -> Bool)
-> (DeclType -> DeclType -> Bool)
-> (DeclType -> DeclType -> DeclType)
-> (DeclType -> DeclType -> DeclType)
-> Ord DeclType
DeclType -> DeclType -> Bool
DeclType -> DeclType -> Ordering
DeclType -> DeclType -> DeclType
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: DeclType -> DeclType -> Ordering
compare :: DeclType -> DeclType -> Ordering
$c< :: DeclType -> DeclType -> Bool
< :: DeclType -> DeclType -> Bool
$c<= :: DeclType -> DeclType -> Bool
<= :: DeclType -> DeclType -> Bool
$c> :: DeclType -> DeclType -> Bool
> :: DeclType -> DeclType -> Bool
$c>= :: DeclType -> DeclType -> Bool
>= :: DeclType -> DeclType -> Bool
$cmax :: DeclType -> DeclType -> DeclType
max :: DeclType -> DeclType -> DeclType
$cmin :: DeclType -> DeclType -> DeclType
min :: DeclType -> DeclType -> DeclType
Ord, Int -> DeclType
DeclType -> Int
DeclType -> [DeclType]
DeclType -> DeclType
DeclType -> DeclType -> [DeclType]
DeclType -> DeclType -> DeclType -> [DeclType]
(DeclType -> DeclType)
-> (DeclType -> DeclType)
-> (Int -> DeclType)
-> (DeclType -> Int)
-> (DeclType -> [DeclType])
-> (DeclType -> DeclType -> [DeclType])
-> (DeclType -> DeclType -> [DeclType])
-> (DeclType -> DeclType -> DeclType -> [DeclType])
-> Enum DeclType
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: DeclType -> DeclType
succ :: DeclType -> DeclType
$cpred :: DeclType -> DeclType
pred :: DeclType -> DeclType
$ctoEnum :: Int -> DeclType
toEnum :: Int -> DeclType
$cfromEnum :: DeclType -> Int
fromEnum :: DeclType -> Int
$cenumFrom :: DeclType -> [DeclType]
enumFrom :: DeclType -> [DeclType]
$cenumFromThen :: DeclType -> DeclType -> [DeclType]
enumFromThen :: DeclType -> DeclType -> [DeclType]
$cenumFromTo :: DeclType -> DeclType -> [DeclType]
enumFromTo :: DeclType -> DeclType -> [DeclType]
$cenumFromThenTo :: DeclType -> DeclType -> DeclType -> [DeclType]
enumFromThenTo :: DeclType -> DeclType -> DeclType -> [DeclType]
Enum)
instance Outputable DeclType where
ppr :: DeclType -> SDoc
ppr DeclType
FamDec = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"type or data family"
ppr DeclType
SynDec = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"type synonym"
ppr DeclType
DataDec = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"data"
ppr DeclType
ConDec = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"constructor"
ppr DeclType
PatSynDec = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"pattern synonym"
ppr DeclType
ClassDec = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"class"
ppr DeclType
InstDec = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"instance"
instance Binary DeclType where
put_ :: BinHandle -> DeclType -> IO ()
put_ BinHandle
bh DeclType
b = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (DeclType -> Int
forall a. Enum a => a -> Int
fromEnum DeclType
b))
get :: BinHandle -> IO DeclType
get BinHandle
bh = do Word8
x <- BinHandle -> IO Word8
getByte BinHandle
bh; DeclType -> IO DeclType
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DeclType -> IO DeclType) -> DeclType -> IO DeclType
forall a b. (a -> b) -> a -> b
$! (Int -> DeclType
forall a. Enum a => Int -> a
toEnum (Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
x))
data Scope
= NoScope
| LocalScope Span
| ModuleScope
deriving (Scope -> Scope -> Bool
(Scope -> Scope -> Bool) -> (Scope -> Scope -> Bool) -> Eq Scope
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Scope -> Scope -> Bool
== :: Scope -> Scope -> Bool
$c/= :: Scope -> Scope -> Bool
/= :: Scope -> Scope -> Bool
Eq, Eq Scope
Eq Scope =>
(Scope -> Scope -> Ordering)
-> (Scope -> Scope -> Bool)
-> (Scope -> Scope -> Bool)
-> (Scope -> Scope -> Bool)
-> (Scope -> Scope -> Bool)
-> (Scope -> Scope -> Scope)
-> (Scope -> Scope -> Scope)
-> Ord Scope
Scope -> Scope -> Bool
Scope -> Scope -> Ordering
Scope -> Scope -> Scope
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Scope -> Scope -> Ordering
compare :: Scope -> Scope -> Ordering
$c< :: Scope -> Scope -> Bool
< :: Scope -> Scope -> Bool
$c<= :: Scope -> Scope -> Bool
<= :: Scope -> Scope -> Bool
$c> :: Scope -> Scope -> Bool
> :: Scope -> Scope -> Bool
$c>= :: Scope -> Scope -> Bool
>= :: Scope -> Scope -> Bool
$cmax :: Scope -> Scope -> Scope
max :: Scope -> Scope -> Scope
$cmin :: Scope -> Scope -> Scope
min :: Scope -> Scope -> Scope
Ord, Typeable, Typeable Scope
Typeable Scope =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Scope -> c Scope)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Scope)
-> (Scope -> Constr)
-> (Scope -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Scope))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Scope))
-> ((forall b. Data b => b -> b) -> Scope -> Scope)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Scope -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Scope -> r)
-> (forall u. (forall d. Data d => d -> u) -> Scope -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Scope -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Scope -> m Scope)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Scope -> m Scope)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Scope -> m Scope)
-> Data Scope
Scope -> Constr
Scope -> DataType
(forall b. Data b => b -> b) -> Scope -> Scope
forall a.
Typeable a =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Scope -> u
forall u. (forall d. Data d => d -> u) -> Scope -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Scope -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Scope -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Scope -> m Scope
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Scope -> m Scope
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Scope
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Scope -> c Scope
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Scope)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Scope)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Scope -> c Scope
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Scope -> c Scope
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Scope
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Scope
$ctoConstr :: Scope -> Constr
toConstr :: Scope -> Constr
$cdataTypeOf :: Scope -> DataType
dataTypeOf :: Scope -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Scope)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Scope)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Scope)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Scope)
$cgmapT :: (forall b. Data b => b -> b) -> Scope -> Scope
gmapT :: (forall b. Data b => b -> b) -> Scope -> Scope
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Scope -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Scope -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Scope -> r
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Scope -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Scope -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Scope -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Scope -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Scope -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Scope -> m Scope
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Scope -> m Scope
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Scope -> m Scope
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Scope -> m Scope
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Scope -> m Scope
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Scope -> m Scope
Data)
instance Outputable Scope where
ppr :: Scope -> SDoc
ppr Scope
NoScope = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"NoScope"
ppr (LocalScope Span
sp) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"LocalScope" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Span -> SDoc
forall a. Outputable a => a -> SDoc
ppr Span
sp
ppr Scope
ModuleScope = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"ModuleScope"
instance Binary Scope where
put_ :: BinHandle -> Scope -> IO ()
put_ BinHandle
bh Scope
NoScope = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
0
put_ BinHandle
bh (LocalScope Span
span) = do
BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
1
BinHandle -> BinSpan -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh (BinSpan -> IO ()) -> BinSpan -> IO ()
forall a b. (a -> b) -> a -> b
$ Span -> BinSpan
BinSpan Span
span
put_ BinHandle
bh Scope
ModuleScope = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
2
get :: BinHandle -> IO Scope
get BinHandle
bh = do
(Word8
t :: Word8) <- BinHandle -> IO Word8
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
case Word8
t of
Word8
0 -> Scope -> IO Scope
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Scope
NoScope
Word8
1 -> Span -> Scope
LocalScope (Span -> Scope) -> (BinSpan -> Span) -> BinSpan -> Scope
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BinSpan -> Span
unBinSpan (BinSpan -> Scope) -> IO BinSpan -> IO Scope
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO BinSpan
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
Word8
2 -> Scope -> IO Scope
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Scope
ModuleScope
Word8
_ -> String -> IO Scope
forall a. HasCallStack => String -> a
panic String
"Binary Scope: invalid tag"
data TyVarScope
= ResolvedScopes [Scope]
| UnresolvedScope
[Name]
(Maybe Span)
deriving (TyVarScope -> TyVarScope -> Bool
(TyVarScope -> TyVarScope -> Bool)
-> (TyVarScope -> TyVarScope -> Bool) -> Eq TyVarScope
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TyVarScope -> TyVarScope -> Bool
== :: TyVarScope -> TyVarScope -> Bool
$c/= :: TyVarScope -> TyVarScope -> Bool
/= :: TyVarScope -> TyVarScope -> Bool
Eq, Eq TyVarScope
Eq TyVarScope =>
(TyVarScope -> TyVarScope -> Ordering)
-> (TyVarScope -> TyVarScope -> Bool)
-> (TyVarScope -> TyVarScope -> Bool)
-> (TyVarScope -> TyVarScope -> Bool)
-> (TyVarScope -> TyVarScope -> Bool)
-> (TyVarScope -> TyVarScope -> TyVarScope)
-> (TyVarScope -> TyVarScope -> TyVarScope)
-> Ord TyVarScope
TyVarScope -> TyVarScope -> Bool
TyVarScope -> TyVarScope -> Ordering
TyVarScope -> TyVarScope -> TyVarScope
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: TyVarScope -> TyVarScope -> Ordering
compare :: TyVarScope -> TyVarScope -> Ordering
$c< :: TyVarScope -> TyVarScope -> Bool
< :: TyVarScope -> TyVarScope -> Bool
$c<= :: TyVarScope -> TyVarScope -> Bool
<= :: TyVarScope -> TyVarScope -> Bool
$c> :: TyVarScope -> TyVarScope -> Bool
> :: TyVarScope -> TyVarScope -> Bool
$c>= :: TyVarScope -> TyVarScope -> Bool
>= :: TyVarScope -> TyVarScope -> Bool
$cmax :: TyVarScope -> TyVarScope -> TyVarScope
max :: TyVarScope -> TyVarScope -> TyVarScope
$cmin :: TyVarScope -> TyVarScope -> TyVarScope
min :: TyVarScope -> TyVarScope -> TyVarScope
Ord)
instance Outputable TyVarScope where
ppr :: TyVarScope -> SDoc
ppr (ResolvedScopes [Scope]
xs) =
String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"type variable scopes:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hsep (SDoc -> [SDoc] -> [SDoc]
forall doc. IsLine doc => doc -> [doc] -> [doc]
punctuate SDoc
", " ([SDoc] -> [SDoc]) -> [SDoc] -> [SDoc]
forall a b. (a -> b) -> a -> b
$ (Scope -> SDoc) -> [Scope] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map Scope -> SDoc
forall a. Outputable a => a -> SDoc
ppr [Scope]
xs)
ppr (UnresolvedScope [Name]
ns Maybe Span
sp) =
String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"unresolved type variable scope for name" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
O.<> [Name] -> SDoc
forall a. [a] -> SDoc
plural [Name]
ns
SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Maybe Span -> SDoc
pprBindSpan Maybe Span
sp
instance Binary TyVarScope where
put_ :: BinHandle -> TyVarScope -> IO ()
put_ BinHandle
bh (ResolvedScopes [Scope]
xs) = do
BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
0
BinHandle -> [Scope] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [Scope]
xs
put_ BinHandle
bh (UnresolvedScope [Name]
ns Maybe Span
span) = do
BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
1
BinHandle -> [Name] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [Name]
ns
BinHandle -> Maybe BinSpan -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh (Span -> BinSpan
BinSpan (Span -> BinSpan) -> Maybe Span -> Maybe BinSpan
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Span
span)
get :: BinHandle -> IO TyVarScope
get BinHandle
bh = do
(Word8
t :: Word8) <- BinHandle -> IO Word8
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
case Word8
t of
Word8
0 -> [Scope] -> TyVarScope
ResolvedScopes ([Scope] -> TyVarScope) -> IO [Scope] -> IO TyVarScope
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO [Scope]
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
Word8
1 -> [Name] -> Maybe Span -> TyVarScope
UnresolvedScope ([Name] -> Maybe Span -> TyVarScope)
-> IO [Name] -> IO (Maybe Span -> TyVarScope)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO [Name]
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh IO (Maybe Span -> TyVarScope) -> IO (Maybe Span) -> IO TyVarScope
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((BinSpan -> Span) -> Maybe BinSpan -> Maybe Span
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap BinSpan -> Span
unBinSpan (Maybe BinSpan -> Maybe Span)
-> IO (Maybe BinSpan) -> IO (Maybe Span)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO (Maybe BinSpan)
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh)
Word8
_ -> String -> IO TyVarScope
forall a. HasCallStack => String -> a
panic String
"Binary TyVarScope: invalid tag"
data HieName
= ExternalName !Module !OccName !SrcSpan
| LocalName !OccName !SrcSpan
| KnownKeyName !Unique
deriving (HieName -> HieName -> Bool
(HieName -> HieName -> Bool)
-> (HieName -> HieName -> Bool) -> Eq HieName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: HieName -> HieName -> Bool
== :: HieName -> HieName -> Bool
$c/= :: HieName -> HieName -> Bool
/= :: HieName -> HieName -> Bool
Eq)
instance Ord HieName where
compare :: HieName -> HieName -> Ordering
compare (ExternalName Module
a OccName
b SrcSpan
c) (ExternalName Module
d OccName
e SrcSpan
f) = (Module, OccName) -> (Module, OccName) -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Module
a,OccName
b) (Module
d,OccName
e) Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
S.<> SrcSpan -> SrcSpan -> Ordering
leftmost_smallest SrcSpan
c SrcSpan
f
compare (LocalName OccName
a SrcSpan
b) (LocalName OccName
c SrcSpan
d) = OccName -> OccName -> Ordering
forall a. Ord a => a -> a -> Ordering
compare OccName
a OccName
c Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
S.<> SrcSpan -> SrcSpan -> Ordering
leftmost_smallest SrcSpan
b SrcSpan
d
compare (KnownKeyName Unique
a) (KnownKeyName Unique
b) = Unique -> Unique -> Ordering
nonDetCmpUnique Unique
a Unique
b
compare ExternalName{} HieName
_ = Ordering
LT
compare LocalName{} ExternalName{} = Ordering
GT
compare LocalName{} HieName
_ = Ordering
LT
compare KnownKeyName{} HieName
_ = Ordering
GT
instance Outputable HieName where
ppr :: HieName -> SDoc
ppr (ExternalName Module
m OccName
n SrcSpan
sp) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"ExternalName" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Module -> SDoc
forall a. Outputable a => a -> SDoc
ppr Module
m SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> OccName -> SDoc
forall a. Outputable a => a -> SDoc
ppr OccName
n SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SrcSpan -> SDoc
forall a. Outputable a => a -> SDoc
ppr SrcSpan
sp
ppr (LocalName OccName
n SrcSpan
sp) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"LocalName" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> OccName -> SDoc
forall a. Outputable a => a -> SDoc
ppr OccName
n SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SrcSpan -> SDoc
forall a. Outputable a => a -> SDoc
ppr SrcSpan
sp
ppr (KnownKeyName Unique
u) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"KnownKeyName" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Unique -> SDoc
forall a. Outputable a => a -> SDoc
ppr Unique
u
hieNameOcc :: HieName -> OccName
hieNameOcc :: HieName -> OccName
hieNameOcc (ExternalName Module
_ OccName
occ SrcSpan
_) = OccName
occ
hieNameOcc (LocalName OccName
occ SrcSpan
_) = OccName
occ
hieNameOcc (KnownKeyName Unique
u) =
case Unique -> Maybe Name
lookupKnownKeyName Unique
u of
Just Name
n -> Name -> OccName
nameOccName Name
n
Maybe Name
Nothing -> String -> SDoc -> OccName
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"hieNameOcc:unknown known-key unique"
(Unique -> SDoc
forall a. Outputable a => a -> SDoc
ppr Unique
u)
toHieName :: Name -> HieName
toHieName :: Name -> HieName
toHieName Name
name
| Name -> Bool
isKnownKeyName Name
name = Unique -> HieName
KnownKeyName (Name -> Unique
nameUnique Name
name)
| Name -> Bool
isExternalName Name
name = Module -> OccName -> SrcSpan -> HieName
ExternalName ((() :: Constraint) => Name -> Module
Name -> Module
nameModule Name
name)
(Name -> OccName
nameOccName Name
name)
(SrcSpan -> SrcSpan
removeBufSpan (SrcSpan -> SrcSpan) -> SrcSpan -> SrcSpan
forall a b. (a -> b) -> a -> b
$ Name -> SrcSpan
nameSrcSpan Name
name)
| Bool
otherwise = OccName -> SrcSpan -> HieName
LocalName (Name -> OccName
nameOccName Name
name) (SrcSpan -> SrcSpan
removeBufSpan (SrcSpan -> SrcSpan) -> SrcSpan -> SrcSpan
forall a b. (a -> b) -> a -> b
$ Name -> SrcSpan
nameSrcSpan Name
name)