Revert "ci trigger"
[ghc.git] / compiler / deSugar / MatchLit.hs
1 {-
2 (c) The University of Glasgow 2006
3 (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4
5
6 Pattern-matching literal patterns
7 -}
8
9 {-# LANGUAGE CPP, ScopedTypeVariables #-}
10 {-# LANGUAGE ViewPatterns #-}
11
12 module MatchLit ( dsLit, dsOverLit, hsLitKey
13 , tidyLitPat, tidyNPat
14 , matchLiterals, matchNPlusKPats, matchNPats
15 , warnAboutIdentities
16 , warnAboutOverflowedOverLit, warnAboutOverflowedLit
17 , warnAboutEmptyEnumerations
18 ) where
19
20 #include "HsVersions.h"
21
22 import GhcPrelude
23
24 import {-# SOURCE #-} Match ( match )
25 import {-# SOURCE #-} DsExpr ( dsExpr, dsSyntaxExpr )
26
27 import DsMonad
28 import DsUtils
29
30 import HsSyn
31
32 import Id
33 import CoreSyn
34 import MkCore
35 import TyCon
36 import DataCon
37 import TcHsSyn ( shortCutLit )
38 import TcType
39 import Name
40 import Type
41 import PrelNames
42 import TysWiredIn
43 import TysPrim
44 import Literal
45 import SrcLoc
46 import Outputable
47 import BasicTypes
48 import DynFlags
49 import Util
50 import FastString
51 import qualified GHC.LanguageExtensions as LangExt
52 import GHC.Real hiding (FractionalExponentBase(..))
53
54 import Control.Monad
55 import Data.Int
56 import Data.Word
57 import Data.Proxy
58
59 {-
60 ************************************************************************
61 * *
62 Desugaring literals
63 [used to be in DsExpr, but DsMeta needs it,
64 and it's nice to avoid a loop]
65 * *
66 ************************************************************************
67
68 We give int/float literals type @Integer@ and @Rational@, respectively.
69 The typechecker will (presumably) have put \tr{from{Integer,Rational}s}
70 around them.
71
72 ToDo: put in range checks for when converting ``@i@''
73 (or should that be in the typechecker?)
74
75 For numeric literals, we try to detect there use at a standard type
76 (@Int@, @Float@, etc.) are directly put in the right constructor.
77 [NB: down with the @App@ conversion.]
78
79 See also below where we look for @DictApps@ for \tr{plusInt}, etc.
80 -}
81
82 dsLit :: HsLit GhcRn -> DsM CoreExpr
83 dsLit l = do
84 dflags <- getDynFlags
85 case l of
86 HsStringPrim _ s -> return (Lit (LitString s))
87 HsCharPrim _ c -> return (Lit (LitChar c))
88 HsIntPrim _ i -> return (Lit (mkLitIntWrap dflags i))
89 HsWordPrim _ w -> return (Lit (mkLitWordWrap dflags w))
90 HsInt64Prim _ i -> return (Lit (mkLitInt64Wrap dflags i))
91 HsWord64Prim _ w -> return (Lit (mkLitWord64Wrap dflags w))
92 HsFloatPrim _ fl -> return (Lit (LitFloat (rationalFromFractionalLit fl)))
93 HsDoublePrim _ fl -> return (Lit (LitDouble (rationalFromFractionalLit fl)))
94 HsChar _ c -> return (mkCharExpr c)
95 HsString _ str -> mkStringExprFS str
96 HsInteger _ i _ -> mkIntegerExpr i
97 HsInt _ i -> return (mkIntExpr dflags (il_value i))
98 HsRat _ fl _ -> dsFractionalLitToRational fl
99 XLit x -> pprPanic "dsLit" (ppr x)
100
101 dsFractionalLitToRational :: FractionalLit -> DsM CoreExpr
102 dsFractionalLitToRational fl =
103 case fl of
104 FL { fl_signi = fl_signi, fl_exp = fl_exp, fl_exp_base = feb } -> do
105 let mkRationalName = case feb of
106 Base2 -> mkRationalBase2Name
107 Base10 -> mkRationalBase10Name
108 mkRational <- dsLookupGlobalId mkRationalName
109 litR <- dsRational fl_signi
110 litE <- mkIntegerExpr fl_exp
111 return (mkCoreApps (Var mkRational) [litR, litE])
112
113 dsRational :: Rational -> DsM CoreExpr
114 dsRational (n :% d) = do
115 dcn <- dsLookupDataCon ratioDataConName
116 cn <- mkIntegerExpr n
117 dn <- mkIntegerExpr d
118 t <- mkTyConTy <$> dsLookupTyCon integerTyConName
119 return $ mkCoreConApps dcn [Type t, cn, dn]
120
121
122 dsOverLit :: HsOverLit GhcTc -> DsM CoreExpr
123 -- ^ Post-typechecker, the 'HsExpr' field of an 'OverLit' contains
124 -- (an expression for) the literal value itself.
125 dsOverLit (OverLit { ol_val = val, ol_ext = OverLitTc rebindable ty
126 , ol_witness = witness }) = do
127 dflags <- getDynFlags
128 case shortCutLit dflags val ty of
129 Just expr | not rebindable -> dsExpr expr -- Note [Literal short cut]
130 _ -> dsExpr witness
131 dsOverLit XOverLit{} = panic "dsOverLit"
132 {-
133 Note [Literal short cut]
134 ~~~~~~~~~~~~~~~~~~~~~~~~
135 The type checker tries to do this short-cutting as early as possible, but
136 because of unification etc, more information is available to the desugarer.
137 And where it's possible to generate the correct literal right away, it's
138 much better to do so.
139
140
141 ************************************************************************
142 * *
143 Warnings about overflowed literals
144 * *
145 ************************************************************************
146
147 Warn about functions like toInteger, fromIntegral, that convert
148 between one type and another when the to- and from- types are the
149 same. Then it's probably (albeit not definitely) the identity
150 -}
151
152 warnAboutIdentities :: DynFlags -> CoreExpr -> Type -> DsM ()
153 warnAboutIdentities dflags (Var conv_fn) type_of_conv
154 | wopt Opt_WarnIdentities dflags
155 , idName conv_fn `elem` conversionNames
156 , Just (arg_ty, res_ty) <- splitFunTy_maybe type_of_conv
157 , arg_ty `eqType` res_ty -- So we are converting ty -> ty
158 = warnDs (Reason Opt_WarnIdentities)
159 (vcat [ text "Call of" <+> ppr conv_fn <+> dcolon <+> ppr type_of_conv
160 , nest 2 $ text "can probably be omitted"
161 ])
162 warnAboutIdentities _ _ _ = return ()
163
164 conversionNames :: [Name]
165 conversionNames
166 = [ toIntegerName, toRationalName
167 , fromIntegralName, realToFracName ]
168 -- We can't easily add fromIntegerName, fromRationalName,
169 -- because they are generated by literals
170
171
172 -- | Emit warnings on overloaded integral literals which overflow the bounds
173 -- implied by their type.
174 warnAboutOverflowedOverLit :: HsOverLit GhcTc -> DsM ()
175 warnAboutOverflowedOverLit hsOverLit = do
176 dflags <- getDynFlags
177 warnAboutOverflowedLiterals dflags (getIntegralLit hsOverLit)
178
179 -- | Emit warnings on integral literals which overflow the boudns implied by
180 -- their type.
181 warnAboutOverflowedLit :: HsLit GhcTc -> DsM ()
182 warnAboutOverflowedLit hsLit = do
183 dflags <- getDynFlags
184 warnAboutOverflowedLiterals dflags (getSimpleIntegralLit hsLit)
185
186 -- | Emit warnings on integral literals which overflow the bounds implied by
187 -- their type.
188 warnAboutOverflowedLiterals
189 :: DynFlags
190 -> Maybe (Integer, Name) -- ^ the literal value and name of its tycon
191 -> DsM ()
192 warnAboutOverflowedLiterals dflags lit
193 | wopt Opt_WarnOverflowedLiterals dflags
194 , Just (i, tc) <- lit
195 = if tc == intTyConName then check i tc (Proxy :: Proxy Int)
196
197 -- These only show up via the 'HsOverLit' route
198 else if tc == int8TyConName then check i tc (Proxy :: Proxy Int8)
199 else if tc == int16TyConName then check i tc (Proxy :: Proxy Int16)
200 else if tc == int32TyConName then check i tc (Proxy :: Proxy Int32)
201 else if tc == int64TyConName then check i tc (Proxy :: Proxy Int64)
202 else if tc == wordTyConName then check i tc (Proxy :: Proxy Word)
203 else if tc == word8TyConName then check i tc (Proxy :: Proxy Word8)
204 else if tc == word16TyConName then check i tc (Proxy :: Proxy Word16)
205 else if tc == word32TyConName then check i tc (Proxy :: Proxy Word32)
206 else if tc == word64TyConName then check i tc (Proxy :: Proxy Word64)
207 else if tc == naturalTyConName then checkPositive i tc
208
209 -- These only show up via the 'HsLit' route
210 else if tc == intPrimTyConName then check i tc (Proxy :: Proxy Int)
211 else if tc == int8PrimTyConName then check i tc (Proxy :: Proxy Int8)
212 else if tc == int32PrimTyConName then check i tc (Proxy :: Proxy Int32)
213 else if tc == int64PrimTyConName then check i tc (Proxy :: Proxy Int64)
214 else if tc == wordPrimTyConName then check i tc (Proxy :: Proxy Word)
215 else if tc == word8PrimTyConName then check i tc (Proxy :: Proxy Word8)
216 else if tc == word32PrimTyConName then check i tc (Proxy :: Proxy Word32)
217 else if tc == word64PrimTyConName then check i tc (Proxy :: Proxy Word64)
218
219 else return ()
220
221 | otherwise = return ()
222 where
223
224 checkPositive :: Integer -> Name -> DsM ()
225 checkPositive i tc
226 = when (i < 0) $ do
227 warnDs (Reason Opt_WarnOverflowedLiterals)
228 (vcat [ text "Literal" <+> integer i
229 <+> text "is negative but" <+> ppr tc
230 <+> ptext (sLit "only supports positive numbers")
231 ])
232
233 check :: forall a. (Bounded a, Integral a) => Integer -> Name -> Proxy a -> DsM ()
234 check i tc _proxy
235 = when (i < minB || i > maxB) $ do
236 warnDs (Reason Opt_WarnOverflowedLiterals)
237 (vcat [ text "Literal" <+> integer i
238 <+> text "is out of the" <+> ppr tc <+> ptext (sLit "range")
239 <+> integer minB <> text ".." <> integer maxB
240 , sug ])
241 where
242 minB = toInteger (minBound :: a)
243 maxB = toInteger (maxBound :: a)
244 sug | minB == -i -- Note [Suggest NegativeLiterals]
245 , i > 0
246 , not (xopt LangExt.NegativeLiterals dflags)
247 = text "If you are trying to write a large negative literal, use NegativeLiterals"
248 | otherwise = Outputable.empty
249
250 {-
251 Note [Suggest NegativeLiterals]
252 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
253 If you write
254 x :: Int8
255 x = -128
256 it'll parse as (negate 128), and overflow. In this case, suggest NegativeLiterals.
257 We get an erroneous suggestion for
258 x = 128
259 but perhaps that does not matter too much.
260 -}
261
262 warnAboutEmptyEnumerations :: DynFlags -> LHsExpr GhcTc -> Maybe (LHsExpr GhcTc)
263 -> LHsExpr GhcTc -> DsM ()
264 -- ^ Warns about @[2,3 .. 1]@ which returns the empty list.
265 -- Only works for integral types, not floating point.
266 warnAboutEmptyEnumerations dflags fromExpr mThnExpr toExpr
267 | wopt Opt_WarnEmptyEnumerations dflags
268 , Just (from,tc) <- getLHsIntegralLit fromExpr
269 , Just mThn <- traverse getLHsIntegralLit mThnExpr
270 , Just (to,_) <- getLHsIntegralLit toExpr
271 , let check :: forall a. (Enum a, Num a) => Proxy a -> DsM ()
272 check _proxy
273 = when (null enumeration) $
274 warnDs (Reason Opt_WarnEmptyEnumerations) (text "Enumeration is empty")
275 where
276 enumeration :: [a]
277 enumeration = case mThn of
278 Nothing -> [fromInteger from .. fromInteger to]
279 Just (thn,_) -> [fromInteger from, fromInteger thn .. fromInteger to]
280
281 = if tc == intTyConName then check (Proxy :: Proxy Int)
282 else if tc == int8TyConName then check (Proxy :: Proxy Int8)
283 else if tc == int16TyConName then check (Proxy :: Proxy Int16)
284 else if tc == int32TyConName then check (Proxy :: Proxy Int32)
285 else if tc == int64TyConName then check (Proxy :: Proxy Int64)
286 else if tc == wordTyConName then check (Proxy :: Proxy Word)
287 else if tc == word8TyConName then check (Proxy :: Proxy Word8)
288 else if tc == word16TyConName then check (Proxy :: Proxy Word16)
289 else if tc == word32TyConName then check (Proxy :: Proxy Word32)
290 else if tc == word64TyConName then check (Proxy :: Proxy Word64)
291 else if tc == integerTyConName then check (Proxy :: Proxy Integer)
292 else if tc == naturalTyConName then check (Proxy :: Proxy Integer)
293 -- We use 'Integer' because otherwise a negative 'Natural' literal
294 -- could cause a compile time crash (instead of a runtime one).
295 -- See the T10930b test case for an example of where this matters.
296 else return ()
297
298 | otherwise = return ()
299
300 getLHsIntegralLit :: LHsExpr GhcTc -> Maybe (Integer, Name)
301 -- ^ See if the expression is an 'Integral' literal.
302 -- Remember to look through automatically-added tick-boxes! (#8384)
303 getLHsIntegralLit (dL->L _ (HsPar _ e)) = getLHsIntegralLit e
304 getLHsIntegralLit (dL->L _ (HsTick _ _ e)) = getLHsIntegralLit e
305 getLHsIntegralLit (dL->L _ (HsBinTick _ _ _ e)) = getLHsIntegralLit e
306 getLHsIntegralLit (dL->L _ (HsOverLit _ over_lit)) = getIntegralLit over_lit
307 getLHsIntegralLit (dL->L _ (HsLit _ lit)) = getSimpleIntegralLit lit
308 getLHsIntegralLit _ = Nothing
309
310 -- | If 'Integral', extract the value and type name of the overloaded literal.
311 getIntegralLit :: HsOverLit GhcTc -> Maybe (Integer, Name)
312 getIntegralLit (OverLit { ol_val = HsIntegral i, ol_ext = OverLitTc _ ty })
313 | Just tc <- tyConAppTyCon_maybe ty
314 = Just (il_value i, tyConName tc)
315 getIntegralLit _ = Nothing
316
317 -- | If 'Integral', extract the value and type name of the non-overloaded
318 -- literal.
319 getSimpleIntegralLit :: HsLit GhcTc -> Maybe (Integer, Name)
320 getSimpleIntegralLit (HsInt _ IL{ il_value = i }) = Just (i, intTyConName)
321 getSimpleIntegralLit (HsIntPrim _ i) = Just (i, intPrimTyConName)
322 getSimpleIntegralLit (HsWordPrim _ i) = Just (i, wordPrimTyConName)
323 getSimpleIntegralLit (HsInt64Prim _ i) = Just (i, int64PrimTyConName)
324 getSimpleIntegralLit (HsWord64Prim _ i) = Just (i, word64PrimTyConName)
325 getSimpleIntegralLit (HsInteger _ i ty)
326 | Just tc <- tyConAppTyCon_maybe ty
327 = Just (i, tyConName tc)
328 getSimpleIntegralLit _ = Nothing
329
330 {-
331 ************************************************************************
332 * *
333 Tidying lit pats
334 * *
335 ************************************************************************
336 -}
337
338 tidyLitPat :: HsLit GhcTc -> Pat GhcTc
339 -- Result has only the following HsLits:
340 -- HsIntPrim, HsWordPrim, HsCharPrim, HsFloatPrim
341 -- HsDoublePrim, HsStringPrim, HsString
342 -- * HsInteger, HsRat, HsInt can't show up in LitPats
343 -- * We get rid of HsChar right here
344 tidyLitPat (HsChar src c) = unLoc (mkCharLitPat src c)
345 tidyLitPat (HsString src s)
346 | lengthFS s <= 1 -- Short string literals only
347 = unLoc $ foldr (\c pat -> mkPrefixConPat consDataCon
348 [mkCharLitPat src c, pat] [charTy])
349 (mkNilPat charTy) (unpackFS s)
350 -- The stringTy is the type of the whole pattern, not
351 -- the type to instantiate (:) or [] with!
352 tidyLitPat lit = LitPat noExt lit
353
354 ----------------
355 tidyNPat :: HsOverLit GhcTc -> Maybe (SyntaxExpr GhcTc) -> SyntaxExpr GhcTc
356 -> Type
357 -> Pat GhcTc
358 tidyNPat (OverLit (OverLitTc False ty) val _) mb_neg _eq outer_ty
359 -- False: Take short cuts only if the literal is not using rebindable syntax
360 --
361 -- Once that is settled, look for cases where the type of the
362 -- entire overloaded literal matches the type of the underlying literal,
363 -- and in that case take the short cut
364 -- NB: Watch out for weird cases like #3382
365 -- f :: Int -> Int
366 -- f "blah" = 4
367 -- which might be ok if we have 'instance IsString Int'
368 --
369 | not type_change, isIntTy ty, Just int_lit <- mb_int_lit
370 = mk_con_pat intDataCon (HsIntPrim NoSourceText int_lit)
371 | not type_change, isWordTy ty, Just int_lit <- mb_int_lit
372 = mk_con_pat wordDataCon (HsWordPrim NoSourceText int_lit)
373 | not type_change, isStringTy ty, Just str_lit <- mb_str_lit
374 = tidyLitPat (HsString NoSourceText str_lit)
375 -- NB: do /not/ convert Float or Double literals to F# 3.8 or D# 5.3
376 -- If we do convert to the constructor form, we'll generate a case
377 -- expression on a Float# or Double# and that's not allowed in Core; see
378 -- #9238 and Note [Rules for floating-point comparisons] in PrelRules
379 where
380 -- Sometimes (like in test case
381 -- overloadedlists/should_run/overloadedlistsrun04), the SyntaxExprs include
382 -- type-changing wrappers (for example, from Id Int to Int, for the identity
383 -- type family Id). In these cases, we can't do the short-cut.
384 type_change = not (outer_ty `eqType` ty)
385
386 mk_con_pat :: DataCon -> HsLit GhcTc -> Pat GhcTc
387 mk_con_pat con lit
388 = unLoc (mkPrefixConPat con [noLoc $ LitPat noExt lit] [])
389
390 mb_int_lit :: Maybe Integer
391 mb_int_lit = case (mb_neg, val) of
392 (Nothing, HsIntegral i) -> Just (il_value i)
393 (Just _, HsIntegral i) -> Just (-(il_value i))
394 _ -> Nothing
395
396 mb_str_lit :: Maybe FastString
397 mb_str_lit = case (mb_neg, val) of
398 (Nothing, HsIsString _ s) -> Just s
399 _ -> Nothing
400
401 tidyNPat over_lit mb_neg eq outer_ty
402 = NPat outer_ty (noLoc over_lit) mb_neg eq
403
404 {-
405 ************************************************************************
406 * *
407 Pattern matching on LitPat
408 * *
409 ************************************************************************
410 -}
411
412 matchLiterals :: [Id]
413 -> Type -- Type of the whole case expression
414 -> [[EquationInfo]] -- All PgLits
415 -> DsM MatchResult
416
417 matchLiterals (var:vars) ty sub_groups
418 = ASSERT( notNull sub_groups && all notNull sub_groups )
419 do { -- Deal with each group
420 ; alts <- mapM match_group sub_groups
421
422 -- Combine results. For everything except String
423 -- we can use a case expression; for String we need
424 -- a chain of if-then-else
425 ; if isStringTy (idType var) then
426 do { eq_str <- dsLookupGlobalId eqStringName
427 ; mrs <- mapM (wrap_str_guard eq_str) alts
428 ; return (foldr1 combineMatchResults mrs) }
429 else
430 return (mkCoPrimCaseMatchResult var ty alts)
431 }
432 where
433 match_group :: [EquationInfo] -> DsM (Literal, MatchResult)
434 match_group eqns
435 = do { dflags <- getDynFlags
436 ; let LitPat _ hs_lit = firstPat (head eqns)
437 ; match_result <- match vars ty (shiftEqns eqns)
438 ; return (hsLitKey dflags hs_lit, match_result) }
439
440 wrap_str_guard :: Id -> (Literal,MatchResult) -> DsM MatchResult
441 -- Equality check for string literals
442 wrap_str_guard eq_str (LitString s, mr)
443 = do { -- We now have to convert back to FastString. Perhaps there
444 -- should be separate LitBytes and LitString constructors?
445 let s' = mkFastStringByteString s
446 ; lit <- mkStringExprFS s'
447 ; let pred = mkApps (Var eq_str) [Var var, lit]
448 ; return (mkGuardedMatchResult pred mr) }
449 wrap_str_guard _ (l, _) = pprPanic "matchLiterals/wrap_str_guard" (ppr l)
450
451 matchLiterals [] _ _ = panic "matchLiterals []"
452
453 ---------------------------
454 hsLitKey :: DynFlags -> HsLit GhcTc -> Literal
455 -- Get the Core literal corresponding to a HsLit.
456 -- It only works for primitive types and strings;
457 -- others have been removed by tidy
458 -- For HsString, it produces a LitString, which really represents an _unboxed_
459 -- string literal; and we deal with it in matchLiterals above. Otherwise, it
460 -- produces a primitive Literal of type matching the original HsLit.
461 -- In the case of the fixed-width numeric types, we need to wrap here
462 -- because Literal has an invariant that the literal is in range, while
463 -- HsLit does not.
464 hsLitKey dflags (HsIntPrim _ i) = mkLitIntWrap dflags i
465 hsLitKey dflags (HsWordPrim _ w) = mkLitWordWrap dflags w
466 hsLitKey dflags (HsInt64Prim _ i) = mkLitInt64Wrap dflags i
467 hsLitKey dflags (HsWord64Prim _ w) = mkLitWord64Wrap dflags w
468 hsLitKey _ (HsCharPrim _ c) = mkLitChar c
469 hsLitKey _ (HsFloatPrim _ fl) = mkLitFloat (rationalFromFractionalLit fl)
470 hsLitKey _ (HsDoublePrim _ fl) = mkLitDouble (rationalFromFractionalLit fl)
471 hsLitKey _ (HsString _ s) = LitString (bytesFS s)
472 hsLitKey _ l = pprPanic "hsLitKey" (ppr l)
473
474 {-
475 ************************************************************************
476 * *
477 Pattern matching on NPat
478 * *
479 ************************************************************************
480 -}
481
482 matchNPats :: [Id] -> Type -> [EquationInfo] -> DsM MatchResult
483 matchNPats (var:vars) ty (eqn1:eqns) -- All for the same literal
484 = do { let NPat _ (dL->L _ lit) mb_neg eq_chk = firstPat eqn1
485 ; lit_expr <- dsOverLit lit
486 ; neg_lit <- case mb_neg of
487 Nothing -> return lit_expr
488 Just neg -> dsSyntaxExpr neg [lit_expr]
489 ; pred_expr <- dsSyntaxExpr eq_chk [Var var, neg_lit]
490 ; match_result <- match vars ty (shiftEqns (eqn1:eqns))
491 ; return (mkGuardedMatchResult pred_expr match_result) }
492 matchNPats vars _ eqns = pprPanic "matchOneNPat" (ppr (vars, eqns))
493
494 {-
495 ************************************************************************
496 * *
497 Pattern matching on n+k patterns
498 * *
499 ************************************************************************
500
501 For an n+k pattern, we use the various magic expressions we've been given.
502 We generate:
503 \begin{verbatim}
504 if ge var lit then
505 let n = sub var lit
506 in <expr-for-a-successful-match>
507 else
508 <try-next-pattern-or-whatever>
509 \end{verbatim}
510 -}
511
512 matchNPlusKPats :: [Id] -> Type -> [EquationInfo] -> DsM MatchResult
513 -- All NPlusKPats, for the *same* literal k
514 matchNPlusKPats (var:vars) ty (eqn1:eqns)
515 = do { let NPlusKPat _ (dL->L _ n1) (dL->L _ lit1) lit2 ge minus
516 = firstPat eqn1
517 ; lit1_expr <- dsOverLit lit1
518 ; lit2_expr <- dsOverLit lit2
519 ; pred_expr <- dsSyntaxExpr ge [Var var, lit1_expr]
520 ; minusk_expr <- dsSyntaxExpr minus [Var var, lit2_expr]
521 ; let (wraps, eqns') = mapAndUnzip (shift n1) (eqn1:eqns)
522 ; match_result <- match vars ty eqns'
523 ; return (mkGuardedMatchResult pred_expr $
524 mkCoLetMatchResult (NonRec n1 minusk_expr) $
525 adjustMatchResult (foldr1 (.) wraps) $
526 match_result) }
527 where
528 shift n1 eqn@(EqnInfo { eqn_pats = NPlusKPat _ (dL->L _ n) _ _ _ _ : pats })
529 = (wrapBind n n1, eqn { eqn_pats = pats })
530 -- The wrapBind is a no-op for the first equation
531 shift _ e = pprPanic "matchNPlusKPats/shift" (ppr e)
532
533 matchNPlusKPats vars _ eqns = pprPanic "matchNPlusKPats" (ppr (vars, eqns))