X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=utils%2Fghctags%2FMain.hs;h=4ba8157dcc044db3aa2f060f71e015ff0d27e292;hp=a25537ee990bbbea39e815fc0315b7df87ad7ce3;hb=0b4324456e472d15a3a124f56387486f71cb765d;hpb=6ea06bbf08517d9805feb82df65cc56ecbaf23a4

diff --git a/utils/ghctags/Main.hs b/utils/ghctags/Main.hs
index a25537e..4ba8157 100644
--- a/utils/ghctags/Main.hs
+++ b/utils/ghctags/Main.hs
@@ -10,11 +10,13 @@ import DriverPhases     ( isHaskellSrcFilename )
 import HscTypes         ( msHsFilePath )
 import Name             ( getOccString )
 --import ErrUtils         ( printBagOfErrors )
+import Panic            ( panic )
 import DynFlags         ( defaultDynFlags )
 import Bag
 import Exception
 import FastString
 import MonadUtils       ( liftIO )
+import SrcLoc
 
 -- Every GHC comes with Cabal anyways, so this is not a bad new dependency
 import Distribution.Simple.GHC ( ghcOptions )
@@ -48,7 +50,7 @@ type FileName = String
 type ThingName = String -- name of a defined entity in a Haskell program
 
 -- A definition we have found (we know its containing module, name, and location)
-data FoundThing = FoundThing ModuleName ThingName SrcLoc
+data FoundThing = FoundThing ModuleName ThingName RealSrcLoc
 
 -- Data we have obtained from a file (list of things we found)
 data FileData = FileData FileName [FoundThing] (Map Int String)
@@ -100,7 +102,7 @@ main = do
                      then Just `liftM` openFile "TAGS" openFileMode
                      else return Nothing
 
-  GHC.defaultErrorHandler defaultDynFlags $
+  GHC.defaultErrorHandler (defaultDynFlags (panic "No settings")) $
     runGhc (Just ghc_topdir) $ do
       --liftIO $ print "starting up session"
       dflags <- getSessionDynFlags
@@ -260,8 +262,10 @@ boundValues mod group =
   in vals ++ tys ++ fors
   where found = foundOfLName mod
 
-startOfLocated :: Located a -> SrcLoc
-startOfLocated lHs = srcSpanStart $ getLoc lHs
+startOfLocated :: Located a -> RealSrcLoc
+startOfLocated lHs = case getLoc lHs of
+                     RealSrcSpan l -> realSrcSpanStart l
+                     UnhelpfulSpan _ -> panic "startOfLocated UnhelpfulSpan"
 
 foundOfLName :: ModuleName -> Located Name -> FoundThing
 foundOfLName mod id = FoundThing mod (getOccString $ unLoc id) (startOfLocated id)
@@ -292,7 +296,6 @@ boundThings modname lbinding =
                LitPat _ -> tl
                NPat _ _ _ -> tl -- form of literal pattern?
                NPlusKPat id _ _ _ -> thing id : tl
-               TypePat _ -> tl -- XXX need help here
                SigPatIn p _ -> patThings p tl
                SigPatOut p _ -> patThings p tl
                _ -> error "boundThings"