never executed always true always false
    1 {-# LANGUAGE DeriveDataTypeable         #-}
    2 {-# LANGUAGE DeriveTraversable          #-}
    3 {-# LANGUAGE FlexibleInstances          #-}
    4 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
    5 {-# LANGUAGE OverloadedStrings          #-}
    6 {-# LANGUAGE PatternSynonyms            #-}
    7 {-# LANGUAGE ScopedTypeVariables        #-}
    8 
    9 {-
   10 Types for the .hie file format are defined here.
   11 
   12 For more information see https://gitlab.haskell.org/ghc/ghc/wikis/hie-files
   13 -}
   14 
   15 module GHC.Iface.Ext.Types where
   16 
   17 import GHC.Prelude
   18 
   19 import GHC.Settings.Config
   20 import GHC.Utils.Binary
   21 import GHC.Data.FastString
   22 import GHC.Builtin.Utils
   23 import GHC.Iface.Type
   24 import GHC.Unit.Module            ( ModuleName, Module )
   25 import GHC.Types.Name
   26 import GHC.Utils.Outputable hiding ( (<>) )
   27 import GHC.Types.SrcLoc
   28 import GHC.Types.Avail
   29 import GHC.Types.Unique
   30 import qualified GHC.Utils.Outputable as O ( (<>) )
   31 import GHC.Utils.Misc
   32 import GHC.Utils.Panic
   33 
   34 import qualified Data.Array as A
   35 import qualified Data.Map as M
   36 import qualified Data.Set as S
   37 import Data.ByteString            ( ByteString )
   38 import Data.Data                  ( Typeable, Data )
   39 import Data.Semigroup             ( Semigroup(..) )
   40 import Data.Word                  ( Word8 )
   41 import Control.Applicative        ( (<|>) )
   42 import Data.Coerce                ( coerce  )
   43 import Data.Function              ( on )
   44 
   45 type Span = RealSrcSpan
   46 
   47 -- | Current version of @.hie@ files
   48 hieVersion :: Integer
   49 hieVersion = read (cProjectVersionInt ++ cProjectPatchLevel) :: Integer
   50 
   51 {- |
   52 GHC builds up a wealth of information about Haskell source as it compiles it.
   53 @.hie@ files are a way of persisting some of this information to disk so that
   54 external tools that need to work with haskell source don't need to parse,
   55 typecheck, and rename all over again. These files contain:
   56 
   57   * a simplified AST
   58 
   59        * nodes are annotated with source positions and types
   60        * identifiers are annotated with scope information
   61 
   62   * the raw bytes of the initial Haskell source
   63 
   64 Besides saving compilation cycles, @.hie@ files also offer a more stable
   65 interface than the GHC API.
   66 -}
   67 data HieFile = HieFile
   68     { hie_hs_file :: FilePath
   69     -- ^ Initial Haskell source file path
   70 
   71     , hie_module :: Module
   72     -- ^ The module this HIE file is for
   73 
   74     , hie_types :: A.Array TypeIndex HieTypeFlat
   75     -- ^ Types referenced in the 'hie_asts'.
   76     --
   77     -- See Note [Efficient serialization of redundant type info]
   78 
   79     , hie_asts :: HieASTs TypeIndex
   80     -- ^ Type-annotated abstract syntax trees
   81 
   82     , hie_exports :: [AvailInfo]
   83     -- ^ The names that this module exports
   84 
   85     , hie_hs_src :: ByteString
   86     -- ^ Raw bytes of the initial Haskell source
   87     }
   88 instance Binary HieFile where
   89   put_ bh hf = do
   90     put_ bh $ hie_hs_file hf
   91     put_ bh $ hie_module hf
   92     put_ bh $ hie_types hf
   93     put_ bh $ hie_asts hf
   94     put_ bh $ hie_exports hf
   95     put_ bh $ hie_hs_src hf
   96 
   97   get bh = HieFile
   98     <$> get bh
   99     <*> get bh
  100     <*> get bh
  101     <*> get bh
  102     <*> get bh
  103     <*> get bh
  104 
  105 
  106 {-
  107 Note [Efficient serialization of redundant type info]
  108 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  109 
  110 The type information in .hie files is highly repetitive and redundant. For
  111 example, consider the expression
  112 
  113     const True 'a'
  114 
  115 There is a lot of shared structure between the types of subterms:
  116 
  117   * const True 'a' ::                 Bool
  118   * const True     ::         Char -> Bool
  119   * const          :: Bool -> Char -> Bool
  120 
  121 Since all 3 of these types need to be stored in the .hie file, it is worth
  122 making an effort to deduplicate this shared structure. The trick is to define
  123 a new data type that is a flattened version of 'Type':
  124 
  125     data HieType a = HAppTy a a  -- data Type = AppTy Type Type
  126                    | HFunTy a a  --           | FunTy Type Type
  127                    | ...
  128 
  129     type TypeIndex = Int
  130 
  131 Types in the final AST are stored in an 'A.Array TypeIndex (HieType TypeIndex)',
  132 where the 'TypeIndex's in the 'HieType' are references to other elements of the
  133 array. Types recovered from GHC are deduplicated and stored in this compressed
  134 form with sharing of subtrees.
  135 -}
  136 
  137 type TypeIndex = Int
  138 
  139 -- | A flattened version of 'Type'.
  140 --
  141 -- See Note [Efficient serialization of redundant type info]
  142 data HieType a
  143   = HTyVarTy Name
  144   | HAppTy a (HieArgs a)
  145   | HTyConApp IfaceTyCon (HieArgs a)
  146   | HForAllTy ((Name, a),ArgFlag) a
  147   | HFunTy a a a
  148   | HQualTy a a           -- ^ type with constraint: @t1 => t2@ (see 'IfaceDFunTy')
  149   | HLitTy IfaceTyLit
  150   | HCastTy a
  151   | HCoercionTy
  152     deriving (Functor, Foldable, Traversable, Eq)
  153 
  154 type HieTypeFlat = HieType TypeIndex
  155 
  156 -- | Roughly isomorphic to the original core 'Type'.
  157 newtype HieTypeFix = Roll (HieType (HieTypeFix))
  158   deriving Eq
  159 
  160 instance Binary (HieType TypeIndex) where
  161   put_ bh (HTyVarTy n) = do
  162     putByte bh 0
  163     put_ bh n
  164   put_ bh (HAppTy a b) = do
  165     putByte bh 1
  166     put_ bh a
  167     put_ bh b
  168   put_ bh (HTyConApp n xs) = do
  169     putByte bh 2
  170     put_ bh n
  171     put_ bh xs
  172   put_ bh (HForAllTy bndr a) = do
  173     putByte bh 3
  174     put_ bh bndr
  175     put_ bh a
  176   put_ bh (HFunTy w a b) = do
  177     putByte bh 4
  178     put_ bh w
  179     put_ bh a
  180     put_ bh b
  181   put_ bh (HQualTy a b) = do
  182     putByte bh 5
  183     put_ bh a
  184     put_ bh b
  185   put_ bh (HLitTy l) = do
  186     putByte bh 6
  187     put_ bh l
  188   put_ bh (HCastTy a) = do
  189     putByte bh 7
  190     put_ bh a
  191   put_ bh (HCoercionTy) = putByte bh 8
  192 
  193   get bh = do
  194     (t :: Word8) <- get bh
  195     case t of
  196       0 -> HTyVarTy <$> get bh
  197       1 -> HAppTy <$> get bh <*> get bh
  198       2 -> HTyConApp <$> get bh <*> get bh
  199       3 -> HForAllTy <$> get bh <*> get bh
  200       4 -> HFunTy <$> get bh <*> get bh <*> get bh
  201       5 -> HQualTy <$> get bh <*> get bh
  202       6 -> HLitTy <$> get bh
  203       7 -> HCastTy <$> get bh
  204       8 -> return HCoercionTy
  205       _ -> panic "Binary (HieArgs Int): invalid tag"
  206 
  207 
  208 -- | A list of type arguments along with their respective visibilities (ie. is
  209 -- this an argument that would return 'True' for 'isVisibleArgFlag'?).
  210 newtype HieArgs a = HieArgs [(Bool,a)]
  211   deriving (Functor, Foldable, Traversable, Eq)
  212 
  213 instance Binary (HieArgs TypeIndex) where
  214   put_ bh (HieArgs xs) = put_ bh xs
  215   get bh = HieArgs <$> get bh
  216 
  217 
  218 -- A HiePath is just a lexical FastString. We use a lexical FastString to avoid
  219 -- non-determinism when printing or storing HieASTs which are sorted by their
  220 -- HiePath.
  221 type HiePath = LexicalFastString
  222 
  223 {-# COMPLETE HiePath #-}
  224 pattern HiePath :: FastString -> HiePath
  225 pattern HiePath fs = LexicalFastString fs
  226 
  227 -- | Mapping from filepaths to the corresponding AST
  228 newtype HieASTs a = HieASTs { getAsts :: M.Map HiePath (HieAST a) }
  229   deriving (Functor, Foldable, Traversable)
  230 
  231 instance Binary (HieASTs TypeIndex) where
  232   put_ bh asts = put_ bh $ M.toAscList $ getAsts asts
  233   get bh = HieASTs <$> fmap M.fromDistinctAscList (get bh)
  234 
  235 instance Outputable a => Outputable (HieASTs a) where
  236   ppr (HieASTs asts) = M.foldrWithKey go "" asts
  237     where
  238       go k a rest = vcat $
  239         [ "File: " O.<> ppr k
  240         , ppr a
  241         , rest
  242         ]
  243 
  244 data HieAST a =
  245   Node
  246     { sourcedNodeInfo :: SourcedNodeInfo a
  247     , nodeSpan :: Span
  248     , nodeChildren :: [HieAST a]
  249     } deriving (Functor, Foldable, Traversable)
  250 
  251 instance Binary (HieAST TypeIndex) where
  252   put_ bh ast = do
  253     put_ bh $ sourcedNodeInfo ast
  254     put_ bh $ nodeSpan ast
  255     put_ bh $ nodeChildren ast
  256 
  257   get bh = Node
  258     <$> get bh
  259     <*> get bh
  260     <*> get bh
  261 
  262 instance Outputable a => Outputable (HieAST a) where
  263   ppr (Node ni sp ch) = hang header 2 rest
  264     where
  265       header = text "Node@" O.<> ppr sp O.<> ":" <+> ppr ni
  266       rest = vcat (map ppr ch)
  267 
  268 
  269 -- | NodeInfos grouped by source
  270 newtype SourcedNodeInfo a = SourcedNodeInfo { getSourcedNodeInfo :: (M.Map NodeOrigin (NodeInfo a)) }
  271   deriving (Functor, Foldable, Traversable)
  272 
  273 instance Binary (SourcedNodeInfo TypeIndex) where
  274   put_ bh asts = put_ bh $ M.toAscList $ getSourcedNodeInfo asts
  275   get bh = SourcedNodeInfo <$> fmap M.fromDistinctAscList (get bh)
  276 
  277 instance Outputable a => Outputable (SourcedNodeInfo a) where
  278   ppr (SourcedNodeInfo asts) = M.foldrWithKey go "" asts
  279     where
  280       go k a rest = vcat $
  281         [ "Source: " O.<> ppr k
  282         , ppr a
  283         , rest
  284         ]
  285 
  286 -- | Source of node info
  287 data NodeOrigin
  288   = SourceInfo
  289   | GeneratedInfo
  290     deriving (Eq, Enum, Ord)
  291 
  292 instance Outputable NodeOrigin where
  293   ppr SourceInfo = text "From source"
  294   ppr GeneratedInfo = text "generated by ghc"
  295 
  296 instance Binary NodeOrigin where
  297   put_ bh b = putByte bh (fromIntegral (fromEnum b))
  298   get bh = do x <- getByte bh; pure $! (toEnum (fromIntegral x))
  299 
  300 -- | A node annotation
  301 data NodeAnnotation = NodeAnnotation
  302    { nodeAnnotConstr :: !FastString -- ^ name of the AST node constructor
  303    , nodeAnnotType   :: !FastString -- ^ name of the AST node Type
  304    }
  305    deriving (Eq)
  306 
  307 instance Ord NodeAnnotation where
  308    compare (NodeAnnotation c0 t0) (NodeAnnotation c1 t1)
  309       = mconcat [lexicalCompareFS c0 c1, lexicalCompareFS t0 t1]
  310 
  311 instance Outputable NodeAnnotation where
  312    ppr (NodeAnnotation c t) = ppr (c,t)
  313 
  314 instance Binary NodeAnnotation where
  315   put_ bh (NodeAnnotation c t) = do
  316     put_ bh c
  317     put_ bh t
  318   get bh = NodeAnnotation
  319     <$> get bh
  320     <*> get bh
  321 
  322 -- | The information stored in one AST node.
  323 --
  324 -- The type parameter exists to provide flexibility in representation of types
  325 -- (see Note [Efficient serialization of redundant type info]).
  326 data NodeInfo a = NodeInfo
  327     { nodeAnnotations :: S.Set NodeAnnotation
  328     -- ^ Annotations
  329 
  330     , nodeType :: [a]
  331     -- ^ The Haskell types of this node, if any.
  332 
  333     , nodeIdentifiers :: NodeIdentifiers a
  334     -- ^ All the identifiers and their details
  335     } deriving (Functor, Foldable, Traversable)
  336 
  337 instance Binary (NodeInfo TypeIndex) where
  338   put_ bh ni = do
  339     put_ bh $ S.toAscList $ nodeAnnotations ni
  340     put_ bh $ nodeType ni
  341     put_ bh $ M.toList $ nodeIdentifiers ni
  342   get bh = NodeInfo
  343     <$> fmap (S.fromDistinctAscList) (get bh)
  344     <*> get bh
  345     <*> fmap (M.fromList) (get bh)
  346 
  347 instance Outputable a => Outputable (NodeInfo a) where
  348   ppr (NodeInfo anns typs idents) = braces $ fsep $ punctuate ", "
  349     [ parens (text "annotations:" <+> ppr anns)
  350     , parens (text "types:" <+> ppr typs)
  351     , parens (text "identifier info:" <+> pprNodeIdents idents)
  352     ]
  353 
  354 pprNodeIdents :: Outputable a => NodeIdentifiers a -> SDoc
  355 pprNodeIdents ni = braces $ fsep $ punctuate ", " $ map go $ M.toList ni
  356   where
  357     go (i,id) = parens $ hsep $ punctuate ", " [pprIdentifier i, ppr id]
  358 
  359 pprIdentifier :: Identifier -> SDoc
  360 pprIdentifier (Left mod) = text "module" <+> ppr mod
  361 pprIdentifier (Right name) = text "name" <+> ppr name
  362 
  363 type Identifier = Either ModuleName Name
  364 
  365 type NodeIdentifiers a = M.Map Identifier (IdentifierDetails a)
  366 
  367 -- | Information associated with every identifier
  368 --
  369 -- We need to include types with identifiers because sometimes multiple
  370 -- identifiers occur in the same span(Overloaded Record Fields and so on)
  371 data IdentifierDetails a = IdentifierDetails
  372   { identType :: Maybe a
  373   , identInfo :: S.Set ContextInfo
  374   } deriving (Eq, Functor, Foldable, Traversable)
  375 
  376 instance Outputable a => Outputable (IdentifierDetails a) where
  377   ppr x = text "Details: " <+> ppr (identType x) <+> ppr (identInfo x)
  378 
  379 instance Semigroup (IdentifierDetails a) where
  380   d1 <> d2 = IdentifierDetails (identType d1 <|> identType d2)
  381                                (S.union (identInfo d1) (identInfo d2))
  382 
  383 instance Monoid (IdentifierDetails a) where
  384   mempty = IdentifierDetails Nothing S.empty
  385 
  386 instance Binary (IdentifierDetails TypeIndex) where
  387   put_ bh dets = do
  388     put_ bh $ identType dets
  389     put_ bh $ S.toList $ identInfo dets
  390   get bh =  IdentifierDetails
  391     <$> get bh
  392     <*> fmap S.fromDistinctAscList (get bh)
  393 
  394 
  395 -- | Different contexts under which identifiers exist
  396 data ContextInfo
  397   = Use                -- ^ regular variable
  398   | MatchBind
  399   | IEThing IEType     -- ^ import/export
  400   | TyDecl
  401 
  402   -- | Value binding
  403   | ValBind
  404       BindType     -- ^ whether or not the binding is in an instance
  405       Scope        -- ^ scope over which the value is bound
  406       (Maybe Span) -- ^ span of entire binding
  407 
  408   -- | Pattern binding
  409   --
  410   -- This case is tricky because the bound identifier can be used in two
  411   -- distinct scopes. Consider the following example (with @-XViewPatterns@)
  412   --
  413   -- @
  414   -- do (b, a, (a -> True)) <- bar
  415   --    foo a
  416   -- @
  417   --
  418   -- The identifier @a@ has two scopes: in the view pattern @(a -> True)@ and
  419   -- in the rest of the @do@-block in @foo a@.
  420   | PatternBind
  421       Scope        -- ^ scope /in the pattern/ (the variable bound can be used
  422                    -- further in the pattern)
  423       Scope        -- ^ rest of the scope outside the pattern
  424       (Maybe Span) -- ^ span of entire binding
  425 
  426   | ClassTyDecl (Maybe Span)
  427 
  428   -- | Declaration
  429   | Decl
  430       DeclType     -- ^ type of declaration
  431       (Maybe Span) -- ^ span of entire binding
  432 
  433   -- | Type variable
  434   | TyVarBind Scope TyVarScope
  435 
  436   -- | Record field
  437   | RecField RecFieldContext (Maybe Span)
  438   -- | Constraint/Dictionary evidence variable binding
  439   | EvidenceVarBind
  440       EvVarSource  -- ^ how did this bind come into being
  441       Scope        -- ^ scope over which the value is bound
  442       (Maybe Span) -- ^ span of the binding site
  443 
  444   -- | Usage of evidence variable
  445   | EvidenceVarUse
  446     deriving (Eq, Ord)
  447 
  448 instance Outputable ContextInfo where
  449  ppr (Use) = text "usage"
  450  ppr (MatchBind) = text "LHS of a match group"
  451  ppr (IEThing x) = ppr x
  452  ppr (TyDecl) = text "bound in a type signature declaration"
  453  ppr (ValBind t sc sp) =
  454    ppr t <+> text "value bound with scope:" <+> ppr sc <+> pprBindSpan sp
  455  ppr (PatternBind sc1 sc2 sp) =
  456    text "bound in a pattern with scope:"
  457      <+> ppr sc1 <+> "," <+> ppr sc2
  458      <+> pprBindSpan sp
  459  ppr (ClassTyDecl sp) =
  460    text "bound in a class type declaration" <+> pprBindSpan sp
  461  ppr (Decl d sp) =
  462    text "declaration of" <+> ppr d <+> pprBindSpan sp
  463  ppr (TyVarBind sc1 sc2) =
  464    text "type variable binding with scope:"
  465      <+> ppr sc1 <+> "," <+> ppr sc2
  466  ppr (RecField ctx sp) =
  467    text "record field" <+> ppr ctx <+> pprBindSpan sp
  468  ppr (EvidenceVarBind ctx sc sp) =
  469    text "evidence variable" <+> ppr ctx
  470      $$ "with scope:" <+> ppr sc
  471      $$ pprBindSpan sp
  472  ppr (EvidenceVarUse) =
  473    text "usage of evidence variable"
  474 
  475 pprBindSpan :: Maybe Span -> SDoc
  476 pprBindSpan Nothing = text ""
  477 pprBindSpan (Just sp) = text "bound at:" <+> ppr sp
  478 
  479 instance Binary ContextInfo where
  480   put_ bh Use = putByte bh 0
  481   put_ bh (IEThing t) = do
  482     putByte bh 1
  483     put_ bh t
  484   put_ bh TyDecl = putByte bh 2
  485   put_ bh (ValBind bt sc msp) = do
  486     putByte bh 3
  487     put_ bh bt
  488     put_ bh sc
  489     put_ bh msp
  490   put_ bh (PatternBind a b c) = do
  491     putByte bh 4
  492     put_ bh a
  493     put_ bh b
  494     put_ bh c
  495   put_ bh (ClassTyDecl sp) = do
  496     putByte bh 5
  497     put_ bh sp
  498   put_ bh (Decl a b) = do
  499     putByte bh 6
  500     put_ bh a
  501     put_ bh b
  502   put_ bh (TyVarBind a b) = do
  503     putByte bh 7
  504     put_ bh a
  505     put_ bh b
  506   put_ bh (RecField a b) = do
  507     putByte bh 8
  508     put_ bh a
  509     put_ bh b
  510   put_ bh MatchBind = putByte bh 9
  511   put_ bh (EvidenceVarBind a b c) = do
  512     putByte bh 10
  513     put_ bh a
  514     put_ bh b
  515     put_ bh c
  516   put_ bh EvidenceVarUse = putByte bh 11
  517 
  518   get bh = do
  519     (t :: Word8) <- get bh
  520     case t of
  521       0 -> return Use
  522       1 -> IEThing <$> get bh
  523       2 -> return TyDecl
  524       3 -> ValBind <$> get bh <*> get bh <*> get bh
  525       4 -> PatternBind <$> get bh <*> get bh <*> get bh
  526       5 -> ClassTyDecl <$> get bh
  527       6 -> Decl <$> get bh <*> get bh
  528       7 -> TyVarBind <$> get bh <*> get bh
  529       8 -> RecField <$> get bh <*> get bh
  530       9 -> return MatchBind
  531       10 -> EvidenceVarBind <$> get bh <*> get bh <*> get bh
  532       11 -> return EvidenceVarUse
  533       _ -> panic "Binary ContextInfo: invalid tag"
  534 
  535 data EvVarSource
  536   = EvPatternBind -- ^ bound by a pattern match
  537   | EvSigBind -- ^ bound by a type signature
  538   | EvWrapperBind -- ^ bound by a hswrapper
  539   | EvImplicitBind -- ^ bound by an implicit variable
  540   | EvInstBind { isSuperInst :: Bool, cls :: Name } -- ^ Bound by some instance of given class
  541   | EvLetBind EvBindDeps -- ^ A direct let binding
  542   deriving (Eq,Ord)
  543 
  544 instance Binary EvVarSource where
  545   put_ bh EvPatternBind = putByte bh 0
  546   put_ bh EvSigBind = putByte bh 1
  547   put_ bh EvWrapperBind = putByte bh 2
  548   put_ bh EvImplicitBind = putByte bh 3
  549   put_ bh (EvInstBind b cls) = do
  550     putByte bh 4
  551     put_ bh b
  552     put_ bh cls
  553   put_ bh (EvLetBind deps) = do
  554     putByte bh 5
  555     put_ bh deps
  556 
  557   get bh = do
  558     (t :: Word8) <- get bh
  559     case t of
  560       0 -> pure EvPatternBind
  561       1 -> pure EvSigBind
  562       2 -> pure EvWrapperBind
  563       3 -> pure EvImplicitBind
  564       4 -> EvInstBind <$> get bh <*> get bh
  565       5 -> EvLetBind <$> get bh
  566       _ -> panic "Binary EvVarSource: invalid tag"
  567 
  568 instance Outputable EvVarSource where
  569   ppr EvPatternBind = text "bound by a pattern"
  570   ppr EvSigBind = text "bound by a type signature"
  571   ppr EvWrapperBind = text "bound by a HsWrapper"
  572   ppr EvImplicitBind = text "bound by an implicit variable binding"
  573   ppr (EvInstBind False cls) = text "bound by an instance of class" <+> ppr cls
  574   ppr (EvInstBind True cls) = text "bound due to a superclass of " <+> ppr cls
  575   ppr (EvLetBind deps) = text "bound by a let, depending on:" <+> ppr deps
  576 
  577 -- | Eq/Ord instances compare on the converted HieName,
  578 -- as non-exported names may have different uniques after
  579 -- a roundtrip
  580 newtype EvBindDeps = EvBindDeps { getEvBindDeps :: [Name] }
  581   deriving Outputable
  582 
  583 instance Eq EvBindDeps where
  584   (==) = coerce ((==) `on` map toHieName)
  585 
  586 instance Ord EvBindDeps where
  587   compare = coerce (compare `on` map toHieName)
  588 
  589 instance Binary EvBindDeps where
  590   put_ bh (EvBindDeps xs) = put_ bh xs
  591   get bh = EvBindDeps <$> get bh
  592 
  593 
  594 -- | Types of imports and exports
  595 data IEType
  596   = Import
  597   | ImportAs
  598   | ImportHiding
  599   | Export
  600     deriving (Eq, Enum, Ord)
  601 
  602 instance Outputable IEType where
  603   ppr Import = text "import"
  604   ppr ImportAs = text "import as"
  605   ppr ImportHiding = text "import hiding"
  606   ppr Export = text "export"
  607 
  608 instance Binary IEType where
  609   put_ bh b = putByte bh (fromIntegral (fromEnum b))
  610   get bh = do x <- getByte bh; pure $! (toEnum (fromIntegral x))
  611 
  612 
  613 data RecFieldContext
  614   = RecFieldDecl
  615   | RecFieldAssign
  616   | RecFieldMatch
  617   | RecFieldOcc
  618     deriving (Eq, Enum, Ord)
  619 
  620 instance Outputable RecFieldContext where
  621   ppr RecFieldDecl = text "declaration"
  622   ppr RecFieldAssign = text "assignment"
  623   ppr RecFieldMatch = text "pattern match"
  624   ppr RecFieldOcc = text "occurence"
  625 
  626 instance Binary RecFieldContext where
  627   put_ bh b = putByte bh (fromIntegral (fromEnum b))
  628   get bh = do x <- getByte bh; pure $! (toEnum (fromIntegral x))
  629 
  630 
  631 data BindType
  632   = RegularBind
  633   | InstanceBind
  634     deriving (Eq, Ord, Enum)
  635 
  636 instance Outputable BindType where
  637   ppr RegularBind = "regular"
  638   ppr InstanceBind = "instance"
  639 
  640 instance Binary BindType where
  641   put_ bh b = putByte bh (fromIntegral (fromEnum b))
  642   get bh = do x <- getByte bh; pure $! (toEnum (fromIntegral x))
  643 
  644 data DeclType
  645   = FamDec     -- ^ type or data family
  646   | SynDec     -- ^ type synonym
  647   | DataDec    -- ^ data declaration
  648   | ConDec     -- ^ constructor declaration
  649   | PatSynDec  -- ^ pattern synonym
  650   | ClassDec   -- ^ class declaration
  651   | InstDec    -- ^ instance declaration
  652     deriving (Eq, Ord, Enum)
  653 
  654 instance Outputable DeclType where
  655   ppr FamDec = text "type or data family"
  656   ppr SynDec = text "type synonym"
  657   ppr DataDec = text "data"
  658   ppr ConDec = text "constructor"
  659   ppr PatSynDec = text "pattern synonym"
  660   ppr ClassDec = text "class"
  661   ppr InstDec = text "instance"
  662 
  663 instance Binary DeclType where
  664   put_ bh b = putByte bh (fromIntegral (fromEnum b))
  665   get bh = do x <- getByte bh; pure $! (toEnum (fromIntegral x))
  666 
  667 data Scope
  668   = NoScope
  669   | LocalScope Span
  670   | ModuleScope
  671     deriving (Eq, Ord, Typeable, Data)
  672 
  673 instance Outputable Scope where
  674   ppr NoScope = text "NoScope"
  675   ppr (LocalScope sp) = text "LocalScope" <+> ppr sp
  676   ppr ModuleScope = text "ModuleScope"
  677 
  678 instance Binary Scope where
  679   put_ bh NoScope = putByte bh 0
  680   put_ bh (LocalScope span) = do
  681     putByte bh 1
  682     put_ bh span
  683   put_ bh ModuleScope = putByte bh 2
  684 
  685   get bh = do
  686     (t :: Word8) <- get bh
  687     case t of
  688       0 -> return NoScope
  689       1 -> LocalScope <$> get bh
  690       2 -> return ModuleScope
  691       _ -> panic "Binary Scope: invalid tag"
  692 
  693 
  694 -- | Scope of a type variable.
  695 --
  696 -- This warrants a data type apart from 'Scope' because of complexities
  697 -- introduced by features like @-XScopedTypeVariables@ and @-XInstanceSigs@. For
  698 -- example, consider:
  699 --
  700 -- @
  701 -- foo, bar, baz :: forall a. a -> a
  702 -- @
  703 --
  704 -- Here @a@ is in scope in all the definitions of @foo@, @bar@, and @baz@, so we
  705 -- need a list of scopes to keep track of this. Furthermore, this list cannot be
  706 -- computed until we resolve the binding sites of @foo@, @bar@, and @baz@.
  707 --
  708 -- Consequently, @a@ starts with an @'UnresolvedScope' [foo, bar, baz] Nothing@
  709 -- which later gets resolved into a 'ResolvedScopes'.
  710 data TyVarScope
  711   = ResolvedScopes [Scope]
  712 
  713   -- | Unresolved scopes should never show up in the final @.hie@ file
  714   | UnresolvedScope
  715         [Name]        -- ^ names of the definitions over which the scope spans
  716         (Maybe Span)  -- ^ the location of the instance/class declaration for
  717                       -- the case where the type variable is declared in a
  718                       -- method type signature
  719     deriving (Eq, Ord)
  720 
  721 instance Outputable TyVarScope where
  722   ppr (ResolvedScopes xs) =
  723     text "type variable scopes:" <+> hsep (punctuate ", " $ map ppr xs)
  724   ppr (UnresolvedScope ns sp) =
  725     text "unresolved type variable scope for name" O.<> plural ns
  726       <+> pprBindSpan sp
  727 
  728 instance Binary TyVarScope where
  729   put_ bh (ResolvedScopes xs) = do
  730     putByte bh 0
  731     put_ bh xs
  732   put_ bh (UnresolvedScope ns span) = do
  733     putByte bh 1
  734     put_ bh ns
  735     put_ bh span
  736 
  737   get bh = do
  738     (t :: Word8) <- get bh
  739     case t of
  740       0 -> ResolvedScopes <$> get bh
  741       1 -> UnresolvedScope <$> get bh <*> get bh
  742       _ -> panic "Binary TyVarScope: invalid tag"
  743 
  744 -- | `Name`'s get converted into `HieName`'s before being written into @.hie@
  745 -- files. See 'toHieName' and 'fromHieName' for logic on how to convert between
  746 -- these two types.
  747 data HieName
  748   = ExternalName !Module !OccName !SrcSpan
  749   | LocalName !OccName !SrcSpan
  750   | KnownKeyName !Unique
  751   deriving (Eq)
  752 
  753 instance Ord HieName where
  754   compare (ExternalName a b c) (ExternalName d e f) = compare (a,b) (d,e) `thenCmp` leftmost_smallest c f
  755     -- TODO (int-index): Perhaps use RealSrcSpan in HieName?
  756   compare (LocalName a b) (LocalName c d) = compare a c `thenCmp` leftmost_smallest b d
  757     -- TODO (int-index): Perhaps use RealSrcSpan in HieName?
  758   compare (KnownKeyName a) (KnownKeyName b) = nonDetCmpUnique a b
  759     -- Not actually non deterministic as it is a KnownKey
  760   compare ExternalName{} _ = LT
  761   compare LocalName{} ExternalName{} = GT
  762   compare LocalName{} _ = LT
  763   compare KnownKeyName{} _ = GT
  764 
  765 instance Outputable HieName where
  766   ppr (ExternalName m n sp) = text "ExternalName" <+> ppr m <+> ppr n <+> ppr sp
  767   ppr (LocalName n sp) = text "LocalName" <+> ppr n <+> ppr sp
  768   ppr (KnownKeyName u) = text "KnownKeyName" <+> ppr u
  769 
  770 hieNameOcc :: HieName -> OccName
  771 hieNameOcc (ExternalName _ occ _) = occ
  772 hieNameOcc (LocalName occ _) = occ
  773 hieNameOcc (KnownKeyName u) =
  774   case lookupKnownKeyName u of
  775     Just n -> nameOccName n
  776     Nothing -> pprPanic "hieNameOcc:unknown known-key unique"
  777                         (ppr (unpkUnique u))
  778 
  779 toHieName :: Name -> HieName
  780 toHieName name
  781   | isKnownKeyName name = KnownKeyName (nameUnique name)
  782   | isExternalName name = ExternalName (nameModule name)
  783                                        (nameOccName name)
  784                                        (nameSrcSpan name)
  785   | otherwise = LocalName (nameOccName name) (nameSrcSpan name)