[commit: ghc] wip/T8584.spj: Finish parser (7a1f9a8)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : wip/T8584.spj
Link       : http://ghc.haskell.org/trac/ghc/changeset/7a1f9a8c1b60c3b040398e37c13a7e5394fe1af6/ghc

>---------------------------------------------------------------

commit 7a1f9a8c1b60c3b040398e37c13a7e5394fe1af6
Author: Dr. ERDI Gergo <gergo at erdi.hu>
Date:   Sun Nov 9 14:42:30 2014 +0800

    Finish parser


>---------------------------------------------------------------

7a1f9a8c1b60c3b040398e37c13a7e5394fe1af6
 compiler/parser/Parser.y | 22 +++++++++++++---------
 1 file changed, 13 insertions(+), 9 deletions(-)

diff --git a/compiler/parser/Parser.y b/compiler/parser/Parser.y
index 7d817ed..bf62286 100644
--- a/compiler/parser/Parser.y
+++ b/compiler/parser/Parser.y
@@ -881,15 +881,19 @@ where_decls :: { Located (OrdList (LHsDecl RdrName)) }
 
 pattern_synonym_sig :: { LSig RdrName }
         : 'pattern' 'type' con '::' ptype
-            { undefined }
-
-ptype :: { () }
-        : 'forall' tv_bndrs '.' ptype   {% hintExplicitForall (getLoc $1) >>
-                                            return () }
-        | pcontext '=>' type            { () }
-
-pcontext :: { (LHsContext RdrName, LHsContext RdrName) }
-        : btype {% checkContextPair $1 }
+            { let (flag, qtvs, prov, req, ty) = unLoc $5
+              in sLL $1 $> $ PatSynSig $3 (flag, mkHsQTvs qtvs) prov req ty }
+
+ptype :: { Located (HsExplicitFlag, [LHsTyVarBndr RdrName], LHsContext RdrName, LHsContext RdrName, LHsType RdrName) }
+        : 'forall' tv_bndrs '.' ptype
+            {% do { hintExplicitForall (getLoc $1)
+                  ; let (_, qtvs', prov, req, ty) = unLoc $4
+                  ; return $ sLL $1 $> (Explicit, $2 ++ qtvs', prov, req ,ty) }}
+        | pcontext '=>' type
+            { let (prov, req) = unLoc $1 in sLL $1 $> (Implicit, [], prov, req, $3) }
+
+pcontext :: { Located (LHsContext RdrName, LHsContext RdrName) }
+        : btype {% fmap (sL1 $1) $ checkContextPair $1 }
 
 vars0 :: { [Located RdrName] }
         : {- empty -}                 { [] }