Commit afbd30b6 authored by Jan Stolarek's avatar Jan Stolarek Committed by Ben Gamari
Browse files

mkGadtDecl no longer in P monad

Since `mkGadtDecl` does not use any of the functions specific to the `P`
monad we can extract it from that monad and reuse in other parts of the
compiler.

Test Plan: ./validate

Reviewers: austin, bgamari

Reviewed By: bgamari

Subscribers: thomie, mpickering

Differential Revision: https://phabricator.haskell.org/D1461
parent fb0d5120
...@@ -1874,7 +1874,7 @@ gadt_constr :: { LConDecl RdrName } ...@@ -1874,7 +1874,7 @@ gadt_constr :: { LConDecl RdrName }
-- see Note [Difference in parsing GADT and data constructors] -- see Note [Difference in parsing GADT and data constructors]
-- Returns a list because of: C,D :: ty -- Returns a list because of: C,D :: ty
: con_list '::' sigtype : con_list '::' sigtype
{% do { (anns,gadtDecl) <- mkGadtDecl (unLoc $1) $3 {% do { let { (anns, gadtDecl) = mkGadtDecl (unLoc $1) $3 }
; ams (sLL $1 $> gadtDecl) ; ams (sLL $1 $> gadtDecl)
(mj AnnDcolon $2:anns) } } (mj AnnDcolon $2:anns) } }
......
...@@ -498,29 +498,27 @@ mkSimpleConDecl name qvars cxt details ...@@ -498,29 +498,27 @@ mkSimpleConDecl name qvars cxt details
mkGadtDecl :: [Located RdrName] mkGadtDecl :: [Located RdrName]
-> LHsType RdrName -- Always a HsForAllTy -> LHsType RdrName -- Always a HsForAllTy
-> P ([AddAnn], ConDecl RdrName) -> ([AddAnn], ConDecl RdrName)
mkGadtDecl names (L l ty) = do mkGadtDecl names (L l ty) =
let let (anns, ty') = flattenHsForAllTyKeepAnns ty
(anns,ty') = flattenHsForAllTyKeepAnns ty gadt = mkGadtDecl' names (L l ty')
gadt <- mkGadtDecl' names (L l ty') in (anns, gadt)
return (anns,gadt)
mkGadtDecl' :: [Located RdrName] mkGadtDecl' :: [Located RdrName]
-> LHsType RdrName -- Always a HsForAllTy -> LHsType RdrName -- Always a HsForAllTy
-> P (ConDecl RdrName) -> (ConDecl RdrName)
-- We allow C,D :: ty -- We allow C,D :: ty
-- and expand it as if it had been -- and expand it as if it had been
-- C :: ty; D :: ty -- C :: ty; D :: ty
-- (Just like type signatures in general.) -- (Just like type signatures in general.)
mkGadtDecl' names (L ls (HsForAllTy imp _ qvars cxt tau)) mkGadtDecl' names (L ls (HsForAllTy imp _ qvars cxt tau))
= return $ mk_gadt_con names = mk_gadt_con names
where where
(details, res_ty) -- See Note [Sorting out the result type] (details, res_ty) -- See Note [Sorting out the result type]
= case tau of = case tau of
L _ (HsFunTy (L l (HsRecTy flds)) res_ty) L _ (HsFunTy (L l (HsRecTy flds)) res_ty)
-> (RecCon (L l flds), res_ty) -> (RecCon (L l flds), res_ty)
_other -> (PrefixCon [], tau) _other -> (PrefixCon [], tau)
mk_gadt_con names mk_gadt_con names
= ConDecl { con_names = names = ConDecl { con_names = names
......
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