diff options
Diffstat (limited to 'compiler/parser/RdrHsSyn.hs')
| -rw-r--r-- | compiler/parser/RdrHsSyn.hs | 27 |
1 files changed, 5 insertions, 22 deletions
diff --git a/compiler/parser/RdrHsSyn.hs b/compiler/parser/RdrHsSyn.hs index 625c4dc6e9..e945e43362 100644 --- a/compiler/parser/RdrHsSyn.hs +++ b/compiler/parser/RdrHsSyn.hs @@ -18,7 +18,7 @@ module RdrHsSyn ( mkTyFamInst, mkFamDecl, splitCon, mkInlinePragma, - splitPatSyn, toPatSynMatchGroup, + mkPatSynMatchGroup, mkRecConstrOrUpdate, -- HsExp -> [HsFieldUpdate] -> P HsExp mkTyClD, mkInstD, @@ -414,33 +414,16 @@ splitCon ty mk_rest [L _ (HsRecTy flds)] = RecCon flds mk_rest ts = PrefixCon ts -splitPatSyn :: LPat RdrName - -> P (Located RdrName, HsPatSynDetails (Located RdrName)) -splitPatSyn (L _ (ParPat pat)) = splitPatSyn pat -splitPatSyn pat@(L loc (ConPatIn con details)) = do - details' <- case details of - PrefixCon pats -> liftM PrefixPatSyn (mapM patVar pats) - InfixCon pat1 pat2 -> liftM2 InfixPatSyn (patVar pat1) (patVar pat2) - RecCon{} -> recordPatSynErr loc pat - return (con, details') - where - patVar :: LPat RdrName -> P (Located RdrName) - patVar (L loc (VarPat v)) = return $ L loc v - patVar (L _ (ParPat pat)) = patVar pat - patVar (L loc pat) = parseErrorSDoc loc $ - text "Pattern synonym arguments must be variable names:" $$ - ppr pat -splitPatSyn pat@(L loc _) = parseErrorSDoc loc $ - text "invalid pattern synonym declaration:" $$ ppr pat - recordPatSynErr :: SrcSpan -> LPat RdrName -> P a recordPatSynErr loc pat = parseErrorSDoc loc $ text "record syntax not supported for pattern synonym declarations:" $$ ppr pat -toPatSynMatchGroup :: Located RdrName -> Located (OrdList (LHsDecl RdrName)) -> P (MatchGroup RdrName (LHsExpr RdrName)) -toPatSynMatchGroup (L _ patsyn_name) (L _ decls) = +mkPatSynMatchGroup :: Located RdrName + -> Located (OrdList (LHsDecl RdrName)) + -> P (MatchGroup RdrName (LHsExpr RdrName)) +mkPatSynMatchGroup (L _ patsyn_name) (L _ decls) = do { matches <- mapM fromDecl (fromOL decls) ; return $ mkMatchGroup FromSource matches } where |