HsPat.lhs 17.5 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

Ian Lynagh's avatar
Ian Lynagh committed
26
import {-# SOURCE #-} HsExpr            (SyntaxExpr, LHsExpr, pprLExpr)
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 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93
  | 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 ---------------
  | ListPat     [LPat id]               -- Syntactic list
                PostTcType              -- The type of the elements

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

95
  | ConPatOut {
Ian Lynagh's avatar
Ian Lynagh committed
96 97 98 99 100 101 102 103
        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
104
    }
105

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

Ian Lynagh's avatar
Ian Lynagh committed
113 114
        ------------ Quasiquoted patterns ---------------
        -- See Note [Quasi-quote overview] in TcSplice
115 116
  | QuasiQuotePat   (HsQuasiQuote id)

Ian Lynagh's avatar
Ian Lynagh committed
117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133
        ------------ 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 ---------------
134 135
  | 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
136 137 138 139 140 141 142 143 144 145 146

  | 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'
147
  deriving (Data, Typeable)
148 149
\end{code}

150
HsConDetails is use for patterns/expressions *and* for data type declarations
151 152

\begin{code}
153 154
data HsConDetails arg rec
  = PrefixCon [arg]             -- C p1 p2 p3
Ian Lynagh's avatar
Ian Lynagh committed
155 156
  | RecCon    rec               -- C { x = p1, y = p2 }
  | InfixCon  arg arg           -- p1 `C` p2
157
  deriving (Data, Typeable)
158 159 160 161 162 163 164 165 166 167 168 169 170

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

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

data HsRecField id arg = HsRecField {
Ian Lynagh's avatar
Ian Lynagh committed
193 194 195
        hsRecFieldId  :: Located id,
        hsRecFieldArg :: arg,           -- Filled in by renamer
        hsRecPun      :: Bool           -- Note [Punning]
196
  } deriving (Data, Typeable)
197 198 199 200

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

hsRecFields :: HsRecFields id arg -> [id]
hsRecFields rbinds = map (unLoc . hsRecFieldId) (rec_flds rbinds)
212 213 214
\end{code}

%************************************************************************
Ian Lynagh's avatar
Ian Lynagh committed
215 216 217
%*                                                                      *
%*              Printing patterns
%*                                                                      *
218
%************************************************************************
219

220
\begin{code}
221 222 223
instance (OutputableBndr name) => Outputable (Pat name) where
    ppr = pprPat

224
pprPatBndr :: OutputableBndr name => name -> SDoc
Ian Lynagh's avatar
Ian Lynagh committed
225
pprPatBndr var                  -- Print with type info if -dppr-debug is on
226 227
  = getPprStyle $ \ sty ->
    if debugStyle sty then
Ian Lynagh's avatar
Ian Lynagh committed
228 229
        parens (pprBndr LambdaBind var)         -- Could pass the site to pprPat
                                                -- but is it worth it?
230
    else
Ian Lynagh's avatar
Ian Lynagh committed
231
        ppr var
232

233 234 235 236
pprParendLPat :: (OutputableBndr name) => LPat name -> SDoc
pprParendLPat (L _ p) = pprParendPat p

pprParendPat :: (OutputableBndr name) => Pat name -> SDoc
237 238
pprParendPat p | hsPatNeedsParens p = parens (pprPat p)
               | otherwise          = pprPat p
239

240
pprPat :: (OutputableBndr name) => Pat name -> SDoc
Ian Lynagh's avatar
Ian Lynagh committed
241 242
pprPat (VarPat var)       = pprPatBndr var
pprPat (WildPat _)        = char '_'
243 244 245 246
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]
Ian Lynagh's avatar
Ian Lynagh committed
247
pprPat (ParPat pat)         = parens (ppr pat)
248
pprPat (ListPat pats _)     = brackets (interpp'SP pats)
249
pprPat (PArrPat pats _)     = paBrackets (interpp'SP pats)
batterseapower's avatar
batterseapower committed
250
pprPat (TuplePat pats bx _) = tupleParens (boxityNormalTupleSort bx) (interpp'SP pats)
251

252
pprPat (ConPatIn con details) = pprUserCon con details
Ian Lynagh's avatar
Ian Lynagh committed
253 254 255 256 257 258 259
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])
260
                <+> pprConArgs details
261
    else pprUserCon con details
262

Ian Lynagh's avatar
Ian Lynagh committed
263
pprPat (LitPat s)           = ppr s
264 265
pprPat (NPat l Nothing  _)  = ppr l
pprPat (NPat l (Just _) _)  = char '-' <> ppr l
266 267
pprPat (NPlusKPat n k _ _)  = hcat [ppr n, char '+', ppr k]
pprPat (QuasiQuotePat qq)   = ppr qq
Ian Lynagh's avatar
Ian Lynagh committed
268
pprPat (CoPat co pat _)     = pprHsWrapper (ppr pat) co
269 270
pprPat (SigPatIn pat ty)    = ppr pat <+> dcolon <+> ppr ty
pprPat (SigPatOut pat ty)   = ppr pat <+> dcolon <+> ppr ty
271

272
pprUserCon :: (Outputable con, OutputableBndr id) => con -> HsConPatDetails id -> SDoc
273 274
pprUserCon c (InfixCon p1 p2) = ppr p1 <+> ppr c <+> ppr p2
pprUserCon c details          = ppr c <+> pprConArgs details
275

276
pprConArgs ::  OutputableBndr id => HsConPatDetails id -> SDoc
277 278
pprConArgs (PrefixCon pats) = sep (map pprParendLPat pats)
pprConArgs (InfixCon p1 p2) = sep [pprParendLPat p1, pprParendLPat p2]
279 280 281 282 283
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
284
        = braces (fsep (punctuate comma (map ppr flds)))
285
  ppr (HsRecFields { rec_flds = flds, rec_dotdot = Just n })
Ian Lynagh's avatar
Ian Lynagh committed
286 287 288
        = braces (fsep (punctuate comma (map ppr (take n flds) ++ [dotdot])))
        where
          dotdot = ptext (sLit "..") <+> ifPprDebug (ppr (drop n flds))
289 290 291

instance (OutputableBndr id, Outputable arg)
      => Outputable (HsRecField id arg) where
Ian Lynagh's avatar
Ian Lynagh committed
292 293
  ppr (HsRecField { hsRecFieldId = f, hsRecFieldArg = arg,
                    hsRecPun = pun })
294
    = ppr f <+> (ppUnless pun $ equals <+> ppr arg)
295 296
\end{code}

297

298
%************************************************************************
Ian Lynagh's avatar
Ian Lynagh committed
299 300 301
%*                                                                      *
%*              Building patterns
%*                                                                      *
302
%************************************************************************
303

304 305 306
\begin{code}
mkPrefixConPat :: DataCon -> [OutPat id] -> Type -> OutPat id
-- Make a vanilla Prefix constructor pattern
Ian Lynagh's avatar
Ian Lynagh committed
307
mkPrefixConPat dc pats ty
308
  = noLoc $ ConPatOut { pat_con = noLoc dc, pat_tvs = [], pat_dicts = [],
Ian Lynagh's avatar
Ian Lynagh committed
309 310
                        pat_binds = emptyTcEvBinds, pat_args = PrefixCon pats,
                        pat_ty = ty }
311

312 313
mkNilPat :: Type -> OutPat id
mkNilPat ty = mkPrefixConPat nilDataCon [] ty
314

315 316
mkCharLitPat :: Char -> OutPat id
mkCharLitPat c = mkPrefixConPat charDataCon [noLoc $ LitPat (HsCharPrim c)] charTy
317 318
\end{code}

319

320
%************************************************************************
Ian Lynagh's avatar
Ian Lynagh committed
321 322 323
%*                                                                      *
%* Predicates for checking things about pattern-lists in EquationInfo   *
%*                                                                      *
324
%************************************************************************
325

326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347
\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.

348 349
The 1.3 report defines what ``irrefutable'' and ``failure-free'' patterns are.
\begin{code}
350 351 352 353
isBangLPat :: LPat id -> Bool
isBangLPat (L _ (BangPat {})) = True
isBangLPat (L _ (ParPat p))   = isBangLPat p
isBangLPat _                  = False
354

simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
355
isBangHsBind :: HsBind id -> Bool
356 357
-- A pattern binding with an outermost bang
-- Defined in this module because HsPat is above HsBinds in the import graph
358 359
isBangHsBind (PatBind { pat_lhs = p }) = isBangLPat p
isBangHsBind _                         = False
simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
360

361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378
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

379
isIrrefutableHsPat :: OutputableBndr id => LPat id -> Bool
380 381
-- (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
382 383 384
--      (NB: this is not quite the same as the (silly) defn
--      in 3.17.2 of the Haskell 98 report.)
--
385
-- isIrrefutableHsPat returns False if it's in doubt; specifically
386
-- on a ConPatIn it doesn't know the size of the constructor family
387 388 389 390
-- But if it returns True, the pattern is definitely irrefutable
isIrrefutableHsPat pat
  = go pat
  where
391
    go (L _ pat) = go1 pat
392

393 394 395
    go1 (WildPat {})        = True
    go1 (VarPat {})         = True
    go1 (LazyPat {})        = True
simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
396
    go1 (BangPat pat)       = go pat
397
    go1 (CoPat _ pat _)     = go1 pat
398 399
    go1 (ParPat pat)        = go pat
    go1 (AsPat _ pat)       = go pat
400
    go1 (ViewPat _ pat _)   = go pat
401 402 403
    go1 (SigPatIn pat _)    = go pat
    go1 (SigPatOut pat _)   = go pat
    go1 (TuplePat pats _ _) = all go pats
404
    go1 (ListPat {})        = False
Ian Lynagh's avatar
Ian Lynagh committed
405
    go1 (PArrPat {})        = False     -- ?
406

Ian Lynagh's avatar
Ian Lynagh committed
407 408 409 410 411 412
    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)
413

414 415 416
    go1 (LitPat {})    = False
    go1 (NPat {})      = False
    go1 (NPlusKPat {}) = False
417

Ian Lynagh's avatar
Ian Lynagh committed
418 419
    go1 (QuasiQuotePat {}) = urk pat    -- Gotten rid of by renamer, before
                                        -- isIrrefutablePat is called
420 421

    urk pat = pprPanic "isIrrefutableHsPat:" (ppr pat)
422 423

hsPatNeedsParens :: Pat a -> Bool
424 425 426 427 428 429 430 431
hsPatNeedsParens (NPlusKPat {})      = True
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
432 433 434 435 436 437 438 439
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
440 441 442
hsPatNeedsParens (PArrPat {})        = False
hsPatNeedsParens (LitPat {})         = False
hsPatNeedsParens (NPat {})           = False
443 444 445

conPatNeedsParens :: HsConDetails a b -> Bool
conPatNeedsParens (PrefixCon args) = not (null args)
446 447
conPatNeedsParens (InfixCon {})    = True
conPatNeedsParens (RecCon {})      = True
448 449
\end{code}