Commit 6305674f authored by Simon Peyton Jones's avatar Simon Peyton Jones

Fix used-variable calculation (Trac #12548)

The used-variable calculation for pattern synonyms is a little
tricky, for reasons described in RnBinds
Note [Pattern synonym builders don't yield dependencies]

It was right semantically, but the "unused-variable warning" was
wrong, which led to Trac #12548.
parent 517d03e4
......@@ -78,7 +78,8 @@ module HsUtils(
collectLStmtsBinders, collectStmtsBinders,
collectLStmtBinders, collectStmtBinders,
hsLTyClDeclBinders, hsTyClForeignBinders, hsPatSynSelectors,
hsLTyClDeclBinders, hsTyClForeignBinders,
hsPatSynSelectors, getPatSynBinds,
hsForeignDeclsBinders, hsGroupBinders, hsDataFamInstBinders,
hsDataDefnBinders,
......@@ -976,6 +977,11 @@ addPatSynSelector bind sels
= map (unLoc . recordPatSynSelectorId) as ++ sels
| otherwise = sels
getPatSynBinds :: [(RecFlag, LHsBinds id)] -> [PatSynBind id id]
getPatSynBinds binds
= [ psb | (_, lbinds) <- binds
, L _ (PatSynBind psb) <- bagToList lbinds ]
-------------------
hsLInstDeclBinders :: LInstDecl name -> ([Located name], [LFieldOcc name])
hsLInstDeclBinders (L _ (ClsInstD { cid_inst = ClsInstDecl { cid_datafam_insts = dfis } }))
......
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE ScopedTypeVariables, BangPatterns #-}
{-
(c) The GRASP/AQUA Project, Glasgow University, 1992-1998
......@@ -285,15 +285,24 @@ rnValBindsRHS :: HsSigCtxt
rnValBindsRHS ctxt (ValBindsIn mbinds sigs)
= do { (sigs', sig_fvs) <- renameSigs ctxt sigs
; binds_w_dus <- mapBagM (rnLBind (mkSigTvFn sigs')) mbinds
; case depAnalBinds binds_w_dus of
(anal_binds, anal_dus) -> return (valbind', valbind'_dus)
where
valbind' = ValBindsOut anal_binds sigs'
valbind'_dus = anal_dus `plusDU` usesOnly sig_fvs
-- Put the sig uses *after* the bindings
-- so that the binders are removed from
-- the uses in the sigs
}
; let !(anal_binds, anal_dus) = depAnalBinds binds_w_dus
; let patsyn_fvs = foldr (unionNameSet . psb_fvs) emptyNameSet $
getPatSynBinds anal_binds
-- The uses in binds_w_dus for PatSynBinds do not include
-- variables used in the patsyn builders; see
-- Note [Pattern synonym builders don't yield dependencies]
-- But psb_fvs /does/ include those builder fvs. So we
-- add them back in here to avoid bogus warnings about
-- unused variables (Trac #12548)
valbind'_dus = anal_dus `plusDU` usesOnly sig_fvs
`plusDU` usesOnly patsyn_fvs
-- Put the sig uses *after* the bindings
-- so that the binders are removed from
-- the uses in the sigs
; return (ValBindsOut anal_binds sigs', valbind'_dus) }
rnValBindsRHS _ b = pprPanic "rnValBindsRHS" (ppr b)
......@@ -665,18 +674,18 @@ rnPatSynBind sig_fn bind@(PSB { psb_id = L l name
-- As well as dependency analysis, we need these for the
-- MonoLocalBinds test in TcBinds.decideGeneralisationPlan
; let bind' = bind{ psb_args = details'
bind' = bind{ psb_args = details'
, psb_def = pat'
, psb_dir = dir'
, psb_fvs = fvs' }
; let selector_names = case details' of
selector_names = case details' of
RecordPatSyn names ->
map (unLoc . recordPatSynSelectorId) names
_ -> []
; fvs' `seq` -- See Note [Free-variable space leak]
return (bind', name : selector_names , fvs1)
-- See Note [Pattern synonym builders don't yield dependencies]
-- Why fvs1? See Note [Pattern synonym builders don't yield dependencies]
}
where
lookupVar = wrapLocM lookupOccRn
......@@ -702,17 +711,24 @@ f (P x) = C2 x
In this case, 'P' needs to be typechecked in two passes:
1. Typecheck the pattern definition of 'P', which fully determines the
type of 'P'. This step doesn't require knowing anything about 'f',
since the builder definition is not looked at.
type of 'P'. This step doesn't require knowing anything about 'f',
since the builder definition is not looked at.
2. Typecheck the builder definition, which needs the typechecked
definition of 'f' to be in scope.
definition of 'f' to be in scope; done by calls oo tcPatSynBuilderBind
in TcBinds.tcValBinds.
This behaviour is implemented in 'tcValBinds', but it crucially
depends on 'P' not being put in a recursive group with 'f' (which
would make it look like a recursive pattern synonym a la 'pattern P =
P' which is unsound and rejected).
So:
* We do not include builder fvs in the Uses returned by rnPatSynBind
(which is then used for dependency analysis)
* But we /do/ include them in the psb_fvs for the PatSynBind
* In rnValBinds we record these builder uses, to avoid bogus
unused-variable warnings (Trac #12548)
-}
{- *********************************************************************
......
......@@ -302,6 +302,7 @@ tcValBinds top_lvl binds sigs thing_inside
{ (binds', (extra_binds', thing)) <- tcBindGroups top_lvl sig_fn prag_fn binds $ do
{ thing <- thing_inside
-- See Note [Pattern synonym builders don't yield dependencies]
-- in RnBinds
; patsyn_builders <- mapM tcPatSynBuilderBind patsyns
; let extra_binds = [ (NonRecursive, builder) | builder <- patsyn_builders ]
; return (extra_binds, thing) }
......
......@@ -40,7 +40,7 @@ module TcEnv(
wrongThingErr, pprBinders,
tcAddDataFamConPlaceholders, tcAddPatSynPlaceholders,
getPatSynBinds, getTypeSigNames,
getTypeSigNames,
tcExtendRecEnv, -- For knot-tying
-- Instances
......@@ -99,7 +99,6 @@ import Module
import Outputable
import Encoding
import FastString
import Bag
import ListSetOps
import Util
import Maybes( MaybeErr(..) )
......@@ -588,12 +587,6 @@ tcAddPatSynPlaceholders pat_syns thing_inside
| PSB{ psb_id = L _ name } <- pat_syns ]
thing_inside
getPatSynBinds :: [(RecFlag, LHsBinds Name)] -> [PatSynBind Name Name]
getPatSynBinds binds
= [ psb | (_, lbinds) <- binds
, L _ (PatSynBind psb) <- bagToList lbinds ]
getTypeSigNames :: [LSig Name] -> NameSet
-- Get the names that have a user type sig
getTypeSigNames sigs
......
{-# OPTIONS_GHC -Wunused-binds #-}
{-# LANGUAGE PatternSynonyms #-}
module Foo (pattern P) where
-- x is used!!
x :: Int
x = 0
pattern P :: Int
pattern P <- _ where
P = x
......@@ -244,3 +244,4 @@ test('T12127',
['T12127', '-v0'])
test('T12533', normal, compile, [''])
test('T12597', normal, compile, [''])
test('T12548', 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