Commit aa3166f4 authored by cactus's avatar cactus

Add fake entries into the global kind environment for pattern synonyms.

This is needed to give meaningful error messages (instead of internal
panics) when a program tries to lift a pattern synonym into a kind.
(fixes T9161)
parent 48abb88b
......@@ -281,19 +281,28 @@ tcValBinds :: TopLevelFlag
-> TcM ([(RecFlag, LHsBinds TcId)], thing)
tcValBinds top_lvl binds sigs thing_inside
= do { -- Typecheck the signature
(poly_ids, sig_fn) <- tcTySigs sigs
= do { -- Add fake entries for pattern synonyms so that
-- precise error messages can be generated when
-- trying to use a pattern synonym as a kind
traceTc "Fake lifted patsyns:" (vcat (map ppr patsyns))
-- Typecheck the signature
; (poly_ids, sig_fn) <- tcExtendKindEnv2 [(patsyn, fakePatSynCon) | patsyn <- patsyns] $
tcTySigs sigs
; let prag_fn = mkPragFun sigs (foldr (unionBags . snd) emptyBag binds)
-- Extend the envt right away with all
-- the Ids declared with type signatures
-- Use tcExtendIdEnv2 to avoid extending the TcIdBinder stack
; (binds', thing) <- tcExtendIdEnv2 [(idName id, id) | id <- poly_ids] $
tcBindGroups top_lvl sig_fn prag_fn
binds thing_inside
; return (binds', thing) }
; tcExtendIdEnv2 [(idName id, id) | id <- poly_ids] $
tcBindGroups top_lvl sig_fn prag_fn
binds thing_inside }
where
patsyns = [ name
| (_, lbinds) <- binds
, L _ (PatSynBind{ patsyn_id = L _ name }) <- bagToList lbinds
]
fakePatSynCon = AGlobal $ AConLike $ PatSynCon $ panic "fakePatSynCon"
------------------------
tcBindGroups :: TopLevelFlag -> TcSigFun -> PragFun
......
......@@ -625,7 +625,6 @@ tcTyVar :: Name -> TcM (TcType, TcKind)
tcTyVar name -- Could be a tyvar, a tycon, or a datacon
= do { traceTc "lk1" (ppr name)
; thing <- tcLookup name
; traceTc "lk2" (ppr name <+> ppr thing)
; case thing of
ATyVar _ tv
| isKindVar tv
......
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE DataKinds #-}
pattern PATTERN = ()
wrongLift :: PATTERN
wrongLift = undefined
T9161-1.hs:6:14:
Pattern synonym ‘PATTERN’ used as a type
In the type signature for ‘wrongLift’: wrongLift :: PATTERN
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE DataKinds, KindSignatures, PolyKinds #-}
pattern PATTERN = ()
data Proxy (tag :: k) (a :: *)
wrongLift :: Proxy PATTERN ()
wrongLift = undefined
T9161-2.hs:8:20:
Pattern synonym ‘PATTERN’ used as a type
In the type signature for ‘wrongLift’:
wrongLift :: Proxy PATTERN ()
......@@ -4,3 +4,5 @@ test('unidir', normal, compile_fail, [''])
test('local', normal, compile_fail, [''])
test('T8961', normal, multimod_compile_fail, ['T8961',''])
test('as-pattern', normal, compile_fail, [''])
test('T9161-1', normal, compile_fail, [''])
test('T9161-2', normal, compile_fail, [''])
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