diff options
author | Ćukasz Hanuszczak <lukasz.hanuszczak@gmail.com> | 2015-07-24 19:32:22 +0200 |
---|---|---|
committer | Mateusz Kowalczyk <fuuzetsu@fuuzetsu.co.uk> | 2015-08-21 18:22:32 +0100 |
commit | fb62902d37e9467364bbbafc9e06128be89a7277 (patch) | |
tree | 049fd05ae91dfca40a9e2c9e6ad9084547d1a923 /haddock-api/src/Haddock/Backends/Xhtml | |
parent | a66852d67fa3a035eaa255880fb82f6f499d7e39 (diff) |
Fix yet another renamer bug where some names were not unique.
Diffstat (limited to 'haddock-api/src/Haddock/Backends/Xhtml')
-rw-r--r-- | haddock-api/src/Haddock/Backends/Xhtml/Specialize.hs | 14 |
1 files changed, 11 insertions, 3 deletions
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 |