Break up TcRnTypes, among other modules.
[ghc.git] / compiler / typecheck / TcHoleFitTypes.hs
1 {-# LANGUAGE ExistentialQuantification #-}
2 module TcHoleFitTypes (
3 TypedHole (..), HoleFit (..), HoleFitCandidate (..),
4 CandPlugin, FitPlugin, HoleFitPlugin (..), HoleFitPluginR (..),
5 hfIsLcl, pprHoleFitCand
6 ) where
7
8 import GhcPrelude
9
10 import TcRnTypes
11 import Constraint
12 import TcType
13
14 import RdrName
15
16 import GHC.Hs.Doc
17 import Id
18
19 import Outputable
20 import Name
21
22 import Data.Function ( on )
23
24 data TypedHole = TyH { tyHRelevantCts :: Cts
25 -- ^ Any relevant Cts to the hole
26 , tyHImplics :: [Implication]
27 -- ^ The nested implications of the hole with the
28 -- innermost implication first.
29 , tyHCt :: Maybe Ct
30 -- ^ The hole constraint itself, if available.
31 }
32
33 instance Outputable TypedHole where
34 ppr (TyH rels implics ct)
35 = hang (text "TypedHole") 2
36 (ppr rels $+$ ppr implics $+$ ppr ct)
37
38
39 -- | HoleFitCandidates are passed to hole fit plugins and then
40 -- checked whether they fit a given typed-hole.
41 data HoleFitCandidate = IdHFCand Id -- An id, like locals.
42 | NameHFCand Name -- A name, like built-in syntax.
43 | GreHFCand GlobalRdrElt -- A global, like imported ids.
44 deriving (Eq)
45
46 instance Outputable HoleFitCandidate where
47 ppr = pprHoleFitCand
48
49 pprHoleFitCand :: HoleFitCandidate -> SDoc
50 pprHoleFitCand (IdHFCand cid) = text "Id HFC: " <> ppr cid
51 pprHoleFitCand (NameHFCand cname) = text "Name HFC: " <> ppr cname
52 pprHoleFitCand (GreHFCand cgre) = text "Gre HFC: " <> ppr cgre
53
54
55
56
57 instance NamedThing HoleFitCandidate where
58 getName hfc = case hfc of
59 IdHFCand cid -> idName cid
60 NameHFCand cname -> cname
61 GreHFCand cgre -> gre_name cgre
62 getOccName hfc = case hfc of
63 IdHFCand cid -> occName cid
64 NameHFCand cname -> occName cname
65 GreHFCand cgre -> occName (gre_name cgre)
66
67 instance HasOccName HoleFitCandidate where
68 occName = getOccName
69
70 instance Ord HoleFitCandidate where
71 compare = compare `on` getName
72
73 -- | HoleFit is the type we use for valid hole fits. It contains the
74 -- element that was checked, the Id of that element as found by `tcLookup`,
75 -- and the refinement level of the fit, which is the number of extra argument
76 -- holes that this fit uses (e.g. if hfRefLvl is 2, the fit is for `Id _ _`).
77 data HoleFit =
78 HoleFit { hfId :: Id -- ^ The elements id in the TcM
79 , hfCand :: HoleFitCandidate -- ^ The candidate that was checked.
80 , hfType :: TcType -- ^ The type of the id, possibly zonked.
81 , hfRefLvl :: Int -- ^ The number of holes in this fit.
82 , hfWrap :: [TcType] -- ^ The wrapper for the match.
83 , hfMatches :: [TcType]
84 -- ^ What the refinement variables got matched with, if anything
85 , hfDoc :: Maybe HsDocString
86 -- ^ Documentation of this HoleFit, if available.
87 }
88 | RawHoleFit SDoc
89 -- ^ A fit that is just displayed as is. Here so thatHoleFitPlugins
90 -- can inject any fit they want.
91
92 -- We define an Eq and Ord instance to be able to build a graph.
93 instance Eq HoleFit where
94 (==) = (==) `on` hfId
95
96 instance Outputable HoleFit where
97 ppr (RawHoleFit sd) = sd
98 ppr (HoleFit _ cand ty _ _ mtchs _) =
99 hang (name <+> holes) 2 (text "where" <+> name <+> dcolon <+> (ppr ty))
100 where name = ppr $ getName cand
101 holes = sep $ map (parens . (text "_" <+> dcolon <+>) . ppr) mtchs
102
103 -- We compare HoleFits by their name instead of their Id, since we don't
104 -- want our tests to be affected by the non-determinism of `nonDetCmpVar`,
105 -- which is used to compare Ids. When comparing, we want HoleFits with a lower
106 -- refinement level to come first.
107 instance Ord HoleFit where
108 compare (RawHoleFit _) (RawHoleFit _) = EQ
109 compare (RawHoleFit _) _ = LT
110 compare _ (RawHoleFit _) = GT
111 compare a@(HoleFit {}) b@(HoleFit {}) = cmp a b
112 where cmp = if hfRefLvl a == hfRefLvl b
113 then compare `on` (getName . hfCand)
114 else compare `on` hfRefLvl
115
116 hfIsLcl :: HoleFit -> Bool
117 hfIsLcl hf@(HoleFit {}) = case hfCand hf of
118 IdHFCand _ -> True
119 NameHFCand _ -> False
120 GreHFCand gre -> gre_lcl gre
121 hfIsLcl _ = False
122
123
124 -- | A plugin for modifying the candidate hole fits *before* they're checked.
125 type CandPlugin = TypedHole -> [HoleFitCandidate] -> TcM [HoleFitCandidate]
126
127 -- | A plugin for modifying hole fits *after* they've been found.
128 type FitPlugin = TypedHole -> [HoleFit] -> TcM [HoleFit]
129
130 -- | A HoleFitPlugin is a pair of candidate and fit plugins.
131 data HoleFitPlugin = HoleFitPlugin
132 { candPlugin :: CandPlugin
133 , fitPlugin :: FitPlugin }
134
135 -- | HoleFitPluginR adds a TcRef to hole fit plugins so that plugins can
136 -- track internal state. Note the existential quantification, ensuring that
137 -- the state cannot be modified from outside the plugin.
138 data HoleFitPluginR = forall s. HoleFitPluginR
139 { hfPluginInit :: TcM (TcRef s)
140 -- ^ Initializes the TcRef to be passed to the plugin
141 , hfPluginRun :: TcRef s -> HoleFitPlugin
142 -- ^ The function defining the plugin itself
143 , hfPluginStop :: TcRef s -> TcM ()
144 -- ^ Cleanup of state, guaranteed to be called even on error
145 }