cλash/CLasH/Utils/GhcTools.hs

   1 module GhcTools where
   2 -- Standard modules
   3 import qualified System.IO.Unsafe
   4
   5 -- GHC API
   6 import qualified GHC
   7 import qualified GHC.Paths
   8 import qualified DynFlags
   9 import qualified TcRnMonad
  10 import qualified MonadUtils
  11 import qualified HscTypes
  12 import qualified PrelNames
  13
  14 -- Change a DynFlag from within the Ghc monad. Strangely enough there seems to
  15 -- be no standard function to do exactly this.
  16 setDynFlag :: DynFlags.DynFlag -> GHC.Ghc ()
  17 setDynFlag dflag = do
  18   dflags <- GHC.getSessionDynFlags
  19   let dflags' = DynFlags.dopt_set dflags dflag
  20   GHC.setSessionDynFlags dflags'
  21   return ()
  22
  23 -- We don't want the IO monad sprinkled around everywhere, so we hide it.
  24 -- This should be safe as long as we only do simple things in the GhcMonad
  25 -- such as interface lookups and evaluating simple expressions that
  26 -- don't have side effects themselves (Or rather, that don't use
  27 -- unsafePerformIO themselves, since normal side effectful function would
  28 -- just return an IO monad when they are evaluated).
  29 unsafeRunGhc :: GHC.Ghc a -> a
  30 unsafeRunGhc m =
  31   System.IO.Unsafe.unsafePerformIO $
  32       GHC.runGhc (Just GHC.Paths.libdir) $ do
  33         dflags <- GHC.getSessionDynFlags
  34         GHC.setSessionDynFlags dflags
  35         m
  36
  37 runTcM :: TcRnMonad.TcM a -> IO a
  38 runTcM thing_inside = do
  39   GHC.runGhc (Just GHC.Paths.libdir) $ do
  40     dflags <- GHC.getSessionDynFlags
  41     GHC.setSessionDynFlags dflags
  42     env <- GHC.getSession
  43     HscTypes.ioMsgMaybe . MonadUtils.liftIO .  TcRnMonad.initTcPrintErrors env PrelNames.iNTERACTIVE $ do
  44       thing_inside