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

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