compiler: de-lhs hsSyn/
[ghc.git] / compiler / hsSyn / HsPat.hs
1 {-
2 (c) The University of Glasgow 2006
3 (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4
5 \section[PatSyntax]{Abstract Haskell syntax---patterns}
6 -}
7
8 {-# LANGUAGE DeriveDataTypeable #-}
9 {-# LANGUAGE DeriveDataTypeable #-}
10 {-# LANGUAGE StandaloneDeriving #-}
11 {-# LANGUAGE FlexibleContexts #-}
12 {-# LANGUAGE UndecidableInstances #-} -- Note [Pass sensitive types]
13 -- in module PlaceHolder
14 {-# LANGUAGE ConstraintKinds #-}
15
16 module HsPat (
17 Pat(..), InPat, OutPat, LPat,
18
19 HsConDetails(..),
20 HsConPatDetails, hsConPatArgs,
21 HsRecFields(..), HsRecField(..), LHsRecField, hsRecFields,
22
23 mkPrefixConPat, mkCharLitPat, mkNilPat,
24
25 isStrictHsBind, looksLazyPatBind,
26 isStrictLPat, hsPatNeedsParens,
27 isIrrefutableHsPat,
28
29 pprParendLPat, pprConArgs
30 ) where
31
32 import {-# SOURCE #-} HsExpr (SyntaxExpr, LHsExpr, HsSplice, pprLExpr, pprUntypedSplice)
33
34 -- friends:
35 import HsBinds
36 import HsLit
37 import PlaceHolder ( PostTc,DataId )
38 import HsTypes
39 import TcEvidence
40 import BasicTypes
41 -- others:
42 import PprCore ( {- instance OutputableBndr TyVar -} )
43 import TysWiredIn
44 import Var
45 import ConLike
46 import DataCon
47 import TyCon
48 import Outputable
49 import Type
50 import SrcLoc
51 import FastString
52 -- libraries:
53 import Data.Data hiding (TyCon,Fixity)
54 import Data.Maybe
55
56 type InPat id = LPat id -- No 'Out' constructors
57 type OutPat id = LPat id -- No 'In' constructors
58
59 type LPat id = Located (Pat id)
60
61 -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnBang'
62 data Pat id
63 = ------------ Simple patterns ---------------
64 WildPat (PostTc id Type) -- Wild card
65 -- The sole reason for a type on a WildPat is to
66 -- support hsPatType :: Pat Id -> Type
67
68 | VarPat id -- Variable
69 | LazyPat (LPat id) -- Lazy pattern
70 | AsPat (Located id) (LPat id) -- As pattern
71 | ParPat (LPat id) -- Parenthesised pattern
72 -- See Note [Parens in HsSyn] in HsExpr
73 | BangPat (LPat id) -- Bang pattern
74
75 ------------ Lists, tuples, arrays ---------------
76 | ListPat [LPat id] -- Syntactic list
77 (PostTc id Type) -- The type of the elements
78 (Maybe (PostTc id Type, SyntaxExpr id)) -- For rebindable syntax
79 -- For OverloadedLists a Just (ty,fn) gives
80 -- overall type of the pattern, and the toList
81 -- function to convert the scrutinee to a list value
82
83 | TuplePat [LPat id] -- Tuple sub-patterns
84 Boxity -- UnitPat is TuplePat []
85 [PostTc id Type] -- [] before typechecker, filled in afterwards
86 -- with the types of the tuple components
87 -- You might think that the PostTc id Type was redundant, because we can
88 -- get the pattern type by getting the types of the sub-patterns.
89 -- But it's essential
90 -- data T a where
91 -- T1 :: Int -> T Int
92 -- f :: (T a, a) -> Int
93 -- f (T1 x, z) = z
94 -- When desugaring, we must generate
95 -- f = /\a. \v::a. case v of (t::T a, w::a) ->
96 -- case t of (T1 (x::Int)) ->
97 -- Note the (w::a), NOT (w::Int), because we have not yet
98 -- refined 'a' to Int. So we must know that the second component
99 -- of the tuple is of type 'a' not Int. See selectMatchVar
100 -- (June 14: I'm not sure this comment is right; the sub-patterns
101 -- will be wrapped in CoPats, no?)
102
103 | PArrPat [LPat id] -- Syntactic parallel array
104 (PostTc id Type) -- The type of the elements
105
106 ------------ Constructor patterns ---------------
107 | ConPatIn (Located id)
108 (HsConPatDetails id)
109
110 | ConPatOut {
111 pat_con :: Located ConLike,
112 pat_arg_tys :: [Type], -- The univeral arg types, 1-1 with the universal
113 -- tyvars of the constructor/pattern synonym
114 -- Use (conLikeResTy pat_con pat_arg_tys) to get
115 -- the type of the pattern
116
117 pat_tvs :: [TyVar], -- Existentially bound type variables (tyvars only)
118 pat_dicts :: [EvVar], -- Ditto *coercion variables* and *dictionaries*
119 -- One reason for putting coercion variable here, I think,
120 -- is to ensure their kinds are zonked
121 pat_binds :: TcEvBinds, -- Bindings involving those dictionaries
122 pat_args :: HsConPatDetails id,
123 pat_wrap :: HsWrapper -- Extra wrapper to pass to the matcher
124 }
125
126 ------------ View patterns ---------------
127 | ViewPat (LHsExpr id)
128 (LPat id)
129 (PostTc id Type) -- The overall type of the pattern
130 -- (= the argument type of the view function)
131 -- for hsPatType.
132
133 ------------ Pattern splices ---------------
134 | SplicePat (HsSplice id)
135
136 ------------ Quasiquoted patterns ---------------
137 -- See Note [Quasi-quote overview] in TcSplice
138 | QuasiQuotePat (HsQuasiQuote id)
139
140 ------------ Literal and n+k patterns ---------------
141 | LitPat HsLit -- Used for *non-overloaded* literal patterns:
142 -- Int#, Char#, Int, Char, String, etc.
143
144 | NPat -- Used for all overloaded literals,
145 -- including overloaded strings with -XOverloadedStrings
146 (HsOverLit id) -- ALWAYS positive
147 (Maybe (SyntaxExpr id)) -- Just (Name of 'negate') for negative
148 -- patterns, Nothing otherwise
149 (SyntaxExpr id) -- Equality checker, of type t->t->Bool
150
151 | NPlusKPat (Located id) -- n+k pattern
152 (HsOverLit id) -- It'll always be an HsIntegral
153 (SyntaxExpr id) -- (>=) function, of type t->t->Bool
154 (SyntaxExpr id) -- Name of '-' (see RnEnv.lookupSyntaxName)
155
156 ------------ Pattern type signatures ---------------
157 | SigPatIn (LPat id) -- Pattern with a type signature
158 (HsWithBndrs id (LHsType id)) -- Signature can bind both
159 -- kind and type vars
160
161 | SigPatOut (LPat id) -- Pattern with a type signature
162 Type
163
164 ------------ Pattern coercions (translation only) ---------------
165 | CoPat HsWrapper -- If co :: t1 ~ t2, p :: t2,
166 -- then (CoPat co p) :: t1
167 (Pat id) -- Why not LPat? Ans: existing locn will do
168 Type -- Type of whole pattern, t1
169 -- During desugaring a (CoPat co pat) turns into a cast with 'co' on
170 -- the scrutinee, followed by a match on 'pat'
171 deriving (Typeable)
172 deriving instance (DataId id) => Data (Pat id)
173
174 -- HsConDetails is use for patterns/expressions *and* for data type declarations
175
176 data HsConDetails arg rec
177 = PrefixCon [arg] -- C p1 p2 p3
178 | RecCon rec -- C { x = p1, y = p2 }
179 | InfixCon arg arg -- p1 `C` p2
180 deriving (Data, Typeable)
181
182 type HsConPatDetails id = HsConDetails (LPat id) (HsRecFields id (LPat id))
183
184 hsConPatArgs :: HsConPatDetails id -> [LPat id]
185 hsConPatArgs (PrefixCon ps) = ps
186 hsConPatArgs (RecCon fs) = map (hsRecFieldArg . unLoc) (rec_flds fs)
187 hsConPatArgs (InfixCon p1 p2) = [p1,p2]
188
189 {-
190 However HsRecFields is used only for patterns and expressions
191 (not data type declarations)
192 -}
193
194 data HsRecFields id arg -- A bunch of record fields
195 -- { x = 3, y = True }
196 -- Used for both expressions and patterns
197 = HsRecFields { rec_flds :: [LHsRecField id arg],
198 rec_dotdot :: Maybe Int } -- Note [DotDot fields]
199 deriving (Data, Typeable)
200
201 -- Note [DotDot fields]
202 -- ~~~~~~~~~~~~~~~~~~~~
203 -- The rec_dotdot field means this:
204 -- Nothing => the normal case
205 -- Just n => the group uses ".." notation,
206 --
207 -- In the latter case:
208 --
209 -- *before* renamer: rec_flds are exactly the n user-written fields
210 --
211 -- *after* renamer: rec_flds includes *all* fields, with
212 -- the first 'n' being the user-written ones
213 -- and the remainder being 'filled in' implicitly
214
215 type LHsRecField id arg = Located (HsRecField id arg)
216 -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnEqual',
217 data HsRecField id arg = HsRecField {
218 hsRecFieldId :: Located id,
219 hsRecFieldArg :: arg, -- Filled in by renamer
220 hsRecPun :: Bool -- Note [Punning]
221 } deriving (Data, Typeable)
222
223 -- Note [Punning]
224 -- ~~~~~~~~~~~~~~
225 -- If you write T { x, y = v+1 }, the HsRecFields will be
226 -- HsRecField x x True ...
227 -- HsRecField y (v+1) False ...
228 -- That is, for "punned" field x is expanded (in the renamer)
229 -- to x=x; but with a punning flag so we can detect it later
230 -- (e.g. when pretty printing)
231 --
232 -- If the original field was qualified, we un-qualify it, thus
233 -- T { A.x } means T { A.x = x }
234
235 hsRecFields :: HsRecFields id arg -> [id]
236 hsRecFields rbinds = map (unLoc . hsRecFieldId . unLoc) (rec_flds rbinds)
237
238 {-
239 ************************************************************************
240 * *
241 * Printing patterns
242 * *
243 ************************************************************************
244 -}
245
246 instance (OutputableBndr name) => Outputable (Pat name) where
247 ppr = pprPat
248
249 pprPatBndr :: OutputableBndr name => name -> SDoc
250 pprPatBndr var -- Print with type info if -dppr-debug is on
251 = getPprStyle $ \ sty ->
252 if debugStyle sty then
253 parens (pprBndr LambdaBind var) -- Could pass the site to pprPat
254 -- but is it worth it?
255 else
256 pprPrefixOcc var
257
258 pprParendLPat :: (OutputableBndr name) => LPat name -> SDoc
259 pprParendLPat (L _ p) = pprParendPat p
260
261 pprParendPat :: (OutputableBndr name) => Pat name -> SDoc
262 pprParendPat p | hsPatNeedsParens p = parens (pprPat p)
263 | otherwise = pprPat p
264
265 pprPat :: (OutputableBndr name) => Pat name -> SDoc
266 pprPat (VarPat var) = pprPatBndr var
267 pprPat (WildPat _) = char '_'
268 pprPat (LazyPat pat) = char '~' <> pprParendLPat pat
269 pprPat (BangPat pat) = char '!' <> pprParendLPat pat
270 pprPat (AsPat name pat) = hcat [pprPrefixOcc (unLoc name), char '@', pprParendLPat pat]
271 pprPat (ViewPat expr pat _) = hcat [pprLExpr expr, text " -> ", ppr pat]
272 pprPat (ParPat pat) = parens (ppr pat)
273 pprPat (ListPat pats _ _) = brackets (interpp'SP pats)
274 pprPat (PArrPat pats _) = paBrackets (interpp'SP pats)
275 pprPat (TuplePat pats bx _) = tupleParens (boxityNormalTupleSort bx) (interpp'SP pats)
276
277 pprPat (ConPatIn con details) = pprUserCon (unLoc con) details
278 pprPat (ConPatOut { pat_con = con, pat_tvs = tvs, pat_dicts = dicts,
279 pat_binds = binds, pat_args = details })
280 = getPprStyle $ \ sty -> -- Tiresome; in TcBinds.tcRhs we print out a
281 if debugStyle sty then -- typechecked Pat in an error message,
282 -- and we want to make sure it prints nicely
283 ppr con
284 <> braces (sep [ hsep (map pprPatBndr (tvs ++ dicts))
285 , ppr binds])
286 <+> pprConArgs details
287 else pprUserCon (unLoc con) details
288
289 pprPat (LitPat s) = ppr s
290 pprPat (NPat l Nothing _) = ppr l
291 pprPat (NPat l (Just _) _) = char '-' <> ppr l
292 pprPat (NPlusKPat n k _ _) = hcat [ppr n, char '+', ppr k]
293 pprPat (SplicePat splice) = pprUntypedSplice splice
294 pprPat (QuasiQuotePat qq) = ppr qq
295 pprPat (CoPat co pat _) = pprHsWrapper (ppr pat) co
296 pprPat (SigPatIn pat ty) = ppr pat <+> dcolon <+> ppr ty
297 pprPat (SigPatOut pat ty) = ppr pat <+> dcolon <+> ppr ty
298
299 pprUserCon :: (OutputableBndr con, OutputableBndr id) => con -> HsConPatDetails id -> SDoc
300 pprUserCon c (InfixCon p1 p2) = ppr p1 <+> pprInfixOcc c <+> ppr p2
301 pprUserCon c details = pprPrefixOcc c <+> pprConArgs details
302
303 pprConArgs :: OutputableBndr id => HsConPatDetails id -> SDoc
304 pprConArgs (PrefixCon pats) = sep (map pprParendLPat pats)
305 pprConArgs (InfixCon p1 p2) = sep [pprParendLPat p1, pprParendLPat p2]
306 pprConArgs (RecCon rpats) = ppr rpats
307
308 instance (OutputableBndr id, Outputable arg)
309 => Outputable (HsRecFields id arg) where
310 ppr (HsRecFields { rec_flds = flds, rec_dotdot = Nothing })
311 = braces (fsep (punctuate comma (map ppr flds)))
312 ppr (HsRecFields { rec_flds = flds, rec_dotdot = Just n })
313 = braces (fsep (punctuate comma (map ppr (take n flds) ++ [dotdot])))
314 where
315 dotdot = ptext (sLit "..") <+> ifPprDebug (ppr (drop n flds))
316
317 instance (OutputableBndr id, Outputable arg)
318 => Outputable (HsRecField id arg) where
319 ppr (HsRecField { hsRecFieldId = f, hsRecFieldArg = arg,
320 hsRecPun = pun })
321 = ppr f <+> (ppUnless pun $ equals <+> ppr arg)
322
323 {-
324 ************************************************************************
325 * *
326 * Building patterns
327 * *
328 ************************************************************************
329 -}
330
331 mkPrefixConPat :: DataCon -> [OutPat id] -> [Type] -> OutPat id
332 -- Make a vanilla Prefix constructor pattern
333 mkPrefixConPat dc pats tys
334 = noLoc $ ConPatOut { pat_con = noLoc (RealDataCon dc), pat_tvs = [], pat_dicts = [],
335 pat_binds = emptyTcEvBinds, pat_args = PrefixCon pats,
336 pat_arg_tys = tys, pat_wrap = idHsWrapper }
337
338 mkNilPat :: Type -> OutPat id
339 mkNilPat ty = mkPrefixConPat nilDataCon [] [ty]
340
341 mkCharLitPat :: String -> Char -> OutPat id
342 mkCharLitPat src c = mkPrefixConPat charDataCon
343 [noLoc $ LitPat (HsCharPrim src c)] []
344
345 {-
346 ************************************************************************
347 * *
348 * Predicates for checking things about pattern-lists in EquationInfo *
349 * *
350 ************************************************************************
351
352 \subsection[Pat-list-predicates]{Look for interesting things in patterns}
353
354 Unlike in the Wadler chapter, where patterns are either ``variables''
355 or ``constructors,'' here we distinguish between:
356 \begin{description}
357 \item[unfailable:]
358 Patterns that cannot fail to match: variables, wildcards, and lazy
359 patterns.
360
361 These are the irrefutable patterns; the two other categories
362 are refutable patterns.
363
364 \item[constructor:]
365 A non-literal constructor pattern (see next category).
366
367 \item[literal patterns:]
368 At least the numeric ones may be overloaded.
369 \end{description}
370
371 A pattern is in {\em exactly one} of the above three categories; `as'
372 patterns are treated specially, of course.
373
374 The 1.3 report defines what ``irrefutable'' and ``failure-free'' patterns are.
375 -}
376
377 isStrictLPat :: LPat id -> Bool
378 isStrictLPat (L _ (ParPat p)) = isStrictLPat p
379 isStrictLPat (L _ (BangPat {})) = True
380 isStrictLPat (L _ (TuplePat _ Unboxed _)) = True
381 isStrictLPat _ = False
382
383 isStrictHsBind :: HsBind id -> Bool
384 -- A pattern binding with an outermost bang or unboxed tuple must be matched strictly
385 -- Defined in this module because HsPat is above HsBinds in the import graph
386 isStrictHsBind (PatBind { pat_lhs = p }) = isStrictLPat p
387 isStrictHsBind _ = False
388
389 looksLazyPatBind :: HsBind id -> Bool
390 -- Returns True of anything *except*
391 -- a StrictHsBind (as above) or
392 -- a VarPat
393 -- In particular, returns True of a pattern binding with a compound pattern, like (I# x)
394 looksLazyPatBind (PatBind { pat_lhs = p }) = looksLazyLPat p
395 looksLazyPatBind _ = False
396
397 looksLazyLPat :: LPat id -> Bool
398 looksLazyLPat (L _ (ParPat p)) = looksLazyLPat p
399 looksLazyLPat (L _ (AsPat _ p)) = looksLazyLPat p
400 looksLazyLPat (L _ (BangPat {})) = False
401 looksLazyLPat (L _ (TuplePat _ Unboxed _)) = False
402 looksLazyLPat (L _ (VarPat {})) = False
403 looksLazyLPat (L _ (WildPat {})) = False
404 looksLazyLPat _ = True
405
406 isIrrefutableHsPat :: OutputableBndr id => LPat id -> Bool
407 -- (isIrrefutableHsPat p) is true if matching against p cannot fail,
408 -- in the sense of falling through to the next pattern.
409 -- (NB: this is not quite the same as the (silly) defn
410 -- in 3.17.2 of the Haskell 98 report.)
411 --
412 -- isIrrefutableHsPat returns False if it's in doubt; specifically
413 -- on a ConPatIn it doesn't know the size of the constructor family
414 -- But if it returns True, the pattern is definitely irrefutable
415 isIrrefutableHsPat pat
416 = go pat
417 where
418 go (L _ pat) = go1 pat
419
420 go1 (WildPat {}) = True
421 go1 (VarPat {}) = True
422 go1 (LazyPat {}) = True
423 go1 (BangPat pat) = go pat
424 go1 (CoPat _ pat _) = go1 pat
425 go1 (ParPat pat) = go pat
426 go1 (AsPat _ pat) = go pat
427 go1 (ViewPat _ pat _) = go pat
428 go1 (SigPatIn pat _) = go pat
429 go1 (SigPatOut pat _) = go pat
430 go1 (TuplePat pats _ _) = all go pats
431 go1 (ListPat {}) = False
432 go1 (PArrPat {}) = False -- ?
433
434 go1 (ConPatIn {}) = False -- Conservative
435 go1 (ConPatOut{ pat_con = L _ (RealDataCon con), pat_args = details })
436 = isJust (tyConSingleDataCon_maybe (dataConTyCon con))
437 -- NB: tyConSingleDataCon_maybe, *not* isProductTyCon, because
438 -- the latter is false of existentials. See Trac #4439
439 && all go (hsConPatArgs details)
440 go1 (ConPatOut{ pat_con = L _ (PatSynCon _pat) })
441 = False -- Conservative
442
443 go1 (LitPat {}) = False
444 go1 (NPat {}) = False
445 go1 (NPlusKPat {}) = False
446
447 -- Both should be gotten rid of by renamer before
448 -- isIrrefutablePat is called
449 go1 (SplicePat {}) = urk pat
450 go1 (QuasiQuotePat {}) = urk pat
451
452 urk pat = pprPanic "isIrrefutableHsPat:" (ppr pat)
453
454 hsPatNeedsParens :: Pat a -> Bool
455 hsPatNeedsParens (NPlusKPat {}) = True
456 hsPatNeedsParens (SplicePat {}) = False
457 hsPatNeedsParens (QuasiQuotePat {}) = True
458 hsPatNeedsParens (ConPatIn _ ds) = conPatNeedsParens ds
459 hsPatNeedsParens p@(ConPatOut {}) = conPatNeedsParens (pat_args p)
460 hsPatNeedsParens (SigPatIn {}) = True
461 hsPatNeedsParens (SigPatOut {}) = True
462 hsPatNeedsParens (ViewPat {}) = True
463 hsPatNeedsParens (CoPat {}) = True
464 hsPatNeedsParens (WildPat {}) = False
465 hsPatNeedsParens (VarPat {}) = False
466 hsPatNeedsParens (LazyPat {}) = False
467 hsPatNeedsParens (BangPat {}) = False
468 hsPatNeedsParens (ParPat {}) = False
469 hsPatNeedsParens (AsPat {}) = False
470 hsPatNeedsParens (TuplePat {}) = False
471 hsPatNeedsParens (ListPat {}) = False
472 hsPatNeedsParens (PArrPat {}) = False
473 hsPatNeedsParens (LitPat {}) = False
474 hsPatNeedsParens (NPat {}) = False
475
476 conPatNeedsParens :: HsConDetails a b -> Bool
477 conPatNeedsParens (PrefixCon args) = not (null args)
478 conPatNeedsParens (InfixCon {}) = True
479 conPatNeedsParens (RecCon {}) = True