Commit 12644c3c authored by Gergő Érdi's avatar Gergő Érdi
Browse files

New parser for pattern synonym declarations:

Like splitCon for constructor definitions, the left-hand side of a
pattern declaration is parsed as a single pattern which is then split
into a ConName and argument variable names
parent b6d52294
......@@ -848,17 +848,19 @@ role : VARID { L1 $ Just $ getVARID $1 }
-- Glasgow extension: pattern synonyms
pattern_synonym_decl :: { LHsDecl RdrName }
: 'pattern' con vars0 patsyn_token pat { LL . ValD $ mkPatSynBind $2 (PrefixPatSyn $3) $5 $4 }
| 'pattern' varid conop varid patsyn_token pat { LL . ValD $ mkPatSynBind $3 (InfixPatSyn $2 $4) $6 $5 }
: 'pattern' pat '=' pat
{% do { (name, args) <- splitPatSyn $2
; return $ LL . ValD $ mkPatSynBind name args $4 ImplicitBidirectional
}}
| 'pattern' pat '<-' pat
{% do { (name, args) <- splitPatSyn $2
; return $ LL . ValD $ mkPatSynBind name args $4 Unidirectional
}}
vars0 :: { [Located RdrName] }
: {- empty -} { [] }
| varid vars0 { $1 : $2 }
patsyn_token :: { HsPatSynDir RdrName }
: '<-' { Unidirectional }
| '=' { ImplicitBidirectional }
-----------------------------------------------------------------------------
-- Nested declarations
......
......@@ -16,7 +16,7 @@ module RdrHsSyn (
mkTySynonym, mkTyFamInstEqn,
mkTyFamInst,
mkFamDecl,
splitCon, mkInlinePragma,
splitCon, splitPatSyn, mkInlinePragma,
mkRecConstrOrUpdate, -- HsExp -> [HsFieldUpdate] -> P HsExp
mkTyLit,
mkTyClD, mkInstD,
......@@ -428,6 +428,25 @@ 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{} -> parseErrorSDoc loc $
text "record syntax not supported for pattern synonym declarations:" $$ ppr 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 pat@(L loc _) = 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
mkDeprecatedGadtRecordDecl :: SrcSpan
-> Located RdrName
-> [ConDeclField RdrName]
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment