X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=utils%2Fghctags%2FMain.hs;h=b3ed58f327efe20f1e34651c3ccaaa7d784c7cf6;hp=9093e032e9362465cdd08bb51e9ee117a32ccbe4;hb=bfa0c2ed1e4cd07c7934901520cb04db6b79cd9d;hpb=241c6ba59c89d491aa4087f754dfcbbca26163f4 diff --git a/utils/ghctags/Main.hs b/utils/ghctags/Main.hs index 9093e03..b3ed58f 100644 --- a/utils/ghctags/Main.hs +++ b/utils/ghctags/Main.hs @@ -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 hsTyClDeclBinders (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