From 161c73d55de958d6371fcad08da0263e17bf9f5f Mon Sep 17 00:00:00 2001 From: Simon Peyton Jones <simonpj@microsoft.com> Date: Tue, 24 Jun 2014 13:24:36 +0100 Subject: [PATCH] Add Note [Placeholder PatSyn kinds] in TcBinds This is just documentation for the fix to Trac #9161 (cherry picked from commit 0757831eaca96c8ebfd99fc51427560d3568cffa) --- compiler/typecheck/TcBinds.lhs | 44 +++++++++++++++++++++++++--------- compiler/typecheck/TcEnv.lhs | 3 +++ 2 files changed, 36 insertions(+), 11 deletions(-) diff --git a/compiler/typecheck/TcBinds.lhs b/compiler/typecheck/TcBinds.lhs index 65ad0011aaa6..f1c98d28dce2 100644 --- a/compiler/typecheck/TcBinds.lhs +++ b/compiler/typecheck/TcBinds.lhs @@ -270,6 +270,30 @@ time by defaulting. No no no. However [Oct 10] this is all handled automatically by the untouchable-range idea. +Note [Placeholder PatSyn kinds] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider this (Trac #9161) + + {-# LANGUAGE PatternSynonyms, DataKinds #-} + pattern A = () + b :: A + b = undefined + +Here, the type signature for b mentions A. But A is a pattern +synonym, which is typechecked (for very good reasons; a view pattern +in the RHS may mention a value binding) as part of a group of +bindings. It is entirely resonable to reject this, but to do so +we need A to be in the kind environment when kind-checking the signature for B. + +Hence the tcExtendKindEnv2 patsyn_placeholder_kinds, which adds a binding + A -> AGlobal (AConLike (PatSynCon _|_)) +to the environment. Then TcHsType.tcTyVar will find A in the kind environment, +and will give a 'wrongThingErr' as a result. But the lookup of A won't fail. + +The _|_ (= panic "fakePatSynCon") works because the wrongThingErr call, in +tcTyVar, doesn't look inside the TcTyThing. + + \begin{code} tcValBinds :: TopLevelFlag -> [(RecFlag, LHsBinds Name)] -> [LSig Name] @@ -277,12 +301,9 @@ tcValBinds :: TopLevelFlag -> TcM ([(RecFlag, LHsBinds TcId)], thing) tcValBinds top_lvl binds sigs thing_inside - = 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] $ + = do { -- Typecheck the signature + ; (poly_ids, sig_fn) <- tcExtendKindEnv2 patsyn_placeholder_kinds $ + -- See Note [Placeholder PatSyn kinds] tcTySigs sigs ; let prag_fn = mkPragFun sigs (foldr (unionBags . snd) emptyBag binds) @@ -294,11 +315,12 @@ tcValBinds top_lvl binds sigs thing_inside 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" + patsyn_placeholder_kinds -- See Note [Placeholder PatSyn kinds] + = [ (name, placeholder_patsyn_tything) + | (_, lbinds) <- binds + , L _ (PatSynBind{ patsyn_id = L _ name }) <- bagToList lbinds ] + placeholder_patsyn_tything + = AGlobal $ AConLike $ PatSynCon $ panic "fakePatSynCon" ------------------------ tcBindGroups :: TopLevelFlag -> TcSigFun -> PragFun diff --git a/compiler/typecheck/TcEnv.lhs b/compiler/typecheck/TcEnv.lhs index a077f5d1d748..d9ce851b44dc 100644 --- a/compiler/typecheck/TcEnv.lhs +++ b/compiler/typecheck/TcEnv.lhs @@ -872,6 +872,9 @@ notFound name } wrongThingErr :: String -> TcTyThing -> Name -> TcM a +-- It's important that this only calls pprTcTyThingCategory, which in +-- turn does not look at the details of the TcTyThing. +-- See Note [Placeholder PatSyn kinds] in TcBinds wrongThingErr expected thing name = failWithTc (pprTcTyThingCategory thing <+> quotes (ppr name) <+> ptext (sLit "used as a") <+> text expected) -- GitLab