Finish parser

1 files changed, 13 insertions, 9 deletions

diff --git a/compiler/parser/Parser.y b/compiler/parser/Parser.y
index 7d817edc44..bf62286705 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 -}                 { [] }