Commit f0b46f3e authored by Simon Peyton Jones's avatar Simon Peyton Jones Committed by Ben Gamari

Do not quantify over deriving clauses

Trac #14331 showed that in a data type decl like

   data D = D deriving (C (a :: k))

we were quantifying D over the 'k' in the deriving clause.  Yikes.

Easily fixed, by deleting code in RnTypes.extractDataDefnKindVars

See the discussion on the ticket, esp comment:8.

(cherry picked from commit 82b77ec3)
parent 35f85046
...@@ -1598,14 +1598,23 @@ extractRdrKindSigVars (L _ resultSig) ...@@ -1598,14 +1598,23 @@ extractRdrKindSigVars (L _ resultSig)
extractDataDefnKindVars :: HsDataDefn RdrName -> RnM [Located RdrName] extractDataDefnKindVars :: HsDataDefn RdrName -> RnM [Located RdrName]
-- Get the scoped kind variables mentioned free in the constructor decls -- Get the scoped kind variables mentioned free in the constructor decls
-- Eg data T a = T1 (S (a :: k) | forall (b::k). T2 (S b) -- Eg: data T a = T1 (S (a :: k) | forall (b::k). T2 (S b)
-- Here k should scope over the whole definition -- Here k should scope over the whole definition
--
-- However, do NOT collect free kind vars from the deriving clauses:
-- Eg: (Trac #14331) class C p q
-- data D = D deriving ( C (a :: k) )
-- Here k should /not/ scope over the whole definition. We intend
-- this to elaborate to:
-- class C @k1 @k2 (p::k1) (q::k2)
-- data D = D
-- instance forall k (a::k). C @k @* a D where ...
--
extractDataDefnKindVars (HsDataDefn { dd_ctxt = ctxt, dd_kindSig = ksig extractDataDefnKindVars (HsDataDefn { dd_ctxt = ctxt, dd_kindSig = ksig
, dd_cons = cons, dd_derivs = L _ derivs }) , dd_cons = cons })
= (nubL . freeKiTyVarsKindVars) <$> = (nubL . freeKiTyVarsKindVars) <$>
(extract_lctxt TypeLevel ctxt =<< (extract_lctxt TypeLevel ctxt =<<
extract_mb extract_lkind ksig =<< extract_mb extract_lkind ksig =<<
extract_sig_tys (concatMap (unLoc . deriv_clause_tys . unLoc) derivs) =<<
foldrM (extract_con . unLoc) emptyFKTV cons) foldrM (extract_con . unLoc) emptyFKTV cons)
where where
extract_con (ConDeclGADT { }) acc = return acc extract_con (ConDeclGADT { }) acc = return acc
...@@ -1623,11 +1632,6 @@ extract_lctxt :: TypeOrKind ...@@ -1623,11 +1632,6 @@ extract_lctxt :: TypeOrKind
-> LHsContext RdrName -> FreeKiTyVars -> RnM FreeKiTyVars -> LHsContext RdrName -> FreeKiTyVars -> RnM FreeKiTyVars
extract_lctxt t_or_k ctxt = extract_ltys t_or_k (unLoc ctxt) extract_lctxt t_or_k ctxt = extract_ltys t_or_k (unLoc ctxt)
extract_sig_tys :: [LHsSigType RdrName] -> FreeKiTyVars -> RnM FreeKiTyVars
extract_sig_tys sig_tys acc
= foldrM (\sig_ty acc -> extract_lty TypeLevel (hsSigType sig_ty) acc)
acc sig_tys
extract_ltys :: TypeOrKind extract_ltys :: TypeOrKind
-> [LHsType RdrName] -> FreeKiTyVars -> RnM FreeKiTyVars -> [LHsType RdrName] -> FreeKiTyVars -> RnM FreeKiTyVars
extract_ltys t_or_k tys acc = foldrM (extract_lty t_or_k) acc tys extract_ltys t_or_k tys acc = foldrM (extract_lty t_or_k) acc tys
......
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeInType #-}
module Bug where
class C p q
data D = D deriving (C (a :: k))
def just_the_deriving( msg ):
return msg[0:msg.find('Filling in method body')]
test('drv001', normal, compile, ['']) test('drv001', normal, compile, [''])
test('drv002', normal, compile, ['']) test('drv002', normal, compile, [''])
test('drv003', normal, compile, ['']) test('drv003', normal, compile, [''])
...@@ -85,3 +88,4 @@ test('T12814', normal, compile, ['-Wredundant-constraints']) ...@@ -85,3 +88,4 @@ test('T12814', normal, compile, ['-Wredundant-constraints'])
test('T13272', normal, compile, ['']) test('T13272', normal, compile, [''])
test('T13272a', normal, compile, ['']) test('T13272a', normal, compile, [''])
test('T13297', normal, compile, ['']) test('T13297', normal, compile, [''])
test('T14331', normal, compile, [''])
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