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 } ...@@ -848,17 +848,19 @@ role : VARID { L1 $ Just $ getVARID $1 }
-- Glasgow extension: pattern synonyms -- Glasgow extension: pattern synonyms
pattern_synonym_decl :: { LHsDecl RdrName } pattern_synonym_decl :: { LHsDecl RdrName }
: 'pattern' con vars0 patsyn_token pat { LL . ValD $ mkPatSynBind $2 (PrefixPatSyn $3) $5 $4 } : 'pattern' pat '=' pat
| 'pattern' varid conop varid patsyn_token pat { LL . ValD $ mkPatSynBind $3 (InfixPatSyn $2 $4) $6 $5 } {% 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] } vars0 :: { [Located RdrName] }
: {- empty -} { [] } : {- empty -} { [] }
| varid vars0 { $1 : $2 } | varid vars0 { $1 : $2 }
patsyn_token :: { HsPatSynDir RdrName }
: '<-' { Unidirectional }
| '=' { ImplicitBidirectional }
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
-- Nested declarations -- Nested declarations
......
...@@ -16,7 +16,7 @@ module RdrHsSyn ( ...@@ -16,7 +16,7 @@ module RdrHsSyn (
mkTySynonym, mkTyFamInstEqn, mkTySynonym, mkTyFamInstEqn,
mkTyFamInst, mkTyFamInst,
mkFamDecl, mkFamDecl,
splitCon, mkInlinePragma, splitCon, splitPatSyn, mkInlinePragma,
mkRecConstrOrUpdate, -- HsExp -> [HsFieldUpdate] -> P HsExp mkRecConstrOrUpdate, -- HsExp -> [HsFieldUpdate] -> P HsExp
mkTyLit, mkTyLit,
mkTyClD, mkInstD, mkTyClD, mkInstD,
...@@ -428,6 +428,25 @@ splitCon ty ...@@ -428,6 +428,25 @@ splitCon ty
mk_rest [L _ (HsRecTy flds)] = RecCon flds mk_rest [L _ (HsRecTy flds)] = RecCon flds
mk_rest ts = PrefixCon ts 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 mkDeprecatedGadtRecordDecl :: SrcSpan
-> Located RdrName -> Located RdrName
-> [ConDeclField 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