Commit 37182fa8 authored by Simon Peyton Jones's avatar Simon Peyton Jones Committed by Austin Seipp
Browse files

Better debug printing

(cherry picked from commit b60df0fa)
parent dfbe251a
......@@ -86,7 +86,7 @@ module OccName (
lookupOccEnv, mkOccEnv, mkOccEnv_C, extendOccEnvList, elemOccEnv,
occEnvElts, foldOccEnv, plusOccEnv, plusOccEnv_C, extendOccEnv_C,
extendOccEnv_Acc, filterOccEnv, delListFromOccEnv, delFromOccEnv,
alterOccEnv,
alterOccEnv, pprOccEnv,
-- * The 'OccSet' type
OccSet, emptyOccSet, unitOccSet, mkOccSet, extendOccSet,
......@@ -416,7 +416,10 @@ filterOccEnv x (A y) = A $ filterUFM x y
alterOccEnv fn (A y) k = A $ alterUFM fn y k
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
......
......@@ -360,8 +360,9 @@ bindHsTyVars doc mb_assoc kv_bndrs tv_bndrs thing_inside
kvs_from_tv_bndrs = [ kv | L _ (KindedTyVar _ kind) <- tvs
, let (_, kvs) = extractHsTyRdrTyVars kind
, kv <- kvs ]
all_kvs = filterOut (`elemLocalRdrEnv` rdr_env) $
nub (kv_bndrs ++ kvs_from_tv_bndrs)
all_kvs' = 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 ]
-- These variables appear both as kind and type variables
-- in the same declaration; eg type family T (x :: *) (y :: x)
......@@ -395,8 +396,12 @@ bindHsTyVars doc mb_assoc kv_bndrs tv_bndrs thing_inside
; (tv_bndrs', fvs1) <- mapFvRn rn_tv_bndr tvs
; (res, fvs2) <- bindLocalNamesFV (map hsLTyVarName tv_bndrs') $
do { env <- getLocalRdrEnv
; traceRn (text "bhtv" <+> (ppr tvs $$ ppr all_kvs $$ ppr env))
do { inner_rdr_env <- getLocalRdrEnv
; 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 }) }
; return (res, fvs1 `plusFV` fvs2) } }
......
......@@ -59,9 +59,10 @@ module UniqFM (
lookupWithDefaultUFM, lookupWithDefaultUFM_Directly,
eltsUFM, keysUFM, splitUFM,
ufmToList,
joinUFM
joinUFM, pprUniqFM
) where
import FastString
import Unique ( Uniquable(..), Unique, getKey )
import Outputable
......@@ -315,5 +316,11 @@ joinUFM eltJoin l (OldFact old) (NewFact new) = foldUFM_Directly add (NoChange,
\begin{code}
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}
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