Initialise Settings before DynFlags
[ghc-hetmet.git] / utils / ghctags / Main.hs
index 9017bd0..b3ed58f 100644 (file)
@@ -10,6 +10,7 @@ import DriverPhases     ( isHaskellSrcFilename )
 import HscTypes         ( msHsFilePath )
 import Name             ( getOccString )
 --import ErrUtils         ( printBagOfErrors )
+import Panic            ( panic )
 import DynFlags         ( defaultDynFlags )
 import Bag
 import Exception
@@ -100,7 +101,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
@@ -195,7 +196,7 @@ safeLoad :: LoadHowMuch -> Ghc SuccessFlag
 safeLoad mode = do
   _dflags <- getSessionDynFlags
   ghandle (\(e :: SomeException) -> liftIO (print e) >> return Failed ) $
-    handleSourceError (\e -> printExceptionAndWarnings e >> return Failed) $
+    handleSourceError (\e -> printException e >> return Failed) $
       load mode
 
 
@@ -221,7 +222,7 @@ graphData graph handles = do
               let filename = msHsFilePath ms
                   modname = moduleName $ ms_mod ms
               in handleSourceError (\e -> do
-                                       printExceptionAndWarnings e
+                                       printException e
                                        liftIO $ exitWith (ExitFailure 1)) $
                   do liftIO $ putStrLn ("loading " ++ filename)
                      mod <- loadModule =<< typecheckModule =<< parseModule ms
@@ -251,7 +252,7 @@ boundValues mod group =
                        , bind <- bagToList binds
                        , x <- boundThings mod bind ]
                _other -> error "boundValues"
-      tys = [ n | ns <- map (tyClDeclNames . unLoc) (hs_tyclds group)
+      tys = [ n | ns <- map hsTyClDeclBinders (concat (hs_tyclds group))
                 , n <- map found ns ]
       fors = concat $ map forBound (hs_fords group)
              where forBound lford = case unLoc lford of
@@ -280,7 +281,6 @@ boundThings modname lbinding =
           in case unLoc lpat of
                WildPat _ -> tl
                VarPat name -> lid name : tl
-               VarPatOut name _ -> lid name : tl -- XXX need help here
                LazyPat p -> patThings p tl
                AsPat id p -> patThings p (thing id : tl)
                ParPat p -> patThings p tl