Commit b60df0fa authored by Simon Peyton Jones's avatar Simon Peyton Jones
Browse files

Better debug printing

parent a600c913
...@@ -90,7 +90,7 @@ module OccName ( ...@@ -90,7 +90,7 @@ module OccName (
lookupOccEnv, mkOccEnv, mkOccEnv_C, extendOccEnvList, elemOccEnv, lookupOccEnv, mkOccEnv, mkOccEnv_C, extendOccEnvList, elemOccEnv,
occEnvElts, foldOccEnv, plusOccEnv, plusOccEnv_C, extendOccEnv_C, occEnvElts, foldOccEnv, plusOccEnv, plusOccEnv_C, extendOccEnv_C,
extendOccEnv_Acc, filterOccEnv, delListFromOccEnv, delFromOccEnv, extendOccEnv_Acc, filterOccEnv, delListFromOccEnv, delFromOccEnv,
alterOccEnv, alterOccEnv, pprOccEnv,
-- * The 'OccSet' type -- * The 'OccSet' type
OccSet, emptyOccSet, unitOccSet, mkOccSet, extendOccSet, OccSet, emptyOccSet, unitOccSet, mkOccSet, extendOccSet,
...@@ -462,7 +462,10 @@ filterOccEnv x (A y) = A $ filterUFM x y ...@@ -462,7 +462,10 @@ filterOccEnv x (A y) = A $ filterUFM x y
alterOccEnv fn (A y) k = A $ alterUFM fn y k alterOccEnv fn (A y) k = A $ alterUFM fn y k
instance Outputable a => Outputable (OccEnv a) where instance Outputable a => Outputable (OccEnv a) where
ppr (A x) = ppr x ppr x = pprOccEnv ppr x
pprOccEnv :: (a -> SDoc) -> OccEnv a -> SDoc
pprOccEnv ppr_elt (A env) = pprUniqFM ppr_elt env
type OccSet = UniqSet OccName type OccSet = UniqSet OccName
......
...@@ -362,8 +362,9 @@ bindHsTyVars doc mb_assoc kv_bndrs tv_bndrs thing_inside ...@@ -362,8 +362,9 @@ bindHsTyVars doc mb_assoc kv_bndrs tv_bndrs thing_inside
kvs_from_tv_bndrs = [ kv | L _ (KindedTyVar _ kind) <- tvs kvs_from_tv_bndrs = [ kv | L _ (KindedTyVar _ kind) <- tvs
, let (_, kvs) = extractHsTyRdrTyVars kind , let (_, kvs) = extractHsTyRdrTyVars kind
, kv <- kvs ] , kv <- kvs ]
all_kvs = filterOut (`elemLocalRdrEnv` rdr_env) $ all_kvs' = nub (kv_bndrs ++ kvs_from_tv_bndrs)
nub (kv_bndrs ++ kvs_from_tv_bndrs) all_kvs = filterOut (`elemLocalRdrEnv` rdr_env) all_kvs'
overlap_kvs = [ kv | kv <- all_kvs, any ((==) kv . hsLTyVarName) tvs ] overlap_kvs = [ kv | kv <- all_kvs, any ((==) kv . hsLTyVarName) tvs ]
-- These variables appear both as kind and type variables -- These variables appear both as kind and type variables
-- in the same declaration; eg type family T (x :: *) (y :: x) -- in the same declaration; eg type family T (x :: *) (y :: x)
...@@ -397,8 +398,12 @@ bindHsTyVars doc mb_assoc kv_bndrs tv_bndrs thing_inside ...@@ -397,8 +398,12 @@ bindHsTyVars doc mb_assoc kv_bndrs tv_bndrs thing_inside
; (tv_bndrs', fvs1) <- mapFvRn rn_tv_bndr tvs ; (tv_bndrs', fvs1) <- mapFvRn rn_tv_bndr tvs
; (res, fvs2) <- bindLocalNamesFV (map hsLTyVarName tv_bndrs') $ ; (res, fvs2) <- bindLocalNamesFV (map hsLTyVarName tv_bndrs') $
do { env <- getLocalRdrEnv do { inner_rdr_env <- getLocalRdrEnv
; traceRn (text "bhtv" <+> (ppr tvs $$ ppr all_kvs $$ ppr env)) ; traceRn (text "bhtv" <+> vcat
[ ppr tvs, ppr kv_bndrs, ppr kvs_from_tv_bndrs
, ppr $ map (`elemLocalRdrEnv` rdr_env) all_kvs'
, ppr $ map (getUnique . rdrNameOcc) all_kvs'
, ppr all_kvs, ppr rdr_env, ppr inner_rdr_env ])
; thing_inside (HsQTvs { hsq_tvs = tv_bndrs', hsq_kvs = kv_names }) } ; thing_inside (HsQTvs { hsq_tvs = tv_bndrs', hsq_kvs = kv_names }) }
; return (res, fvs1 `plusFV` fvs2) } } ; return (res, fvs1 `plusFV` fvs2) } }
......
...@@ -60,9 +60,10 @@ module UniqFM ( ...@@ -60,9 +60,10 @@ module UniqFM (
eltsUFM, keysUFM, splitUFM, eltsUFM, keysUFM, splitUFM,
ufmToSet_Directly, ufmToSet_Directly,
ufmToList, ufmToList,
joinUFM joinUFM, pprUniqFM
) where ) where
import FastString
import Unique ( Uniquable(..), Unique, getKey ) import Unique ( Uniquable(..), Unique, getKey )
import Outputable import Outputable
...@@ -319,5 +320,11 @@ joinUFM eltJoin l (OldFact old) (NewFact new) = foldUFM_Directly add (NoChange, ...@@ -319,5 +320,11 @@ joinUFM eltJoin l (OldFact old) (NewFact new) = foldUFM_Directly add (NoChange,
\begin{code} \begin{code}
instance Outputable a => Outputable (UniqFM a) where instance Outputable a => Outputable (UniqFM a) where
ppr ufm = ppr (ufmToList ufm) ppr ufm = pprUniqFM ppr ufm
pprUniqFM :: (a -> SDoc) -> UniqFM a -> SDoc
pprUniqFM ppr_elt ufm
= brackets $ fsep $ punctuate comma $
[ ppr uq <+> ptext (sLit ":->") <+> ppr_elt elt
| (uq, elt) <- ufmToList ufm ]
\end{code} \end{code}
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