-checkPattern :: SrcLoc -> RdrNameHsExpr -> P RdrNamePat
-checkPattern loc e = setSrcLocFor loc (checkPat e [])
-
-checkPatterns :: SrcLoc -> [RdrNameHsExpr] -> P [RdrNamePat]
-checkPatterns loc es = mapM (checkPattern loc) es
-
-checkPat :: RdrNameHsExpr -> [RdrNamePat] -> P RdrNamePat
-checkPat (HsVar c) args | isRdrDataCon c = return (ConPatIn c (PrefixCon args))
-checkPat (HsApp f x) args =
- checkPat x [] >>= \x ->
- checkPat f (x:args)
-checkPat e [] = case e of
- EWildPat -> return (WildPat placeHolderType)
- HsVar x | isQual x -> parseError ("Qualified variable in pattern: " ++ showRdrName x)
- | otherwise -> return (VarPat x)
- HsLit l -> return (LitPat l)
-
- -- Overloaded numeric patterns (e.g. f 0 x = x)
- -- Negation is recorded separately, so that the literal is zero or +ve
- -- NB. Negative *primitive* literals are already handled by
- -- RdrHsSyn.mkHsNegApp
- HsOverLit pos_lit -> return (NPatIn pos_lit Nothing)
- NegApp (HsOverLit pos_lit) _ -> return (NPatIn pos_lit (Just placeHolderName))
-
- ELazyPat e -> checkPat e [] >>= (return . LazyPat)
- EAsPat n e -> checkPat e [] >>= (return . AsPat n)
- ExprWithTySig e t -> checkPat e [] >>= \e ->
- -- Pattern signatures are parsed as sigtypes,
- -- but they aren't explicit forall points. Hence
- -- we have to remove the implicit forall here.
- let t' = case t of
- HsForAllTy Implicit _ [] ty -> ty
- other -> other
- in
- return (SigPatIn e t')
-
- -- n+k patterns
- OpApp (HsVar n) (HsVar plus) _ (HsOverLit lit@(HsIntegral _ _))
- | plus == plus_RDR
- -> return (mkNPlusKPat n lit)
- where
- plus_RDR = mkUnqual varName FSLIT("+") -- Hack
-
- OpApp l op fix r -> checkPat l [] >>= \l ->
- checkPat r [] >>= \r ->
- case op of
- HsVar c | isDataOcc (rdrNameOcc c)
- -> return (ConPatIn c (InfixCon l r))
- _ -> patFail
-
- HsPar e -> checkPat e [] >>= (return . ParPat)
- ExplicitList _ es -> mapM (\e -> checkPat e []) es >>= \ps ->
- return (ListPat ps placeHolderType)
- ExplicitPArr _ es -> mapM (\e -> checkPat e []) es >>= \ps ->
- return (PArrPat ps placeHolderType)
-
- ExplicitTuple es b -> mapM (\e -> checkPat e []) es >>= \ps ->
- return (TuplePat ps b)
-
- RecordCon c fs -> mapM checkPatField fs >>= \fs ->
- return (ConPatIn c (RecCon fs))
+checkPattern :: LHsExpr RdrName -> P (LPat RdrName)
+checkPattern e = checkLPat e
+
+checkPatterns :: [LHsExpr RdrName] -> P [LPat RdrName]
+checkPatterns es = mapM checkPattern es
+
+checkLPat :: LHsExpr RdrName -> P (LPat RdrName)
+checkLPat e@(L l _) = checkPat l e []
+
+checkPat :: SrcSpan -> LHsExpr RdrName -> [LPat RdrName] -> P (LPat RdrName)
+checkPat loc (L l (HsVar c)) args
+ | isRdrDataCon c = return (L loc (ConPatIn (L l c) (PrefixCon args)))
+checkPat loc (L _ (HsApp f x)) args = do
+ x <- checkLPat x
+ checkPat loc f (x:args)
+checkPat loc (L _ e) [] = do
+ p <- checkAPat loc e
+ return (L loc p)
+checkPat loc pat _some_args
+ = patFail loc
+
+checkAPat loc e = case e of
+ EWildPat -> return (WildPat placeHolderType)
+ HsVar x | isQual x -> parseError loc ("Qualified variable in pattern: "
+ ++ showRdrName x)
+ | otherwise -> return (VarPat x)
+ HsLit l -> return (LitPat l)
+
+ -- Overloaded numeric patterns (e.g. f 0 x = x)
+ -- Negation is recorded separately, so that the literal is zero or +ve
+ -- NB. Negative *primitive* literals are already handled by
+ -- RdrHsSyn.mkHsNegApp
+ HsOverLit pos_lit -> return (NPatIn pos_lit Nothing)
+ NegApp (L _ (HsOverLit pos_lit)) _
+ -> return (NPatIn pos_lit (Just placeHolderName))
+
+ ELazyPat e -> checkLPat e >>= (return . LazyPat)
+ EAsPat n e -> checkLPat e >>= (return . AsPat n)
+ ExprWithTySig e t -> checkLPat e >>= \e ->
+ -- Pattern signatures are parsed as sigtypes,
+ -- but they aren't explicit forall points. Hence
+ -- we have to remove the implicit forall here.
+ let t' = case t of
+ L _ (HsForAllTy Implicit _ (L _ []) ty) -> ty
+ other -> other
+ in
+ return (SigPatIn e t')
+
+ -- n+k patterns
+ OpApp (L nloc (HsVar n)) (L _ (HsVar plus)) _
+ (L _ (HsOverLit lit@(HsIntegral _ _)))
+ | plus == plus_RDR
+ -> return (mkNPlusKPat (L nloc n) lit)
+ where
+ plus_RDR = mkUnqual varName FSLIT("+") -- Hack
+
+ OpApp l op fix r -> checkLPat l >>= \l ->
+ checkLPat r >>= \r ->
+ case op of
+ L cl (HsVar c) | isDataOcc (rdrNameOcc c)
+ -> return (ConPatIn (L cl c) (InfixCon l r))
+ _ -> patFail loc
+
+ HsPar e -> checkLPat e >>= (return . ParPat)
+ ExplicitList _ es -> mapM (\e -> checkLPat e) es >>= \ps ->
+ return (ListPat ps placeHolderType)
+ ExplicitPArr _ es -> mapM (\e -> checkLPat e) es >>= \ps ->
+ return (PArrPat ps placeHolderType)
+
+ ExplicitTuple es b -> mapM (\e -> checkLPat e) es >>= \ps ->
+ return (TuplePat ps b)
+
+ RecordCon c fs -> mapM checkPatField fs >>= \fs ->
+ return (ConPatIn c (RecCon fs))