diff options
author | Moritz Drexl <mdrexl@fastmail.fm> | 2017-08-05 16:44:40 +0200 |
---|---|---|
committer | Alexander Biehl <alexbiehl@gmail.com> | 2017-08-05 16:44:40 +0200 |
commit | 4d765e3cd0a735f9a7e8d13fb6633f9ee534fbfb (patch) | |
tree | 9daee9af367a7c7d54eeef63083a2adbf97ffcfb | |
parent | 74d1173fa022cc8f520ff33c2620507522423e42 (diff) |
Fix renaming after instance signature specializing (#660)
* rework rename
* Add regression test for Bug 613
* update tests
* update changelog
-rw-r--r-- | CHANGES.md | 2 | ||||
-rw-r--r-- | haddock-api/src/Haddock/Interface/Specialize.hs | 132 | ||||
-rw-r--r-- | html-test/ref/Bug613.html | 260 | ||||
-rw-r--r-- | html-test/ref/Instances.html | 178 | ||||
-rw-r--r-- | html-test/src/Bug613.hs | 16 |
5 files changed, 418 insertions, 170 deletions
@@ -2,6 +2,8 @@ * to be released + * Fix renaming of type variables after specializing instance method signatures (#613) + * Move markup related data types to haddock-library ## Changes in version 2.18.1 diff --git a/haddock-api/src/Haddock/Interface/Specialize.hs b/haddock-api/src/Haddock/Interface/Specialize.hs index da8c3e7b..84168151 100644 --- a/haddock-api/src/Haddock/Interface/Specialize.hs +++ b/haddock-api/src/Haddock/Interface/Specialize.hs @@ -17,7 +17,6 @@ import Name import FastString import Control.Monad -import Control.Monad.Trans.Reader import Control.Monad.Trans.State import Data.Data @@ -204,7 +203,7 @@ setInternalOccName occ name = -- | Compute set of free variables of given type. freeVariables :: forall name. (NamedThing name, DataId name) - => HsType name -> Set NameRep + => HsType name -> Set Name freeVariables = everythingWithState Set.empty Set.union query where @@ -213,7 +212,7 @@ freeVariables = (Set.empty, Set.union ctx (bndrsNames bndrs)) Just (HsTyVar _ (L _ name)) | getName name `Set.member` ctx -> (Set.empty, ctx) - | otherwise -> (Set.singleton $ getNameRep name, ctx) + | otherwise -> (Set.singleton $ getName name, ctx) _ -> (Set.empty, ctx) bndrsNames = Set.fromList . map (getName . tyVarName . unLoc) @@ -225,33 +224,36 @@ freeVariables = -- @(a -> b)@ we get @(a -> b) -> b@ where first occurrence of @b@ refers to -- different type variable than latter one. Applying 'rename' function -- will fix that type to be visually unambiguous again (making it something --- like @(a -> c) -> b@). -rename :: SetName name => Set NameRep -> HsType name -> HsType name -rename fv typ = runReader (renameType typ) $ RenameEnv - { rneFV = fv - , rneCtx = Map.empty - } - +-- like @(a -> b0) -> b@). +rename :: (Eq name, DataId name, SetName name) + => Set Name -> HsType name -> HsType name +rename fv typ = evalState (renameType typ) env + where + env = RenameEnv + { rneHeadFVs = Map.fromList . map mkPair . Set.toList $ fv + , rneSigFVs = Set.map getNameRep $ freeVariables typ + , rneCtx = Map.empty + } + mkPair name = (getNameRep name, name) -- | Renaming monad. -type Rename name = Reader (RenameEnv name) - --- | Binding generation monad. -type Rebind name = State (RenameEnv name) +type Rename name = State (RenameEnv name) data RenameEnv name = RenameEnv - { rneFV :: Set NameRep - , rneCtx :: Map Name name - } + { rneHeadFVs :: Map NameRep Name + , rneSigFVs :: Set NameRep + , rneCtx :: Map Name name + } -renameType :: SetName name => HsType name -> Rename name (HsType name) -renameType (HsForAllTy bndrs lt) = rebind bndrs $ \bndrs' -> +renameType :: (Eq name, SetName name) + => HsType name -> Rename name (HsType name) +renameType (HsForAllTy bndrs lt) = HsForAllTy - <$> pure bndrs' + <$> mapM (located renameBinder) bndrs <*> renameLType lt renameType (HsQualTy lctxt lt) = - HsQualTy + HsQualTy <$> located renameContext lctxt <*> renameLType lt renameType (HsTyVar ip name) = HsTyVar ip <$> located renameName name @@ -281,85 +283,61 @@ renameType (HsWildCardTy wc) = pure (HsWildCardTy wc) renameType (HsAppsTy _) = error "HsAppsTy: Only used before renaming" -renameLType :: SetName name => LHsType name -> Rename name (LHsType name) +renameLType :: (Eq name, SetName name) + => LHsType name -> Rename name (LHsType name) renameLType = located renameType -renameLTypes :: SetName name => [LHsType name] -> Rename name [LHsType name] +renameLTypes :: (Eq name, SetName name) + => [LHsType name] -> Rename name [LHsType name] renameLTypes = mapM renameLType -renameContext :: SetName name => HsContext name -> Rename name (HsContext name) +renameContext :: (Eq name, SetName name) + => HsContext name -> Rename name (HsContext name) renameContext = renameLTypes -{- -renameLTyOp :: SetName name => LHsTyOp name -> Rename name (LHsTyOp name) -renameLTyOp (wrap, lname) = (,) wrap <$> located renameName lname --} - - -renameName :: SetName name => name -> Rename name name -renameName name = do - RenameEnv { rneCtx = ctx } <- ask - pure $ fromMaybe name (Map.lookup (getName name) ctx) - - -rebind :: SetName name - => [LHsTyVarBndr name] -> ([LHsTyVarBndr name] -> Rename name a) - -> Rename name a -rebind lbndrs action = do - (lbndrs', env') <- runState (rebindLTyVarBndrs lbndrs) <$> ask - local (const env') (action lbndrs') - -rebindLTyVarBndrs :: SetName name - => [LHsTyVarBndr name] -> Rebind name [LHsTyVarBndr name] -rebindLTyVarBndrs lbndrs = mapM (located rebindTyVarBndr) lbndrs +renameBinder :: (Eq name, SetName name) + => HsTyVarBndr name -> Rename name (HsTyVarBndr name) +renameBinder (UserTyVar lname) = UserTyVar <$> located renameName lname +renameBinder (KindedTyVar lname lkind) = + KindedTyVar <$> located renameName lname <*> located renameType lkind -rebindTyVarBndr :: SetName name - => HsTyVarBndr name -> Rebind name (HsTyVarBndr name) -rebindTyVarBndr (UserTyVar (L l name)) = - UserTyVar . L l <$> rebindName name -rebindTyVarBndr (KindedTyVar name kinds) = - KindedTyVar <$> located rebindName name <*> pure kinds - - -rebindName :: SetName name => name -> Rebind name name -rebindName name = do +-- | Core renaming logic. +renameName :: (Eq name, SetName name) => name -> Rename name name +renameName name = do RenameEnv { .. } <- get - taken <- takenNames case Map.lookup (getName name) rneCtx of - Just name' -> pure name' - Nothing | getNameRep name `Set.member` taken -> freshName name - Nothing -> reuseName name + Nothing + | Just headTv <- Map.lookup (getNameRep name) rneHeadFVs + , headTv /= getName name -> freshName name + Just name' -> return name' + _ -> return name -- | Generate fresh occurrence name, put it into context and return. -freshName :: SetName name => name -> Rebind name name +freshName :: SetName name => name -> Rename name name freshName name = do - env@RenameEnv { .. } <- get taken <- takenNames let name' = setInternalNameRep (findFreshName taken rep) name - put $ env { rneCtx = Map.insert nname name' rneCtx } + modify $ \rne -> rne + { rneCtx = Map.insert (getName name) name' (rneCtx rne) } return name' where nname = getName name rep = getNameRep nname -reuseName :: SetName name => name -> Rebind name name -reuseName name = do - env@RenameEnv { .. } <- get - put $ env { rneCtx = Map.insert (getName name) name rneCtx } - return name - - -takenNames :: NamedThing name => Rebind name (Set NameRep) +takenNames :: NamedThing name => Rename name (Set NameRep) takenNames = do RenameEnv { .. } <- get - return $ Set.union rneFV (ctxElems rneCtx) + return $ headReps rneHeadFVs `Set.union` + rneSigFVs `Set.union` + ctxElems rneCtx where + headReps = Set.fromList . Map.keys ctxElems = Set.fromList . map getNameRep . Map.elems @@ -371,15 +349,7 @@ findFreshName taken = alternativeNames :: NameRep -> [NameRep] -alternativeNames name - | [_] <- nameRepString name = letterNames ++ alternativeNames' name - where - letterNames = map (stringNameRep . pure) ['a'..'z'] -alternativeNames name = alternativeNames' name - - -alternativeNames' :: NameRep -> [NameRep] -alternativeNames' name = +alternativeNames name = [ stringNameRep $ str ++ show i | i :: Int <- [0..] ] where str = nameRepString name diff --git a/html-test/ref/Bug613.html b/html-test/ref/Bug613.html new file mode 100644 index 00000000..924f37d4 --- /dev/null +++ b/html-test/ref/Bug613.html @@ -0,0 +1,260 @@ +<html xmlns="http://www.w3.org/1999/xhtml" +><head + ><meta http-equiv="Content-Type" content="text/html; charset=UTF-8" + /><title + >Bug613</title + ><link href="#" rel="stylesheet" type="text/css" title="Ocean" + /><script src="haddock-util.js" type="text/javascript" + ></script + ><script src="https://cdnjs.cloudflare.com/ajax/libs/mathjax/2.7.0/MathJax.js?config=TeX-AMS-MML_HTMLorMML" type="text/javascript" + ></script + ><script type="text/javascript" + >// +window.onload = function () {pageLoad();}; +// +</script + ></head + ><body + ><div id="package-header" + ><ul class="links" id="page-menu" + ><li + ><a href="#" + >Contents</a + ></li + ><li + ><a href="#" + >Index</a + ></li + ></ul + ><p class="caption empty" + ></p + ></div + ><div id="content" + ><div id="module-header" + ><table class="info" + ><tr + ><th + >Safe Haskell</th + ><td + >Safe</td + ></tr + ></table + ><p class="caption" + >Bug613</p + ></div + ><div id="synopsis" + ><p id="control.syn" class="caption expander" onclick="toggleSection('syn')" + >Synopsis</p + ><ul id="section.syn" class="hide" onclick="toggleSection('syn')" + ><li class="src short" + ><span class="keyword" + >class</span + > <a href="#" + >Functor</a + > f <span class="keyword" + >where</span + ><ul class="subs" + ></ul + ></li + ><li class="src short" + ><span class="keyword" + >data</span + > <a href="#" + >ThreeVars</a + > a0 a b = <a href="#" + >ThreeVars</a + > a b</li + ></ul + ></div + ><div id="interface" + ><h1 + >Documentation</h1 + ><div class="top" + ><p class="src" + ><span class="keyword" + >class</span + > <a id="t:Functor" class="def" + >Functor</a + > f <span class="keyword" + >where</span + > <a href="#" class="selflink" + >#</a + ></p + ><div class="subs minimal" + ><p class="caption" + >Minimal complete definition</p + ><p class="src" + ><a href="#" + >fmap</a + ></p + ></div + ><div class="subs methods" + ><p class="caption" + >Methods</p + ><p class="src" + ><a id="v:fmap" class="def" + >fmap</a + > :: (a -> b) -> f a -> f b <a href="#" class="selflink" + >#</a + ></p + ></div + ><div class="subs instances" + ><p id="control.i:Functor" class="caption collapser" onclick="toggleSection('i:Functor')" + >Instances</p + ><div id="section.i:Functor" class="show" + ><table + ><tr + ><td class="src clearfix" + ><span class="inst-left" + ><span id="control.i:ic:Functor:Functor:1" class="instance expander" onclick="toggleSection('i:ic:Functor:Functor:1')" + ></span + > <a href="#" + >Functor</a + > (<a href="#" + >Either</a + > a)</span + > <a href="#" class="selflink" + >#</a + ></td + ><td class="doc empty" + ></td + ></tr + ><tr + ><td colspan="2" + ><div id="section.i:ic:Functor:Functor:1" class="inst-details hide" + ><div class="subs methods" + ><p class="caption" + >Methods</p + ><p class="src" + ><a href="#" + >fmap</a + > :: (a0 -> b) -> <a href="#" + >Either</a + > a a0 -> <a href="#" + >Either</a + > a b <a href="#" class="selflink" + >#</a + ></p + ></div + ></div + ></td + ></tr + ><tr + ><td class="src clearfix" + ><span class="inst-left" + ><span id="control.i:ic:Functor:Functor:2" class="instance expander" onclick="toggleSection('i:ic:Functor:Functor:2')" + ></span + > <a href="#" + >Functor</a + > (<a href="#" + >ThreeVars</a + > a0 a)</span + > <a href="#" class="selflink" + >#</a + ></td + ><td class="doc empty" + ></td + ></tr + ><tr + ><td colspan="2" + ><div id="section.i:ic:Functor:Functor:2" class="inst-details hide" + ><div class="subs methods" + ><p class="caption" + >Methods</p + ><p class="src" + ><a href="#" + >fmap</a + > :: (a1 -> b) -> <a href="#" + >ThreeVars</a + > a0 a a1 -> <a href="#" + >ThreeVars</a + > a0 a b <a href="#" class="selflink" + >#</a + ></p + ></div + ></div + ></td + ></tr + ></table + ></div + ></div + ></div + ><div class="top" + ><p class="src" + ><span class="keyword" + >data</span + > <a id="t:ThreeVars" class="def" + >ThreeVars</a + > a0 a b <a href="#" class="selflink" + >#</a + ></p + ><div class="doc" + ><p + >Phantom type a0 is added to block the first renaming from a to a0. This ensures that the renamer doesn't create a new conflict</p + ></div + ><div class="subs constructors" + ><p class="caption" + >Constructors</p + ><table + ><tr + ><td class="src" + ><a id="v:ThreeVars" class="def" + >ThreeVars</a + > a b</td + ><td class="doc empty" + ></td + ></tr + ></table + ></div + ><div class="subs instances" + ><p id="control.i:ThreeVars" class="caption collapser" onclick="toggleSection('i:ThreeVars')" + >Instances</p + ><div id="section.i:ThreeVars" class="show" + ><table + ><tr + ><td class="src clearfix" + ><span class="inst-left" + ><span id="control.i:id:ThreeVars:Functor:1" class="instance expander" onclick="toggleSection('i:id:ThreeVars:Functor:1')" + ></span + > <a href="#" + >Functor</a + > (<a href="#" + >ThreeVars</a + > a0 a)</span + > <a href="#" class="selflink" + >#</a + ></td + ><td class="doc empty" + ></td + ></tr + ><tr + ><td colspan="2" + ><div id="section.i:id:ThreeVars:Functor:1" class="inst-details hide" + ><div class="subs methods" + ><p class="caption" + >Methods</p + ><p class="src" + ><a href="#" + >fmap</a + > :: (a1 -> b) -> <a href="#" + >ThreeVars</a + > a0 a a1 -> <a href="#" + >ThreeVars</a + > a0 a b <a href="#" class="selflink" + >#</a + ></p + ></div + ></div + ></td + ></tr + ></table + ></div + ></div + ></div + ></div + ></div + ><div id="footer" + ></div + ></body + ></html +>
\ No newline at end of file diff --git a/html-test/ref/Instances.html b/html-test/ref/Instances.html index b014e8df..c9ca6f82 100644 --- a/html-test/ref/Instances.html +++ b/html-test/ref/Instances.html @@ -102,9 +102,9 @@ window.onload = function () {pageLoad();}; ><~~</a > <a href="#" >Int</a - >) -> a -> a <a href="#" + >) -> a0 -> a <a href="#" ><~~</a - > a <a href="#" class="selflink" + > a0 <a href="#" class="selflink" >#</a ></p ><p class="src" @@ -114,7 +114,7 @@ window.onload = function () {pageLoad();}; ><~~</a > (a <a href="#" ><~~</a - > a)) -> <a href="#" + > a0)) -> <a href="#" >Int</a > -> a <a href="#" ><~~</a @@ -298,9 +298,9 @@ window.onload = function () {pageLoad();}; >Either</a > a <a href="#" >Int</a - > -> a -> <a href="#" + > -> a0 -> <a href="#" >Either</a - > a a <a href="#" class="selflink" + > a a0 <a href="#" class="selflink" >#</a ></p ><p class="src" @@ -310,7 +310,7 @@ window.onload = function () {pageLoad();}; >Either</a > a (<a href="#" >Either</a - > a a) -> <a href="#" + > a a0) -> <a href="#" >Int</a > -> <a href="#" >Either</a @@ -356,13 +356,13 @@ window.onload = function () {pageLoad();}; >foo</a > :: (f a, <a href="#" >Int</a - >) -> a -> (f a, a) <a href="#" class="selflink" + >) -> a0 -> (f a, a0) <a href="#" class="selflink" >#</a ></p ><p class="src" ><a href="#" >foo'</a - > :: (f a, (f a, a)) -> <a href="#" + > :: (f a, (f a, a0)) -> <a href="#" >Int</a > -> (f a, (f a, <a href="#" >Int</a @@ -402,9 +402,9 @@ window.onload = function () {pageLoad();}; ><~~</a > <a href="#" >Int</a - >) -> a -> a <a href="#" + >) -> a0 -> a <a href="#" ><~~</a - > a <a href="#" class="selflink" + > a0 <a href="#" class="selflink" >#</a ></p ><p class="src" @@ -414,7 +414,7 @@ window.onload = function () {pageLoad();}; ><~~</a > (a <a href="#" ><~~</a - > a)) -> <a href="#" + > a0)) -> <a href="#" >Int</a > -> a <a href="#" ><~~</a @@ -456,13 +456,13 @@ window.onload = function () {pageLoad();}; >foo</a > :: (a, a, <a href="#" >Int</a - >) -> a -> (a, a, a) <a href="#" class="selflink" + >) -> a0 -> (a, a, a0) <a href="#" class="selflink" >#</a ></p ><p class="src" ><a href="#" >foo'</a - > :: (a, a, (a, a, a)) -> <a href="#" + > :: (a, a, (a, a, a0)) -> <a href="#" >Int</a > -> (a, a, (a, a, <a href="#" >Int</a @@ -502,9 +502,9 @@ window.onload = function () {pageLoad();}; >Quux</a > a b <a href="#" >Int</a - > -> a -> <a href="#" + > -> a0 -> <a href="#" >Quux</a - > a b a <a href="#" class="selflink" + > a b a0 <a href="#" class="selflink" >#</a ></p ><p class="src" @@ -514,7 +514,7 @@ window.onload = function () {pageLoad();}; >Quux</a > a b (<a href="#" >Quux</a - > a b a) -> <a href="#" + > a b a0) -> <a href="#" >Int</a > -> <a href="#" >Quux</a @@ -562,11 +562,11 @@ window.onload = function () {pageLoad();}; >LiftedRep</a >) a <a href="#" >Int</a - > -> a -> (<a href="#" + > -> a0 -> (<a href="#" >LiftedRep</a > -> <a href="#" >LiftedRep</a - >) a a <a href="#" class="selflink" + >) a a0 <a href="#" class="selflink" >#</a ></p ><p class="src" @@ -580,7 +580,7 @@ window.onload = function () {pageLoad();}; >LiftedRep</a > -> <a href="#" >LiftedRep</a - >) a a) -> <a href="#" + >) a a0) -> <a href="#" >Int</a > -> (<a href="#" >LiftedRep</a @@ -1002,19 +1002,19 @@ window.onload = function () {pageLoad();}; ><p class="src" ><a href="#" >bar'</a - > :: (a, b, (a, b, (a, b, a))) -> (a, b, (a, b, (a, b, b))) <a href="#" class="selflink" + > :: (a, b, (a, b, (a, b, a))) -> (a, b, (a, b, (a, b, b0))) <a href="#" class="selflink" >#</a ></p ><p class="src" ><a href="#" >bar0</a - > :: ((a, b, (a, b, a)), (a, b, (a, b, a))) -> ((a, b, b), (a, b, c)) <a href="#" class="selflink" + > :: ((a, b, (a, b, a)), (a, b, (a, b, a))) -> ((a, b, b0), (a, b, c)) <a href="#" class="selflink" >#</a ></p ><p class="src" ><a href="#" >bar1</a - > :: ((a, b, (a, b, a)), (a, b, (a, b, a))) -> ((a, b, b), (a, b, c)) <a href="#" class="selflink" + > :: ((a, b, (a, b, a)), (a, b, (a, b, a))) -> ((a, b, b0), (a, b, c)) <a href="#" class="selflink" >#</a ></p ></div @@ -1076,7 +1076,7 @@ window.onload = function () {pageLoad();}; >Quux</a > a c (<a href="#" >Quux</a - > a c b)) <a href="#" class="selflink" + > a c b0)) <a href="#" class="selflink" >#</a ></p ><p class="src" @@ -1092,9 +1092,9 @@ window.onload = function () {pageLoad();}; >Quux</a > a b c)) -> (<a href="#" >Quux</a - > a c b, <a href="#" + > a c b0, <a href="#" >Quux</a - > a c c) <a href="#" class="selflink" + > a c c0) <a href="#" class="selflink" >#</a ></p ><p class="src" @@ -1110,9 +1110,9 @@ window.onload = function () {pageLoad();}; >Quux</a > a b c)) -> (<a href="#" >Quux</a - > a c b, <a href="#" + > a c b0, <a href="#" >Quux</a - > a c c) <a href="#" class="selflink" + > a c c0) <a href="#" class="selflink" >#</a ></p ></div @@ -1202,7 +1202,7 @@ window.onload = function () {pageLoad();}; >forall</span > a. a -> a) -> (b, <span class="keyword" >forall</span - > a. a -> [c]) -> (b, c) <a href="#" class="selflink" + > c0. c0 -> [c]) -> (b, c1) <a href="#" class="selflink" >#</a ></p ><p class="src" @@ -1222,9 +1222,9 @@ window.onload = function () {pageLoad();}; >forall</span > b. (<span class="keyword" >forall</span - > a. a -> [c]) -> c) -> <span class="keyword" + > b. b -> [c]) -> c0) -> <span class="keyword" >forall</span - > a. a -> b <a href="#" class="selflink" + > c1. c1 -> b <a href="#" class="selflink" >#</a ></p ></div @@ -1256,31 +1256,31 @@ window.onload = function () {pageLoad();}; >baz</a > :: (a -> b) -> (<span class="keyword" >forall</span - > c. c -> c) -> (b, <span class="keyword" + > a0. a0 -> a0) -> (b0, <span class="keyword" >forall</span - > c. c -> a -> b) -> (b, c) <a href="#" class="selflink" + > c. c -> a -> b) -> (b0, c) <a href="#" class="selflink" >#</a ></p ><p class="src" ><a href="#" >baz'</a - > :: b -> (<span class="keyword" + > :: b0 -> (<span class="keyword" >forall</span - > c. c -> a -> b) -> (<span class="keyword" + > b1. b1 -> a -> b) -> (<span class="keyword" >forall</span - > c. c -> a -> b) -> [(b, a -> b)] <a href="#" class="selflink" + > b2. b2 -> a -> b) -> [(b0, a -> b)] <a href="#" class="selflink" >#</a ></p ><p class="src" ><a href="#" >baz''</a - > :: b -> (<span class="keyword" + > :: b0 -> (<span class="keyword" >forall</span - > c. (<span class="keyword" + > b1. (<span class="keyword" >forall</span - > d. d -> a -> b) -> c) -> <span class="keyword" + > b2. b2 -> a -> b) -> c) -> <span class="keyword" >forall</span - > c. c -> b <a href="#" class="selflink" + > c. c -> b0 <a href="#" class="selflink" >#</a ></p ></div @@ -1312,31 +1312,31 @@ window.onload = function () {pageLoad();}; >baz</a > :: (a, b, c) -> (<span class="keyword" >forall</span - > d. d -> d) -> (b, <span class="keyword" + > a0. a0 -> a0) -> (b0, <span class="keyword" >forall</span - > d. d -> (a, b, c)) -> (b, c) <a href="#" class="selflink" + > c0. c0 -> (a, b, c)) -> (b0, c1) <a href="#" class="selflink" >#</a ></p ><p class="src" ><a href="#" >baz'</a - > :: b -> (<span class="keyword" + > :: b0 -> (<span class="keyword" >forall</span - > d. d -> (a, b, c)) -> (<span class="keyword" + > b1. b1 -> (a, b, c)) -> (<span class="keyword" >forall</span - > d. d -> (a, b, c)) -> [(b, (a, b, c))] <a href="#" class="selflink" + > b2. b2 -> (a, b, c)) -> [(b0, (a, b, c))] <a href="#" class="selflink" >#</a ></p ><p class="src" ><a href="#" >baz''</a - > :: b -> (<span class="keyword" + > :: b0 -> (<span class="keyword" >forall</span - > d. (<span class="keyword" + > b1. (<span class="keyword" >forall</span - > e. e -> (a, b, c)) -> c) -> <span class="keyword" + > b2. b2 -> (a, b, c)) -> c0) -> <span class="keyword" >forall</span - > d. d -> b <a href="#" class="selflink" + > c1. c1 -> b0 <a href="#" class="selflink" >#</a ></p ></div @@ -1372,25 +1372,25 @@ window.onload = function () {pageLoad();}; >Quux</a > a b c -> (<span class="keyword" >forall</span - > d. d -> d) -> (b, <span class="keyword" + > a0. a0 -> a0) -> (b0, <span class="keyword" >forall</span - > d. d -> <a href="#" + > c0. c0 -> <a href="#" >Quux</a - > a b c) -> (b, c) <a href="#" class="selflink" + > a b c) -> (b0, c1) <a href="#" class="selflink" >#</a ></p ><p class="src" ><a href="#" >baz'</a - > :: b -> (<span class="keyword" + > :: b0 -> (<span class="keyword" >forall</span - > d. d -> <a href="#" + > b1. b1 -> <a href="#" >Quux</a > a b c) -> (<span class="keyword" >forall</span - > d. d -> <a href="#" + > b2. b2 -> <a href="#" >Quux</a - > a b c) -> [(b, <a href="#" + > a b c) -> [(b0, <a href="#" >Quux</a > a b c)] <a href="#" class="selflink" >#</a @@ -1398,15 +1398,15 @@ window.onload = function () {pageLoad();}; ><p class="src" ><a href="#" >baz''</a - > :: b -> (<span class="keyword" + > :: b0 -> (<span class="keyword" >forall</span - > d. (<span class="keyword" + > b1. (<span class="keyword" >forall</span - > e. e -> <a href="#" + > b2. b2 -> <a href="#" >Quux</a - > a b c) -> c) -> <span class="keyword" + > a b c) -> c0) -> <span class="keyword" >forall</span - > d. d -> b <a href="#" class="selflink" + > c1. c1 -> b0 <a href="#" class="selflink" >#</a ></p ></div @@ -1438,31 +1438,31 @@ window.onload = function () {pageLoad();}; >baz</a > :: (a, [b], b, a) -> (<span class="keyword" >forall</span - > c. c -> c) -> (b, <span class="keyword" + > a0. a0 -> a0) -> (b0, <span class="keyword" >forall</span - > c. c -> (a, [b], b, a)) -> (b, c) <a href="#" class="selflink" + > c. c -> (a, [b], b, a)) -> (b0, c) <a href="#" class="selflink" >#</a ></p ><p class="src" ><a href="#" >baz'</a - > :: b -> (<span class="keyword" + > :: b0 -> (<span class="keyword" >forall</span - > c. c -> (a, [b], b, a)) -> (<span class="keyword" + > b1. b1 -> (a, [b], b, a)) -> (<span class="keyword" >forall</span - > c. c -> (a, [b], b, a)) -> [(b, (a, [b], b, a))] <a href="#" class="selflink" + > b2. b2 -> (a, [b], b, a)) -> [(b0, (a, [b], b, a))] <a href="#" class="selflink" >#</a ></p ><p class="src" ><a href="#" >baz''</a - > :: b -> (<span class="keyword" + > :: b0 -> (<span class="keyword" >forall</span - > c. (<span class="keyword" + > b1. (<span class="keyword" >forall</span - > d. d -> (a, [b], b, a)) -> c) -> <span class="keyword" + > b2. b2 -> (a, [b], b, a)) -> c) -> <span class="keyword" >forall</span - > c. c -> b <a href="#" class="selflink" + > c. c -> b0 <a href="#" class="selflink" >#</a ></p ></div @@ -1546,9 +1546,9 @@ window.onload = function () {pageLoad();}; >Quux</a > a b <a href="#" >Int</a - > -> a -> <a href="#" + > -> a0 -> <a href="#" >Quux</a - > a b a <a href="#" class="selflink" + > a b a0 <a href="#" class="selflink" >#</a ></p ><p class="src" @@ -1558,7 +1558,7 @@ window.onload = function () {pageLoad();}; >Quux</a > a b (<a href="#" >Quux</a - > a b a) -> <a href="#" + > a b a0) -> <a href="#" >Int</a > -> <a href="#" >Quux</a @@ -1628,7 +1628,7 @@ window.onload = function () {pageLoad();}; >Quux</a > a c (<a href="#" >Quux</a - > a c b)) <a href="#" class="selflink" + > a c b0)) <a href="#" class="selflink" >#</a ></p ><p class="src" @@ -1644,9 +1644,9 @@ window.onload = function () {pageLoad();}; >Quux</a > a b c)) -> (<a href="#" >Quux</a - > a c b, <a href="#" + > a c b0, <a href="#" >Quux</a - > a c c) <a href="#" class="selflink" + > a c c0) <a href="#" class="selflink" >#</a ></p ><p class="src" @@ -1662,9 +1662,9 @@ window.onload = function () {pageLoad();}; >Quux</a > a b c)) -> (<a href="#" >Quux</a - > a c b, <a href="#" + > a c b0, <a href="#" >Quux</a - > a c c) <a href="#" class="selflink" + > a c c0) <a href="#" class="selflink" >#</a ></p ></div @@ -1700,25 +1700,25 @@ window.onload = function () {pageLoad();}; >Quux</a > a b c -> (<span class="keyword" >forall</span - > d. d -> d) -> (b, <span class="keyword" + > a0. a0 -> a0) -> (b0, <span class="keyword" >forall</span - > d. d -> <a href="#" + > c0. c0 -> <a href="#" >Quux</a - > a b c) -> (b, c) <a href="#" class="selflink" + > a b c) -> (b0, c1) <a href="#" class="selflink" >#</a ></p ><p class="src" ><a href="#" >baz'</a - > :: b -> (<span class="keyword" + > :: b0 -> (<span class="keyword" >forall</span - > d. d -> <a href="#" + > b1. b1 -> <a href="#" >Quux</a > a b c) -> (<span class="keyword" >forall</span - > d. d -> <a href="#" + > b2. b2 -> <a href="#" >Quux</a - > a b c) -> [(b, <a href="#" + > a b c) -> [(b0, <a href="#" >Quux</a > a b c)] <a href="#" class="selflink" >#</a @@ -1726,15 +1726,15 @@ window.onload = function () {pageLoad();}; ><p class="src" ><a href="#" >baz''</a - > :: b -> (<span class="keyword" + > :: b0 -> (<span class="keyword" >forall</span - > d. (<span class="keyword" + > b1. (<span class="keyword" >forall</span - > e. e -> <a href="#" + > b2. b2 -> <a href="#" >Quux</a - > a b c) -> c) -> <span class="keyword" + > a b c) -> c0) -> <span class="keyword" >forall</span - > d. d -> b <a href="#" class="selflink" + > c1. c1 -> b0 <a href="#" class="selflink" >#</a ></p ></div diff --git a/html-test/src/Bug613.hs b/html-test/src/Bug613.hs new file mode 100644 index 00000000..effef695 --- /dev/null +++ b/html-test/src/Bug613.hs @@ -0,0 +1,16 @@ +module Bug613 where + +import Prelude (Either(Left, Right)) + +class Functor f where + fmap :: (a -> b) -> f a -> f b + +instance Functor (Either a) where + fmap _ (Left x) = Left x + fmap f (Right y) = Right (f y) + +-- | Phantom type a0 is added to block the first renaming from a to a0. This ensures that the renamer doesn't create a new conflict +data ThreeVars a0 a b = ThreeVars a b + +instance Functor (ThreeVars a0 a) where + fmap f (ThreeVars a b) = ThreeVars a (f b) |