From 6ccf78e15a525282fef61bc4f58a279aa9c21771 Mon Sep 17 00:00:00 2001
From: David Waern <david.waern@gmail.com>
Date: Fri, 28 Sep 2012 19:50:20 +0200
Subject: Fix spurious superclass constraints bug.

---
 src/Haddock/Interface/AttachInstances.hs | 31 +++++++++++++++++++++++--------
 1 file changed, 23 insertions(+), 8 deletions(-)

(limited to 'src/Haddock/Interface')

diff --git a/src/Haddock/Interface/AttachInstances.hs b/src/Haddock/Interface/AttachInstances.hs
index ebe62cb6..4b5f159d 100644
--- a/src/Haddock/Interface/AttachInstances.hs
+++ b/src/Haddock/Interface/AttachInstances.hs
@@ -22,19 +22,20 @@ import Data.List
 import qualified Data.Map as Map
 import qualified Data.Set as Set
 
-import GHC
-import Name
-import InstEnv
 import Class
+import FastString
+import GHC
 import GhcMonad (withSession)
-import TysPrim( funTyCon )
+import Id
+import InstEnv
 import MonadUtils (liftIO)
+import Name
+import PrelNames
 import TcRnDriver (tcRnGetInfo)
+import TyCon
 import TypeRep
+import TysPrim( funTyCon )
 import Var hiding (varName)
-import TyCon
-import PrelNames
-import FastString
 #define FSLIT(x) (mkFastString# (x#))
 
 type ExportedNames = Set.Set Name
@@ -65,7 +66,7 @@ attachToExportItem expInfo iface ifaceMap instIfaceMap export =
                   Just (_, _, instances) ->
                     let insts = map (first synifyInstHead) $ sortImage (first instHead) $
                                 filter (\((_,_,cls,tys),_) -> not $ isInstanceHidden expInfo cls tys)
-                                [ (instanceHead i, getName i) | i <- instances ]
+                                [ (instanceHead' i, getName i) | i <- instances ]
                     in [ (inst, lookupInstDoc name iface ifaceMap instIfaceMap)
                        | (inst, name) <- insts ]
                   Nothing -> []
@@ -94,6 +95,20 @@ lookupInstDoc name iface ifaceMap instIfaceMap =
     modName = nameModule name
 
 
+-- | Like GHC's 'instanceHead' but drops "silent" arguments.
+instanceHead' :: ClsInst -> ([TyVar], ThetaType, Class, [Type])
+instanceHead' ispec = (tvs, dropSilentArgs dfun theta, cls, tys)
+  where
+    dfun = is_dfun ispec
+    (tvs, theta, cls, tys) = instanceHead ispec
+
+
+-- | Drop "silent" arguments. See GHC Note [Silent superclass
+-- arguments].
+dropSilentArgs :: DFunId -> ThetaType -> ThetaType
+dropSilentArgs dfun theta = drop (dfunNSilent dfun) theta
+
+
 -- | Like GHC's getInfo but doesn't cut things out depending on the
 -- interative context, which we don't set sufficiently anyway.
 getAllInfo :: GhcMonad m => Name -> m (Maybe (TyThing,Fixity,[ClsInst]))
-- 
cgit v1.2.3