diff options
| author | Dr. ERDI Gergo <gergo@erdi.hu> | 2014-07-02 19:23:47 +0800 |
|---|---|---|
| committer | Dr. ERDI Gergo <gergo@erdi.hu> | 2014-07-02 19:23:47 +0800 |
| commit | dbe2c5c44ffffb9252b33ec049edb189103c49a4 (patch) | |
| tree | fb2331ea8f1d8ea3d0129e31c58336595701d8bd | |
| parent | 2d86eeff134baac96d708eaa4c161455350da14d (diff) | |
| download | haskell-wip/T9023.tar.gz | |
Add parser for pattern synonym signatureswip/T9023
| -rw-r--r-- | compiler/parser/Parser.y.pp | 22 |
1 files changed, 20 insertions, 2 deletions
diff --git a/compiler/parser/Parser.y.pp b/compiler/parser/Parser.y.pp index 68f7e5bd58..6e4a3d5a8c 100644 --- a/compiler/parser/Parser.y.pp +++ b/compiler/parser/Parser.y.pp @@ -816,8 +816,25 @@ 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' 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_synonym_sig :: { LSig RdrName } + : 'pattern' patsyn_context patsyn_stuff '::' patsyn_context type + { let (name, details) = unLoc $3 + in LL $ PatSynSig name details $6 $2 $5 } + +patsyn_stuff :: { Located (Located RdrName, HsPatSynDetails (LHsType RdrName)) } + : constr_stuff + {% do { let { (L loc (name, con_details)) = $1 } + ; ps_details <- toPatSynSigDetails loc con_details + ; return $ LL (name, ps_details) } } + +patsyn_context :: { LHsContext RdrName } + : forall { L0 [] } + | forall context '=>' { $2 } vars0 :: { [Located RdrName] } : {- empty -} { [] } @@ -1432,6 +1449,7 @@ sigdecl :: { Located (OrdList (LHsDecl RdrName)) } { LL $ toOL [ LL $ SigD (TypeSig ($1 : unLoc $3) $5) ] } | infix prec ops { LL $ toOL [ LL $ SigD (FixSig (FixitySig n (Fixity $2 (unLoc $1)))) | n <- unLoc $3 ] } + | pattern_synonym_sig { LL . unitOL $ LL . SigD . unLoc $ $1 } | '{-# INLINE' activation qvar '#-}' { LL $ unitOL (LL $ SigD (InlineSig $3 (mkInlinePragma (getINLINE $1) $2))) } | '{-# SPECIALISE' activation qvar '::' sigtypes1 '#-}' |