HsPat.lhs 16 KB
Newer Older
1
%
2
% (c) The University of Glasgow 2006
3
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4
5
6
7
%
\section[PatSyntax]{Abstract Haskell syntax---patterns}

\begin{code}
8
{-# OPTIONS -fno-warn-incomplete-patterns #-}
9
10
11
-- The above warning supression flag is a temporary kludge.
-- While working on this module you are encouraged to remove it and fix
-- any warnings in the module. See
Ian Lynagh's avatar
Ian Lynagh committed
12
--     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
13
-- for details
14
{-# LANGUAGE DeriveDataTypeable #-}
15

16
module HsPat (
17
	Pat(..), InPat, OutPat, LPat, 
18
	
19
20
21
	HsConDetails(..), 
	HsConPatDetails, hsConPatArgs, 
	HsRecFields(..), HsRecField(..), hsRecFields,
22

23
	mkPrefixConPat, mkCharLitPat, mkNilPat, 
24

25
26
	isBangHsBind, isBangLPat, hsPatNeedsParens,
	isIrrefutableHsPat,
27
28

	pprParendLPat
29
30
    ) where

31
import {-# SOURCE #-} HsExpr		(SyntaxExpr, LHsExpr, pprLExpr)
sof's avatar
sof committed
32

33
-- friends:
34
35
36
37
import HsBinds
import HsLit
import HsTypes
import BasicTypes
38
-- others:
39
import PprCore		( {- instance OutputableBndr TyVar -} )
40
41
42
43
import TysWiredIn
import Var
import DataCon
import TyCon
44
import Outputable	
45
46
import Type
import SrcLoc
47
import FastString
48
49
-- libraries:
import Data.Data hiding (TyCon)
50
import Data.Maybe
51
52
\end{code}

53

54
\begin{code}
55
56
57
58
type InPat id  = LPat id	-- No 'Out' constructors
type OutPat id = LPat id	-- No 'In' constructors

type LPat id = Located (Pat id)
59
60
61
62

data Pat id
  =	------------ Simple patterns ---------------
    WildPat	PostTcType		-- Wild card
63
64
65
	-- The sole reason for a type on a WildPat is to
	-- support hsPatType :: Pat Id -> Type

66
  | VarPat	id			-- Variable
67
  | VarPatOut	id TcEvBinds		-- Used only for overloaded Ids; the 
68
					-- bindings give its overloaded instances
69
70
71
  | LazyPat	(LPat id)		-- Lazy pattern
  | AsPat	(Located id) (LPat id)  -- As pattern
  | ParPat      (LPat id)		-- Parenthesised pattern
72
  | BangPat	(LPat id)		-- Bang pattern
73
74

	------------ Lists, tuples, arrays ---------------
75
  | ListPat	[LPat id]		-- Syntactic list
76
77
		PostTcType		-- The type of the elements
   	    	    
78
  | TuplePat	[LPat id]		-- Tuple
79
		Boxity			-- UnitPat is TuplePat []
80
81
82
83
84
85
86
87
88
89
90
91
		PostTcType
	-- You might think that the PostTcType was redundant, but it's essential
	--	data T a where
	--	  T1 :: Int -> T Int
	--	f :: (T a, a) -> Int
	--	f (T1 x, z) = z
	-- When desugaring, we must generate
	--	f = /\a. \v::a.  case v of (t::T a, w::a) ->
	--			 case t of (T1 (x::Int)) -> 
	-- Note the (w::a), NOT (w::Int), because we have not yet
	-- refined 'a' to Int.  So we must know that the second component
	-- of the tuple is of type 'a' not Int.  See selectMatchVar
92

93
  | PArrPat	[LPat id]		-- Syntactic parallel array
94
95
96
		PostTcType		-- The type of the elements

	------------ Constructor patterns ---------------
97
  | ConPatIn	(Located id)
98
		(HsConPatDetails id)
99

100
101
  | ConPatOut {
	pat_con   :: Located DataCon,
102
	pat_tvs   :: [TyVar],		-- Existentially bound type variables (tyvars only)
103
	pat_dicts :: [EvVar],		-- Ditto *coercion variables* and *dictionaries*
104
105
					-- One reason for putting coercion variable here, I think,
					-- 	is to ensure their kinds are zonked
106
	pat_binds :: TcEvBinds,		-- Bindings involving those dictionaries
107
	pat_args  :: HsConPatDetails id,
108
109
	pat_ty	  :: Type   		-- The type of the pattern
    }
110

111
112
113
114
115
116
117
	------------ View patterns ---------------
  | ViewPat       (LHsExpr id)      
                  (LPat id)
                  PostTcType        -- The overall type of the pattern
                                    -- (= the argument type of the view function)
                                    -- for hsPatType.

118
119
120
121
	------------ Quasiquoted patterns ---------------
	-- See Note [Quasi-quote overview] in TcSplice
  | QuasiQuotePat   (HsQuasiQuote id)

122
123
124
	------------ Literal and n+k patterns ---------------
  | LitPat	    HsLit		-- Used for *non-overloaded* literal patterns:
					-- Int#, Char#, Int, Char, String, etc.
125

126
  | NPat	    (HsOverLit id)		-- ALWAYS positive
127
128
129
		    (Maybe (SyntaxExpr id))	-- Just (Name of 'negate') for negative
						-- patterns, Nothing otherwise
		    (SyntaxExpr id)		-- Equality checker, of type t->t->Bool
130

131
132
133
134
  | NPlusKPat	    (Located id)	-- n+k pattern
		    (HsOverLit id)	-- It'll always be an HsIntegral
		    (SyntaxExpr id)	-- (>=) function, of type t->t->Bool
		    (SyntaxExpr id)	-- Name of '-' (see RnEnv.lookupSyntaxName)
135

136
	------------ Generics ---------------
137
  | TypePat	    (LHsType id)	-- Type pattern for generic definitions
138
                                        -- e.g  f{| a+b |} = ...
139
                                        -- These show up only in class declarations,
140
141
                                        -- and should be a top-level pattern

142
	------------ Pattern type signatures ---------------
143
144
  | SigPatIn	    (LPat id)		-- Pattern with a type signature
		    (LHsType id)
145

146
147
  | SigPatOut	    (LPat id)		-- Pattern with a type signature
		    Type
148

149
	------------ Pattern coercions (translation only) ---------------
150
  | CoPat 	HsWrapper		-- If co :: t1 ~ t2, p :: t2, 
151
					-- then (CoPat co p) :: t1
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
152
		(Pat id)		-- Why not LPat?  Ans: existing locn will do
153
	    	Type			-- Type of whole pattern, t1
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
154
155
	-- During desugaring a (CoPat co pat) turns into a cast with 'co' on 
	-- the scrutinee, followed by a match on 'pat'
156
  deriving (Data, Typeable)
157
158
\end{code}

159
HsConDetails is use for patterns/expressions *and* for data type declarations
160
161

\begin{code}
162
163
164
165
data HsConDetails arg rec
  = PrefixCon [arg]             -- C p1 p2 p3
  | RecCon    rec		-- C { x = p1, y = p2 }
  | InfixCon  arg arg		-- p1 `C` p2
166
  deriving (Data, Typeable)
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181

type HsConPatDetails id = HsConDetails (LPat id) (HsRecFields id (LPat id))

hsConPatArgs :: HsConPatDetails id -> [LPat id]
hsConPatArgs (PrefixCon ps)   = ps
hsConPatArgs (RecCon fs)      = map hsRecFieldArg (rec_flds fs)
hsConPatArgs (InfixCon p1 p2) = [p1,p2]
\end{code}

However HsRecFields is used only for patterns and expressions
(not data type declarations)

\begin{code}
data HsRecFields id arg 	-- A bunch of record fields
				--	{ x = 3, y = True }
182
	-- Used for both expressions and patterns
183
  = HsRecFields { rec_flds   :: [HsRecField id arg],
184
		  rec_dotdot :: Maybe Int }  -- Note [DotDot fields]
185
  deriving (Data, Typeable)
186
187
188
189
190
191
192
193
194
195
196
197
198
199

-- Note [DotDot fields]
-- ~~~~~~~~~~~~~~~~~~~~
-- The rec_dotdot field means this:
--   Nothing => the normal case
--   Just n  => the group uses ".." notation, 
--
-- In the latter case: 
--
--   *before* renamer: rec_flds are exactly the n user-written fields
--
--   *after* renamer:  rec_flds includes *all* fields, with 
--   	     	       the first 'n' being the user-written ones
--		       and the remainder being 'filled in' implicitly
200
201
202

data HsRecField id arg = HsRecField {
	hsRecFieldId  :: Located id,
203
	hsRecFieldArg :: arg,		-- Filled in by renamer
204
	hsRecPun      :: Bool 		-- Note [Punning]
205
  } deriving (Data, Typeable)
206
207
208
209
210
211

-- Note [Punning]
-- ~~~~~~~~~~~~~~
-- If you write T { x, y = v+1 }, the HsRecFields will be
--	HsRecField x x True ...
--	HsRecField y (v+1) False ...
212
213
-- That is, for "punned" field x is expanded (in the renamer) 
-- to x=x; but with a punning flag so we can detect it later
214
-- (e.g. when pretty printing)
215
216
217
--
-- If the original field was qualified, we un-qualify it, thus
--    T { A.x } means T { A.x = x }
218
219
220

hsRecFields :: HsRecFields id arg -> [id]
hsRecFields rbinds = map (unLoc . hsRecFieldId) (rec_flds rbinds)
221
222
223
224
225
226
227
\end{code}

%************************************************************************
%*									*
%* 		Printing patterns
%*									*
%************************************************************************
228

229
\begin{code}
230
231
232
instance (OutputableBndr name) => Outputable (Pat name) where
    ppr = pprPat

233
234
pprPatBndr :: OutputableBndr name => name -> SDoc
pprPatBndr var		  	-- Print with type info if -dppr-debug is on
235
236
237
238
239
240
  = getPprStyle $ \ sty ->
    if debugStyle sty then
	parens (pprBndr LambdaBind var)		-- Could pass the site to pprPat
						-- but is it worth it?
    else
	ppr var
241

242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
pprParendLPat :: (OutputableBndr name) => LPat name -> SDoc
pprParendLPat (L _ p) = pprParendPat p

pprParendPat :: (OutputableBndr name) => Pat name -> SDoc
pprParendPat p | patNeedsParens p = parens (pprPat p)
               | otherwise        = pprPat p

patNeedsParens :: Pat name -> Bool
patNeedsParens (ConPatIn _ d)               = not (null (hsConPatArgs d))
patNeedsParens (ConPatOut { pat_args = d }) = not (null (hsConPatArgs d))
patNeedsParens (SigPatIn {})  = True
patNeedsParens (SigPatOut {}) = True
patNeedsParens (ViewPat {})   = True
patNeedsParens (CoPat {})     = True
patNeedsParens _              = False

258
pprPat :: (OutputableBndr name) => Pat name -> SDoc
simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
259
pprPat (VarPat var)  	  = pprPatBndr var
260
pprPat (VarPatOut var bs) = pprPatBndr var <+> braces (ppr bs)
simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
261
pprPat (WildPat _)	  = char '_'
262
263
264
265
pprPat (LazyPat pat)      = char '~' <> pprParendLPat pat
pprPat (BangPat pat)      = char '!' <> pprParendLPat pat
pprPat (AsPat name pat)   = hcat [ppr name, char '@', pprParendLPat pat]
pprPat (ViewPat expr pat _) = hcat [pprLExpr expr, text " -> ", ppr pat]
266
pprPat (ParPat pat)	    = parens (ppr pat)
267
268
269
pprPat (ListPat pats _)     = brackets (interpp'SP pats)
pprPat (PArrPat pats _)     = pabrackets (interpp'SP pats)
pprPat (TuplePat pats bx _) = tupleParens bx (interpp'SP pats)
270

271
pprPat (ConPatIn con details) = pprUserCon con details
272
273
pprPat (ConPatOut { pat_con = con, pat_tvs = tvs, pat_dicts = dicts, 
		    pat_binds = binds, pat_args = details })
274
275
276
277
  = getPprStyle $ \ sty ->	-- Tiresome; in TcBinds.tcRhs we print out a 
    if debugStyle sty then 	-- typechecked Pat in an error message, 
				-- and we want to make sure it prints nicely
	ppr con <+> sep [ hsep (map pprPatBndr tvs) <+> hsep (map pprPatBndr dicts),
278
		   	  ppr binds, pprConArgs details]
279
    else pprUserCon con details
280

281
pprPat (LitPat s)	    = ppr s
282
283
pprPat (NPat l Nothing  _)  = ppr l
pprPat (NPat l (Just _) _)  = char '-' <> ppr l
284
285
286
287
288
289
pprPat (NPlusKPat n k _ _)  = hcat [ppr n, char '+', ppr k]
pprPat (QuasiQuotePat qq)   = ppr qq
pprPat (TypePat ty)	    = ptext (sLit "{|") <> ppr ty <> ptext (sLit "|}")
pprPat (CoPat co pat _)	    = pprHsWrapper (ppr pat) co
pprPat (SigPatIn pat ty)    = ppr pat <+> dcolon <+> ppr ty
pprPat (SigPatOut pat ty)   = ppr pat <+> dcolon <+> ppr ty
290

291
pprUserCon :: (Outputable con, OutputableBndr id) => con -> HsConPatDetails id -> SDoc
292
293
pprUserCon c (InfixCon p1 p2) = ppr p1 <+> ppr c <+> ppr p2
pprUserCon c details          = ppr c <+> pprConArgs details
294

295
pprConArgs ::  OutputableBndr id => HsConPatDetails id -> SDoc
296
297
pprConArgs (PrefixCon pats) = sep (map pprParendLPat pats)
pprConArgs (InfixCon p1 p2) = sep [pprParendLPat p1, pprParendLPat p2]
298
299
300
301
302
303
304
305
306
pprConArgs (RecCon rpats)   = ppr rpats

instance (OutputableBndr id, Outputable arg)
      => Outputable (HsRecFields id arg) where
  ppr (HsRecFields { rec_flds = flds, rec_dotdot = Nothing })
	= braces (fsep (punctuate comma (map ppr flds)))
  ppr (HsRecFields { rec_flds = flds, rec_dotdot = Just n })
	= braces (fsep (punctuate comma (map ppr (take n flds) ++ [dotdot])))
	where
Ian Lynagh's avatar
Ian Lynagh committed
307
	  dotdot = ptext (sLit "..") <+> ifPprDebug (ppr (drop n flds))
308
309
310
311
312

instance (OutputableBndr id, Outputable arg)
      => Outputable (HsRecField id arg) where
  ppr (HsRecField { hsRecFieldId = f, hsRecFieldArg = arg, 
		    hsRecPun = pun })
313
    = ppr f <+> (ppUnless pun $ equals <+> ppr arg)
chak's avatar
chak committed
314
315
316
317

-- add parallel array brackets around a document
--
pabrackets   :: SDoc -> SDoc
Ian Lynagh's avatar
Ian Lynagh committed
318
pabrackets p  = ptext (sLit "[:") <> p <> ptext (sLit ":]")
319
320
\end{code}

321

322
323
324
325
326
%************************************************************************
%*									*
%* 		Building patterns
%*									*
%************************************************************************
327

328
329
330
\begin{code}
mkPrefixConPat :: DataCon -> [OutPat id] -> Type -> OutPat id
-- Make a vanilla Prefix constructor pattern
331
332
mkPrefixConPat dc pats ty 
  = noLoc $ ConPatOut { pat_con = noLoc dc, pat_tvs = [], pat_dicts = [],
333
			pat_binds = emptyTcEvBinds, pat_args = PrefixCon pats, 
334
			pat_ty = ty }
335

336
337
mkNilPat :: Type -> OutPat id
mkNilPat ty = mkPrefixConPat nilDataCon [] ty
338

339
340
mkCharLitPat :: Char -> OutPat id
mkCharLitPat c = mkPrefixConPat charDataCon [noLoc $ LitPat (HsCharPrim c)] charTy
341
342
\end{code}

343

344
345
%************************************************************************
%*									*
346
%* Predicates for checking things about pattern-lists in EquationInfo	*
347
348
%*									*
%************************************************************************
349

350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
\subsection[Pat-list-predicates]{Look for interesting things in patterns}

Unlike in the Wadler chapter, where patterns are either ``variables''
or ``constructors,'' here we distinguish between:
\begin{description}
\item[unfailable:]
Patterns that cannot fail to match: variables, wildcards, and lazy
patterns.

These are the irrefutable patterns; the two other categories
are refutable patterns.

\item[constructor:]
A non-literal constructor pattern (see next category).

\item[literal patterns:]
At least the numeric ones may be overloaded.
\end{description}

A pattern is in {\em exactly one} of the above three categories; `as'
patterns are treated specially, of course.

372
373
The 1.3 report defines what ``irrefutable'' and ``failure-free'' patterns are.
\begin{code}
374
375
376
377
isBangLPat :: LPat id -> Bool
isBangLPat (L _ (BangPat {})) = True
isBangLPat (L _ (ParPat p))   = isBangLPat p
isBangLPat _                  = False
378

simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
379
380
isBangHsBind :: HsBind id -> Bool
-- In this module because HsPat is above HsBinds in the import graph
381
382
isBangHsBind (PatBind { pat_lhs = p }) = isBangLPat p
isBangHsBind _                         = False
simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
383

384
isIrrefutableHsPat :: OutputableBndr id => LPat id -> Bool
385
386
387
388
389
390
-- (isIrrefutableHsPat p) is true if matching against p cannot fail,
-- in the sense of falling through to the next pattern.
--	(NB: this is not quite the same as the (silly) defn
--	in 3.17.2 of the Haskell 98 report.)
-- 
-- isIrrefutableHsPat returns False if it's in doubt; specifically
391
-- on a ConPatIn it doesn't know the size of the constructor family
392
393
394
395
-- But if it returns True, the pattern is definitely irrefutable
isIrrefutableHsPat pat
  = go pat
  where
396
    go (L _ pat) = go1 pat
397

398
399
400
401
    go1 (WildPat {})        = True
    go1 (VarPat {})         = True
    go1 (VarPatOut {})      = True
    go1 (LazyPat {})        = True
simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
402
    go1 (BangPat pat)       = go pat
403
    go1 (CoPat _ pat _)     = go1 pat
404
405
    go1 (ParPat pat)        = go pat
    go1 (AsPat _ pat)       = go pat
406
    go1 (ViewPat _ pat _)   = go pat
407
408
409
    go1 (SigPatIn pat _)    = go pat
    go1 (SigPatOut pat _)   = go pat
    go1 (TuplePat pats _ _) = all go pats
410
411
    go1 (ListPat {})        = False
    go1 (PArrPat {})        = False	-- ?
412

413
    go1 (ConPatIn {})       = False	-- Conservative
414
    go1 (ConPatOut{ pat_con = L _ con, pat_args = details }) 
415
416
417
	=  isJust (tyConSingleDataCon_maybe (dataConTyCon con))
	   -- NB: tyConSingleDataCon_maybe, *not* isProductTyCon, because 
	   -- the latter is false of existentials. See Trac #4439
418
	&& all go (hsConPatArgs details)
419

420
421
422
    go1 (LitPat {})    = False
    go1 (NPat {})      = False
    go1 (NPlusKPat {}) = False
423

424
425
426
427
428
    go1 (QuasiQuotePat {}) = urk pat	-- Gotten rid of by renamer, before
					-- isIrrefutablePat is called
    go1 (TypePat {})       = urk pat

    urk pat = pprPanic "isIrrefutableHsPat:" (ppr pat)
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456

hsPatNeedsParens :: Pat a -> Bool
hsPatNeedsParens (WildPat {})        = False
hsPatNeedsParens (VarPat {})         = False
hsPatNeedsParens (VarPatOut {})      = True
hsPatNeedsParens (LazyPat {})        = False
hsPatNeedsParens (BangPat {})        = False
hsPatNeedsParens (CoPat {})          = True
hsPatNeedsParens (ParPat {})         = False
hsPatNeedsParens (AsPat {})          = False
hsPatNeedsParens (ViewPat {})        = True
hsPatNeedsParens (SigPatIn {})       = True
hsPatNeedsParens (SigPatOut {})      = True
hsPatNeedsParens (TuplePat {})       = False
hsPatNeedsParens (ListPat {})        = False
hsPatNeedsParens (PArrPat {})        = False	
hsPatNeedsParens (ConPatIn _ ds)     = conPatNeedsParens ds
hsPatNeedsParens (ConPatOut {})      = True
hsPatNeedsParens (LitPat {})   	     = False
hsPatNeedsParens (NPat {})	     = False
hsPatNeedsParens (NPlusKPat {})      = True
hsPatNeedsParens (QuasiQuotePat {})  = True
hsPatNeedsParens (TypePat {})        = False

conPatNeedsParens :: HsConDetails a b -> Bool
conPatNeedsParens (PrefixCon args) = not (null args)
conPatNeedsParens (InfixCon {})    = False
conPatNeedsParens (RecCon {})      = False
457
458
\end{code}