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
|
{-# 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
data SumOrTuple b
= Sum ConTag Arity (Located b)
| Tuple [Located (Maybe (Located 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 (maybe empty ppr . unLoc) xs)
<> parClose
where
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] in
-- GHC.parser.PostProcess
data PatBuilder p
= PatBuilderPat (Pat p)
| PatBuilderPar (Located (PatBuilder p))
| PatBuilderApp (Located (PatBuilder p)) (Located (PatBuilder p))
| PatBuilderOpApp (Located (PatBuilder p)) (Located RdrName) (Located (PatBuilder p))
| PatBuilderVar (Located 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 (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
(Located RdrName) -- Data constructor name
| InfixDataConBuilder
(LHsType GhcPs) -- LHS field
(Located 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
|
