Commit e7653bc3 authored by Simon Peyton Jones's avatar Simon Peyton Jones

Wombling around in Trac #14808

Comment:4 in Trac #14808 explains why I'm unhappy with the current
state of affairs -- at least the lack of documentation.

This smallpatch does nothing major:

* adds comments
* uses existing type synonyms more (notably FreeKiTyVarsWithDups)
* adds another test case to T14808
parent a9f680f6
......@@ -1917,9 +1917,12 @@ rnConDecl decl@(ConDeclGADT { con_names = names
; let explicit_tkvs = hsQTvExplicit qtvs
theta = hsConDeclTheta mcxt
arg_tys = hsConDeclArgTys args
-- We must ensure that we extract the free tkvs in the
-- order of theta, then arg_tys, then res_ty. Failing to
-- do so resulted in #14808.
-- We must ensure that we extract the free tkvs in left-to-right
-- order of their appearance in the constructor type.
-- That order governs the order the implicitly-quantified type
-- variable, and hence the order needed for visible type application
-- See Trac #14808.
; free_tkvs <- extractHsTysRdrTyVarsDups (theta ++ arg_tys ++ [res_ty])
; free_tkvs <- extractHsTvBndrs explicit_tkvs free_tkvs
......
......@@ -1748,27 +1748,32 @@ extractDataDefnKindVars (HsDataDefn { dd_ctxt = ctxt, dd_kindSig = ksig
extract_mlctxt ctxt =<<
extract_ltys TypeLevel (hsConDeclArgTys args) emptyFKTV
extract_mlctxt :: Maybe (LHsContext GhcPs) -> FreeKiTyVars -> RnM FreeKiTyVars
extract_mlctxt :: Maybe (LHsContext GhcPs)
-> FreeKiTyVarsWithDups -> RnM FreeKiTyVarsWithDups
extract_mlctxt Nothing acc = return acc
extract_mlctxt (Just ctxt) acc = extract_lctxt TypeLevel ctxt acc
extract_lctxt :: TypeOrKind
-> LHsContext GhcPs -> FreeKiTyVars -> RnM FreeKiTyVars
-> LHsContext GhcPs
-> FreeKiTyVarsWithDups -> RnM FreeKiTyVarsWithDups
extract_lctxt t_or_k ctxt = extract_ltys t_or_k (unLoc ctxt)
extract_ltys :: TypeOrKind
-> [LHsType GhcPs] -> FreeKiTyVars -> RnM FreeKiTyVars
-> [LHsType GhcPs]
-> FreeKiTyVarsWithDups -> RnM FreeKiTyVarsWithDups
extract_ltys t_or_k tys acc = foldrM (extract_lty t_or_k) acc tys
extract_mb :: (a -> FreeKiTyVars -> RnM FreeKiTyVars)
-> Maybe a -> FreeKiTyVars -> RnM FreeKiTyVars
extract_mb :: (a -> FreeKiTyVarsWithDups -> RnM FreeKiTyVarsWithDups)
-> Maybe a
-> FreeKiTyVarsWithDups -> RnM FreeKiTyVarsWithDups
extract_mb _ Nothing acc = return acc
extract_mb f (Just x) acc = f x acc
extract_lkind :: LHsType GhcPs -> FreeKiTyVars -> RnM FreeKiTyVars
extract_lkind = extract_lty KindLevel
extract_lty :: TypeOrKind -> LHsType GhcPs -> FreeKiTyVars -> RnM FreeKiTyVars
extract_lty :: TypeOrKind -> LHsType GhcPs
-> FreeKiTyVarsWithDups -> RnM FreeKiTyVarsWithDups
extract_lty t_or_k (L _ ty) acc
= case ty of
HsTyVar _ ltv -> extract_tv t_or_k ltv acc
......@@ -1813,19 +1818,21 @@ extract_apps :: TypeOrKind
-> [LHsAppType GhcPs] -> FreeKiTyVars -> RnM FreeKiTyVars
extract_apps t_or_k tys acc = foldrM (extract_app t_or_k) acc tys
extract_app :: TypeOrKind -> LHsAppType GhcPs -> FreeKiTyVars
-> RnM FreeKiTyVars
extract_app :: TypeOrKind -> LHsAppType GhcPs
-> FreeKiTyVarsWithDups -> RnM FreeKiTyVarsWithDups
extract_app t_or_k (L _ (HsAppInfix tv)) acc = extract_tv t_or_k tv acc
extract_app t_or_k (L _ (HsAppPrefix ty)) acc = extract_lty t_or_k ty acc
extractHsTvBndrs :: [LHsTyVarBndr GhcPs]
-> FreeKiTyVars -- Free in body
-> RnM FreeKiTyVars -- Free in result
-> FreeKiTyVarsWithDups -- Free in body
-> RnM FreeKiTyVarsWithDups -- Free in result
extractHsTvBndrs tv_bndrs body_fvs
= extract_hs_tv_bndrs tv_bndrs emptyFKTV body_fvs
extract_hs_tv_bndrs :: [LHsTyVarBndr GhcPs] -> FreeKiTyVars
-> FreeKiTyVars -> RnM FreeKiTyVars
extract_hs_tv_bndrs :: [LHsTyVarBndr GhcPs]
-> FreeKiTyVarsWithDups -- Accumulator
-> FreeKiTyVarsWithDups -- Free in body
-> RnM FreeKiTyVarsWithDups
-- In (forall (a :: Maybe e). a -> b) we have
-- 'a' is bound by the forall
-- 'b' is a free type variable
......@@ -1866,8 +1873,8 @@ extract_hs_tv_bndrs_kvs tv_bndrs
; return (freeKiTyVarsKindVars fktvs) }
-- There will /be/ no free tyvars!
extract_tv :: TypeOrKind -> Located RdrName -> FreeKiTyVars
-> RnM FreeKiTyVars
extract_tv :: TypeOrKind -> Located RdrName
-> FreeKiTyVarsWithDups -> RnM FreeKiTyVarsWithDups
extract_tv t_or_k ltv@(L _ tv) acc@(FKTV kvs tvs)
| not (isRdrTyVar tv) = return acc
| isTypeLevel t_or_k = return (FKTV kvs (ltv : tvs))
......
......@@ -10,3 +10,9 @@ data ECC ctx f a where
f :: [()] -> ECC () [] ()
f = ECC @() @[] @()
data ECC2 f a ctx where
ECC2 :: ctx => f a -> ECC2 f a ctx
f2 :: [()] -> ECC2 [] () ()
f2 = ECC2 @() @[] @()
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