Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
Glasgow Haskell Compiler
GHC
Commits
37182fa8
Commit
37182fa8
authored
Jun 12, 2014
by
Simon Peyton Jones
Committed by
Austin Seipp
Jun 30, 2014
Browse files
Better debug printing
(cherry picked from commit
b60df0fa
)
parent
dfbe251a
Changes
3
Hide whitespace changes
Inline
Side-by-side
compiler/basicTypes/OccName.lhs
View file @
37182fa8
...
...
@@ -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
...
...
compiler/rename/RnTypes.lhs
View file @
37182fa8
...
...
@@ -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) } }
...
...
compiler/utils/UniqFM.lhs
View file @
37182fa8
...
...
@@ -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}
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment