1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
|
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE FlexibleInstances #-}
module GHC.Parser.Types
( SumOrTuple(..)
, pprSumOrTuple
, PatBuilder(..)
, DataConBuilder(..)
)
where
import GHC.Prelude
import GHC.Types.Basic
import GHC.Types.SrcLoc
import GHC.Types.Name.Reader
import GHC.Hs.Extension
import GHC.Hs.Lit
import GHC.Hs.Pat
import GHC.Hs.Type
import GHC.Utils.Outputable as Outputable
import GHC.Data.OrdList
import Data.Foldable
import GHC.Parser.Annotation
import Language.Haskell.Syntax
data SumOrTuple b
= Sum ConTag Arity (LocatedA b) [EpaLocation] [EpaLocation]
-- ^ Last two are the locations of the '|' before and after the payload
| Tuple [Either (EpAnn EpaLocation) (LocatedA b)]
pprSumOrTuple :: Outputable b => Boxity -> SumOrTuple b -> SDoc
pprSumOrTuple boxity = \case
Sum alt arity e _ _ ->
parOpen <+> ppr_bars (alt - 1) <+> ppr e <+> ppr_bars (arity - alt)
<+> parClose
Tuple xs ->
parOpen <> (fcat . punctuate comma $ map ppr_tup xs)
<> parClose
where
ppr_tup (Left _) = empty
ppr_tup (Right e) = ppr e
ppr_bars n = hsep (replicate n (Outputable.char '|'))
(parOpen, parClose) =
case boxity of
Boxed -> (text "(", text ")")
Unboxed -> (text "(#", text "#)")
-- | See Note [Ambiguous syntactic categories] and Note [PatBuilder]
data PatBuilder p
= PatBuilderPat (Pat p)
| PatBuilderPar (LocatedA (PatBuilder p)) AnnParen
| PatBuilderApp (LocatedA (PatBuilder p)) (LocatedA (PatBuilder p))
| PatBuilderAppType (LocatedA (PatBuilder p)) (HsPatSigType GhcPs)
| PatBuilderOpApp (LocatedA (PatBuilder p)) (LocatedN RdrName)
(LocatedA (PatBuilder p)) (EpAnn [AddEpAnn])
| PatBuilderVar (LocatedN RdrName)
| PatBuilderOverLit (HsOverLit GhcPs)
instance Outputable (PatBuilder GhcPs) where
ppr (PatBuilderPat p) = ppr p
ppr (PatBuilderPar (L _ p) _) = parens (ppr p)
ppr (PatBuilderApp (L _ p1) (L _ p2)) = ppr p1 <+> ppr p2
ppr (PatBuilderAppType (L _ p) t) = ppr p <+> text "@" <> ppr t
ppr (PatBuilderOpApp (L _ p1) op (L _ p2) _) = ppr p1 <+> ppr op <+> ppr p2
ppr (PatBuilderVar v) = ppr v
ppr (PatBuilderOverLit l) = ppr l
-- | An accumulator to build a prefix data constructor,
-- e.g. when parsing @MkT A B C@, the accumulator will evolve as follows:
--
-- @
-- 1. PrefixDataConBuilder [] MkT
-- 2. PrefixDataConBuilder [A] MkT
-- 3. PrefixDataConBuilder [A, B] MkT
-- 4. PrefixDataConBuilder [A, B, C] MkT
-- @
--
-- There are two reasons we have a separate builder type instead of using
-- @HsConDeclDetails GhcPs@ directly:
--
-- 1. It's faster, because 'OrdList' gives us constant-time snoc.
-- 2. Having a separate type helps ensure that we don't forget to finalize a
-- 'RecTy' into a 'RecCon' (we do that in 'dataConBuilderDetails').
--
-- See Note [PatBuilder] for another builder type used in the parser.
-- Here the technique is similar, but the motivation is different.
data DataConBuilder
= PrefixDataConBuilder
(OrdList (LHsType GhcPs)) -- Data constructor fields
(LocatedN RdrName) -- Data constructor name
| InfixDataConBuilder
(LHsType GhcPs) -- LHS field
(LocatedN RdrName) -- Data constructor name
(LHsType GhcPs) -- RHS field
instance Outputable DataConBuilder where
ppr (PrefixDataConBuilder flds data_con) =
hang (ppr data_con) 2 (sep (map ppr (toList flds)))
ppr (InfixDataConBuilder lhs data_con rhs) =
ppr lhs <+> ppr data_con <+> ppr rhs
type instance Anno [LocatedA (StmtLR GhcPs GhcPs (LocatedA (PatBuilder GhcPs)))] = SrcSpanAnnL
|
