From 2c94f5a7804ecf84f818a64ba41ca5829621323c Mon Sep 17 00:00:00 2001 From: Łukasz Hanuszczak Date: Sun, 19 Jul 2015 15:57:10 +0200 Subject: Fix logic behind binder type renaming. --- haddock-api/src/Haddock/Backends/Xhtml/Specialize.hs | 11 +++++++---- 1 file changed, 7 insertions(+), 4 deletions(-) (limited to 'haddock-api/src/Haddock/Backends') diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Specialize.hs b/haddock-api/src/Haddock/Backends/Xhtml/Specialize.hs index a9c46463..6a149719 100644 --- a/haddock-api/src/Haddock/Backends/Xhtml/Specialize.hs +++ b/haddock-api/src/Haddock/Backends/Xhtml/Specialize.hs @@ -193,9 +193,11 @@ renameLTyOp (wrap, lname) = (,) wrap <$> located renameName lname renameNameBndr :: SetName name => name -> Rename name name renameNameBndr name = do fv <- ask - when (getOccName name `Set.member` fv) $ - freshName name - renameName name + env <- get + case Map.lookup (getName name) env of + Just name' -> pure name' + Nothing | getOccName name `Set.member` fv -> freshName name + Nothing -> pure name renameName :: SetName name => name -> Rename name name @@ -206,13 +208,14 @@ renameName name = do Nothing -> name -freshName :: SetName name => name -> Rename name () +freshName :: SetName name => name -> Rename name name freshName name = do fv <- ask env <- get let taken = Set.union fv (Set.fromList . map getOccName . Map.keys $ env) let name' = setInternalOccName (findFreshName taken occ) name put $ Map.insert nname name' env + return name' where nname = getName name occ = nameOccName nname -- cgit v1.2.3