Ticket #3836: getallinfo-nothing-ghci-566331

File getallinfo-nothing-ghci-566331, 2.3 KB (added by igloo, 4 years ago)
Line 
1Index: ghc6-6.12.1/utils/haddock/src/Haddock/Interface/AttachInstances.hs
2===================================================================
3--- ghc6-6.12.1.orig/utils/haddock/src/Haddock/Interface/AttachInstances.hs     2010-01-27 22:13:25.000000000 +0200
4+++ ghc6-6.12.1/utils/haddock/src/Haddock/Interface/AttachInstances.hs  2010-01-27 22:19:17.000000000 +0200
5@@ -25,7 +25,9 @@
6 import InstEnv
7 import Class
8 import HscTypes (withSession, ioMsg)
9+#ifdef GHCI
10 import TcRnDriver (tcRnGetInfo)
11+#endif
12 
13 #if __GLASGOW_HASKELL__ > 610 || (__GLASGOW_HASKELL__ == 610 && __GHC_PATCHLEVEL__ >= 2)
14 import TypeRep hiding (funTyConName)
15@@ -48,7 +50,11 @@
16       return $ iface { ifaceExportItems = newItems }
17 
18     attachExport export@ExportDecl{expItemDecl = L _ (TyClD d)} = do
19+#ifdef GHCI
20        mb_info <- getAllInfo (unLoc (tcdLName d))
21+#else
22+       let mb_info = Nothing
23+#endif
24        return $ export { expItemInstances = case mb_info of
25          Just (_, _, instances) ->
26            map synifyInstHead . sortImage instHead . map instanceHead $ instances
27@@ -58,10 +64,12 @@
28     attachExport export = return export
29 
30 
31+#ifdef GHCI
32 -- | Like GHC's getInfo but doesn't cut things out depending on the
33 -- interative context, which we don't set sufficiently anyway.
34 getAllInfo :: GhcMonad m => Name -> m (Maybe (TyThing,Fixity,[Instance]))
35 getAllInfo name = withSession $ \hsc_env -> ioMsg $ tcRnGetInfo hsc_env name
36+#endif
37 
38 --------------------------------------------------------------------------------
39 -- Collecting and sorting instances
40Index: ghc6-6.12.1/utils/haddock/src/Haddock/Interface/Create.hs
41===================================================================
42--- ghc6-6.12.1.orig/utils/haddock/src/Haddock/Interface/Create.hs      2010-01-28 10:28:29.000000000 +0200
43+++ ghc6-6.12.1/utils/haddock/src/Haddock/Interface/Create.hs   2010-01-28 10:29:26.000000000 +0200
44@@ -495,7 +495,11 @@
45         Nothing -> do
46           -- If we can't find the declaration, it must belong to
47           -- another package
48+#ifdef GHCI
49           mbTyThing <- liftGhcToErrMsgGhc $ lookupName t
50+#else
51+          mbTyThing <- liftGhcToErrMsgGhc $ lookupGlobalName t
52+#endif
53           -- show the name as exported as well as the name's
54           -- defining module (because the latter is where we
55           -- looked for the .hi/.haddock).  It's to help people