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