cλash/CLasH/Utils/GhcTools.hs

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