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)