From fb62902d37e9467364bbbafc9e06128be89a7277 Mon Sep 17 00:00:00 2001 From: Łukasz Hanuszczak Date: Fri, 24 Jul 2015 19:32:22 +0200 Subject: Fix yet another renamer bug where some names were not unique. --- haddock-api/src/Haddock/Backends/Xhtml/Specialize.hs | 14 +++++++++++--- 1 file changed, 11 insertions(+), 3 deletions(-) (limited to 'haddock-api/src/Haddock/Backends/Xhtml/Specialize.hs') diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Specialize.hs b/haddock-api/src/Haddock/Backends/Xhtml/Specialize.hs index 38ec7d44..a8a4e8ec 100644 --- a/haddock-api/src/Haddock/Backends/Xhtml/Specialize.hs +++ b/haddock-api/src/Haddock/Backends/Xhtml/Specialize.hs @@ -296,9 +296,10 @@ rebindTyVarBndr (KindedTyVar name kinds) = rebindName :: SetName name => name -> Rebind name name rebindName name = do RenameEnv { .. } <- get + taken <- takenNames case Map.lookup (getName name) rneCtx of Just name' -> pure name' - Nothing | getNameRep name `Set.member` rneFV -> freshName name + Nothing | getNameRep name `Set.member` taken -> freshName name Nothing -> reuseName name @@ -306,12 +307,11 @@ rebindName name = do freshName :: SetName name => name -> Rebind name name freshName name = do env@RenameEnv { .. } <- get - let taken = Set.union rneFV (elems' rneCtx) + taken <- takenNames let name' = setInternalNameRep (findFreshName taken rep) name put $ env { rneCtx = Map.insert nname name' rneCtx } return name' where - elems' = Set.fromList . map getNameRep . Map.elems nname = getName name rep = getNameRep nname @@ -323,6 +323,14 @@ reuseName name = do return name +takenNames :: NamedThing name => Rebind name (Set NameRep) +takenNames = do + RenameEnv { .. } <- get + return $ Set.union rneFV (ctxElems rneCtx) + where + ctxElems = Set.fromList . map getNameRep . Map.elems + + findFreshName :: Set NameRep -> NameRep -> NameRep findFreshName taken = fromJust . List.find isFresh . alternativeNames -- cgit v1.2.3