HsPat.lhs 18.1 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
{-# LANGUAGE DeriveDataTypeable #-}
9

10
module HsPat (
Ian Lynagh's avatar
Ian Lynagh committed
11
        Pat(..), InPat, OutPat, LPat,
12

Ian Lynagh's avatar
Ian Lynagh committed
13 14 15 16 17
        HsConDetails(..),
        HsConPatDetails, hsConPatArgs,
        HsRecFields(..), HsRecField(..), hsRecFields,

        mkPrefixConPat, mkCharLitPat, mkNilPat,
18

19 20
        isBangHsBind, isLiftedPatBind,
        isBangLPat, hsPatNeedsParens,
21
        isIrrefutableHsPat,
22

Ian Lynagh's avatar
Ian Lynagh committed
23
        pprParendLPat
24 25
    ) where

26
import {-# SOURCE #-} HsExpr            (SyntaxExpr, LHsExpr, HsSplice, pprLExpr, pprUntypedSplice)
sof's avatar
sof committed
27

28
-- friends:
29 30 31
import HsBinds
import HsLit
import HsTypes
32
import TcEvidence
33
import BasicTypes
34
-- others:
Ian Lynagh's avatar
Ian Lynagh committed
35
import PprCore          ( {- instance OutputableBndr TyVar -} )
36 37 38 39
import TysWiredIn
import Var
import DataCon
import TyCon
Ian Lynagh's avatar
Ian Lynagh committed
40
import Outputable
41 42
import Type
import SrcLoc
43
import FastString
44 45
-- libraries:
import Data.Data hiding (TyCon)
46
import Data.Maybe
47 48
\end{code}

49

50
\begin{code}
Ian Lynagh's avatar
Ian Lynagh committed
51 52
type InPat id  = LPat id        -- No 'Out' constructors
type OutPat id = LPat id        -- No 'In' constructors
53 54

type LPat id = Located (Pat id)
55 56

data Pat id
Ian Lynagh's avatar
Ian Lynagh committed
57 58 59 60
  =     ------------ Simple patterns ---------------
    WildPat     PostTcType              -- Wild card
        -- The sole reason for a type on a WildPat is to
        -- support hsPatType :: Pat Id -> Type
61

Ian Lynagh's avatar
Ian Lynagh committed
62
  | VarPat      id                      -- Variable
63
  | LazyPat     (LPat id)               -- Lazy pattern
Ian Lynagh's avatar
Ian Lynagh committed
64 65 66 67 68 69
  | AsPat       (Located id) (LPat id)  -- As pattern
  | ParPat      (LPat id)               -- Parenthesised pattern
                                        -- See Note [Parens in HsSyn] in HsExpr
  | BangPat     (LPat id)               -- Bang pattern

        ------------ Lists, tuples, arrays ---------------
70 71 72 73 74 75
  | ListPat     [LPat id]                            -- Syntactic list
                PostTcType                           -- The type of the elements
                (Maybe (PostTcType, SyntaxExpr id))  -- For rebindable syntax
                   -- For OverloadedLists a Just (ty,fn) gives
                   -- overall type of the pattern, and the toList
                   -- function to convert the scrutinee to a list value
Ian Lynagh's avatar
Ian Lynagh committed
76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97

  | TuplePat    [LPat id]               -- Tuple
                Boxity                  -- UnitPat is TuplePat []
                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

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

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

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

Ian Lynagh's avatar
Ian Lynagh committed
110 111
        ------------ View patterns ---------------
  | ViewPat       (LHsExpr id)
112 113 114 115 116
                  (LPat id)
                  PostTcType        -- The overall type of the pattern
                                    -- (= the argument type of the view function)
                                    -- for hsPatType.

gmainland's avatar
gmainland committed
117 118 119
        ------------ Pattern splices ---------------
  | SplicePat       (HsSplice id)

Ian Lynagh's avatar
Ian Lynagh committed
120 121
        ------------ Quasiquoted patterns ---------------
        -- See Note [Quasi-quote overview] in TcSplice
122 123
  | QuasiQuotePat   (HsQuasiQuote id)

Ian Lynagh's avatar
Ian Lynagh committed
124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140
        ------------ Literal and n+k patterns ---------------
  | LitPat          HsLit               -- Used for *non-overloaded* literal patterns:
                                        -- Int#, Char#, Int, Char, String, etc.

  | NPat                -- Used for all overloaded literals,
                        -- including overloaded strings with -XOverloadedStrings
                    (HsOverLit id)              -- ALWAYS positive
                    (Maybe (SyntaxExpr id))     -- Just (Name of 'negate') for negative
                                                -- patterns, Nothing otherwise
                    (SyntaxExpr id)             -- Equality checker, of type t->t->Bool

  | 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)

        ------------ Pattern type signatures ---------------
141 142
  | SigPatIn        (LPat id)                   -- Pattern with a type signature
                    (HsWithBndrs (LHsType id))  -- Signature can bind both kind and type vars
Ian Lynagh's avatar
Ian Lynagh committed
143 144 145 146 147 148 149 150 151 152 153

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

        ------------ Pattern coercions (translation only) ---------------
  | CoPat       HsWrapper               -- If co :: t1 ~ t2, p :: t2,
                                        -- then (CoPat co p) :: t1
                (Pat id)                -- Why not LPat?  Ans: existing locn will do
                Type                    -- Type of whole pattern, t1
        -- During desugaring a (CoPat co pat) turns into a cast with 'co' on
        -- the scrutinee, followed by a match on 'pat'
154
  deriving (Data, Typeable)
155 156
\end{code}

157
HsConDetails is use for patterns/expressions *and* for data type declarations
158 159

\begin{code}
160 161
data HsConDetails arg rec
  = PrefixCon [arg]             -- C p1 p2 p3
Ian Lynagh's avatar
Ian Lynagh committed
162 163
  | RecCon    rec               -- C { x = p1, y = p2 }
  | InfixCon  arg arg           -- p1 `C` p2
164
  deriving (Data, Typeable)
165 166 167 168 169 170 171 172 173 174 175 176 177

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}
Ian Lynagh's avatar
Ian Lynagh committed
178 179 180
data HsRecFields id arg         -- A bunch of record fields
                                --      { x = 3, y = True }
        -- Used for both expressions and patterns
181
  = HsRecFields { rec_flds   :: [HsRecField id arg],
Ian Lynagh's avatar
Ian Lynagh committed
182
                  rec_dotdot :: Maybe Int }  -- Note [DotDot fields]
183
  deriving (Data, Typeable)
184 185 186 187 188

-- Note [DotDot fields]
-- ~~~~~~~~~~~~~~~~~~~~
-- The rec_dotdot field means this:
--   Nothing => the normal case
Ian Lynagh's avatar
Ian Lynagh committed
189
--   Just n  => the group uses ".." notation,
190
--
Ian Lynagh's avatar
Ian Lynagh committed
191
-- In the latter case:
192 193 194
--
--   *before* renamer: rec_flds are exactly the n user-written fields
--
Ian Lynagh's avatar
Ian Lynagh committed
195 196 197
--   *after* renamer:  rec_flds includes *all* fields, with
--                     the first 'n' being the user-written ones
--                     and the remainder being 'filled in' implicitly
198 199

data HsRecField id arg = HsRecField {
Ian Lynagh's avatar
Ian Lynagh committed
200 201 202
        hsRecFieldId  :: Located id,
        hsRecFieldArg :: arg,           -- Filled in by renamer
        hsRecPun      :: Bool           -- Note [Punning]
203
  } deriving (Data, Typeable)
204 205 206 207

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

hsRecFields :: HsRecFields id arg -> [id]
hsRecFields rbinds = map (unLoc . hsRecFieldId) (rec_flds rbinds)
219 220 221
\end{code}

%************************************************************************
Ian Lynagh's avatar
Ian Lynagh committed
222 223 224
%*                                                                      *
%*              Printing patterns
%*                                                                      *
225
%************************************************************************
226

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

231
pprPatBndr :: OutputableBndr name => name -> SDoc
Ian Lynagh's avatar
Ian Lynagh committed
232
pprPatBndr var                  -- Print with type info if -dppr-debug is on
233 234
  = getPprStyle $ \ sty ->
    if debugStyle sty then
Ian Lynagh's avatar
Ian Lynagh committed
235 236
        parens (pprBndr LambdaBind var)         -- Could pass the site to pprPat
                                                -- but is it worth it?
237
    else
238
        pprPrefixOcc var
239

240 241 242 243
pprParendLPat :: (OutputableBndr name) => LPat name -> SDoc
pprParendLPat (L _ p) = pprParendPat p

pprParendPat :: (OutputableBndr name) => Pat name -> SDoc
244 245
pprParendPat p | hsPatNeedsParens p = parens (pprPat p)
               | otherwise          = pprPat p
246

247
pprPat :: (OutputableBndr name) => Pat name -> SDoc
Ian Lynagh's avatar
Ian Lynagh committed
248 249
pprPat (VarPat var)       = pprPatBndr var
pprPat (WildPat _)        = char '_'
250 251
pprPat (LazyPat pat)      = char '~' <> pprParendLPat pat
pprPat (BangPat pat)      = char '!' <> pprParendLPat pat
252
pprPat (AsPat name pat)   = hcat [pprPrefixOcc (unLoc name), char '@', pprParendLPat pat]
253
pprPat (ViewPat expr pat _) = hcat [pprLExpr expr, text " -> ", ppr pat]
Ian Lynagh's avatar
Ian Lynagh committed
254
pprPat (ParPat pat)         = parens (ppr pat)
255
pprPat (ListPat pats _ _)     = brackets (interpp'SP pats)
256
pprPat (PArrPat pats _)     = paBrackets (interpp'SP pats)
batterseapower's avatar
batterseapower committed
257
pprPat (TuplePat pats bx _) = tupleParens (boxityNormalTupleSort bx) (interpp'SP pats)
258

259
pprPat (ConPatIn con details) = pprUserCon (unLoc con) details
Ian Lynagh's avatar
Ian Lynagh committed
260 261 262 263 264 265 266
pprPat (ConPatOut { pat_con = con, pat_tvs = tvs, pat_dicts = dicts,
                    pat_binds = binds, pat_args = details })
  = 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 <> braces (sep [ hsep (map pprPatBndr (tvs ++ dicts))
                               , ppr binds])
267
                <+> pprConArgs details
268
    else pprUserCon (unLoc con) details
269

Ian Lynagh's avatar
Ian Lynagh committed
270
pprPat (LitPat s)           = ppr s
271 272
pprPat (NPat l Nothing  _)  = ppr l
pprPat (NPat l (Just _) _)  = char '-' <> ppr l
273
pprPat (NPlusKPat n k _ _)  = hcat [ppr n, char '+', ppr k]
274
pprPat (SplicePat splice)   = pprUntypedSplice splice
275
pprPat (QuasiQuotePat qq)   = ppr qq
Ian Lynagh's avatar
Ian Lynagh committed
276
pprPat (CoPat co pat _)     = pprHsWrapper (ppr pat) co
277 278
pprPat (SigPatIn pat ty)    = ppr pat <+> dcolon <+> ppr ty
pprPat (SigPatOut pat ty)   = ppr pat <+> dcolon <+> ppr ty
279

280 281 282
pprUserCon :: (OutputableBndr con, OutputableBndr id) => con -> HsConPatDetails id -> SDoc
pprUserCon c (InfixCon p1 p2) = ppr p1 <+> pprInfixOcc c <+> ppr p2
pprUserCon c details          = pprPrefixOcc c <+> pprConArgs details
283

284
pprConArgs ::  OutputableBndr id => HsConPatDetails id -> SDoc
285 286
pprConArgs (PrefixCon pats) = sep (map pprParendLPat pats)
pprConArgs (InfixCon p1 p2) = sep [pprParendLPat p1, pprParendLPat p2]
287 288 289 290 291
pprConArgs (RecCon rpats)   = ppr rpats

instance (OutputableBndr id, Outputable arg)
      => Outputable (HsRecFields id arg) where
  ppr (HsRecFields { rec_flds = flds, rec_dotdot = Nothing })
Ian Lynagh's avatar
Ian Lynagh committed
292
        = braces (fsep (punctuate comma (map ppr flds)))
293
  ppr (HsRecFields { rec_flds = flds, rec_dotdot = Just n })
Ian Lynagh's avatar
Ian Lynagh committed
294 295 296
        = braces (fsep (punctuate comma (map ppr (take n flds) ++ [dotdot])))
        where
          dotdot = ptext (sLit "..") <+> ifPprDebug (ppr (drop n flds))
297 298 299

instance (OutputableBndr id, Outputable arg)
      => Outputable (HsRecField id arg) where
Ian Lynagh's avatar
Ian Lynagh committed
300 301
  ppr (HsRecField { hsRecFieldId = f, hsRecFieldArg = arg,
                    hsRecPun = pun })
302
    = ppr f <+> (ppUnless pun $ equals <+> ppr arg)
303 304
\end{code}

305

306
%************************************************************************
Ian Lynagh's avatar
Ian Lynagh committed
307 308 309
%*                                                                      *
%*              Building patterns
%*                                                                      *
310
%************************************************************************
311

312 313 314
\begin{code}
mkPrefixConPat :: DataCon -> [OutPat id] -> Type -> OutPat id
-- Make a vanilla Prefix constructor pattern
Ian Lynagh's avatar
Ian Lynagh committed
315
mkPrefixConPat dc pats ty
316
  = noLoc $ ConPatOut { pat_con = noLoc dc, pat_tvs = [], pat_dicts = [],
Ian Lynagh's avatar
Ian Lynagh committed
317 318
                        pat_binds = emptyTcEvBinds, pat_args = PrefixCon pats,
                        pat_ty = ty }
319

320 321
mkNilPat :: Type -> OutPat id
mkNilPat ty = mkPrefixConPat nilDataCon [] ty
322

323 324
mkCharLitPat :: Char -> OutPat id
mkCharLitPat c = mkPrefixConPat charDataCon [noLoc $ LitPat (HsCharPrim c)] charTy
325 326
\end{code}

327

328
%************************************************************************
Ian Lynagh's avatar
Ian Lynagh committed
329 330 331
%*                                                                      *
%* Predicates for checking things about pattern-lists in EquationInfo   *
%*                                                                      *
332
%************************************************************************
333

334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355
\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.

356 357
The 1.3 report defines what ``irrefutable'' and ``failure-free'' patterns are.
\begin{code}
358 359 360 361
isBangLPat :: LPat id -> Bool
isBangLPat (L _ (BangPat {})) = True
isBangLPat (L _ (ParPat p))   = isBangLPat p
isBangLPat _                  = False
362

simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
363
isBangHsBind :: HsBind id -> Bool
364 365
-- A pattern binding with an outermost bang
-- Defined in this module because HsPat is above HsBinds in the import graph
366 367
isBangHsBind (PatBind { pat_lhs = p }) = isBangLPat p
isBangHsBind _                         = False
simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
368

369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386
isLiftedPatBind :: HsBind id -> Bool
-- A pattern binding with a compound pattern, not just a variable
--    (I# x)       yes
--    (# a, b #)   no, even if a::Int#
--    x            no, even if x::Int#
-- We want to warn about a missing bang-pattern on the yes's
isLiftedPatBind (PatBind { pat_lhs = p }) = isLiftedLPat p
isLiftedPatBind _                         = False

isLiftedLPat :: LPat id -> Bool
isLiftedLPat (L _ (ParPat p))   = isLiftedLPat p
isLiftedLPat (L _ (BangPat p))  = isLiftedLPat p
isLiftedLPat (L _ (AsPat _ p))  = isLiftedLPat p
isLiftedLPat (L _ (TuplePat _ Unboxed _)) = False
isLiftedLPat (L _ (VarPat {}))            = False
isLiftedLPat (L _ (WildPat {}))           = False
isLiftedLPat _                            = True

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

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

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

422 423 424
    go1 (LitPat {})    = False
    go1 (NPat {})      = False
    go1 (NPlusKPat {}) = False
425

gmainland's avatar
gmainland committed
426 427 428 429
    -- Both should be gotten rid of by renamer before
    -- isIrrefutablePat is called
    go1 (SplicePat {})     = urk pat    
    go1 (QuasiQuotePat {}) = urk pat
430 431

    urk pat = pprPanic "isIrrefutableHsPat:" (ppr pat)
432 433

hsPatNeedsParens :: Pat a -> Bool
434
hsPatNeedsParens (NPlusKPat {})      = True
gmainland's avatar
gmainland committed
435
hsPatNeedsParens (SplicePat {})      = False
436 437 438 439 440 441 442
hsPatNeedsParens (QuasiQuotePat {})  = True
hsPatNeedsParens (ConPatIn _ ds)     = conPatNeedsParens ds
hsPatNeedsParens p@(ConPatOut {})    = conPatNeedsParens (pat_args p)
hsPatNeedsParens (SigPatIn {})       = True
hsPatNeedsParens (SigPatOut {})      = True
hsPatNeedsParens (ViewPat {})        = True
hsPatNeedsParens (CoPat {})          = True
443 444 445 446 447 448 449 450
hsPatNeedsParens (WildPat {})        = False
hsPatNeedsParens (VarPat {})         = False
hsPatNeedsParens (LazyPat {})        = False
hsPatNeedsParens (BangPat {})        = False
hsPatNeedsParens (ParPat {})         = False
hsPatNeedsParens (AsPat {})          = False
hsPatNeedsParens (TuplePat {})       = False
hsPatNeedsParens (ListPat {})        = False
Ian Lynagh's avatar
Ian Lynagh committed
451 452 453
hsPatNeedsParens (PArrPat {})        = False
hsPatNeedsParens (LitPat {})         = False
hsPatNeedsParens (NPat {})           = False
454 455 456

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