Moved clash to it's own library directory, and started on library structure

[matthijs/master-project/cλash.git] / cλash / CLasH / Utils / GhcTools.hs

diff --git a/cλash/CLasH/Utils/GhcTools.hs b/cλash/CLasH/Utils/GhcTools.hs
new file mode 100644 (file)
index 0000000..9c5038c
--- /dev/null
+++ b/cλash/CLasH/Utils/GhcTools.hs
@@ -0,0 +1,44 @@
+module GhcTools where
+-- Standard modules
+import qualified System.IO.Unsafe
+
+-- GHC API
+import qualified GHC
+import qualified GHC.Paths
+import qualified DynFlags
+import qualified TcRnMonad
+import qualified MonadUtils
+import qualified HscTypes
+import qualified PrelNames
+
+-- Change a DynFlag from within the Ghc monad. Strangely enough there seems to
+-- be no standard function to do exactly this.
+setDynFlag :: DynFlags.DynFlag -> GHC.Ghc ()
+setDynFlag dflag = do
+  dflags <- GHC.getSessionDynFlags
+  let dflags' = DynFlags.dopt_set dflags dflag
+  GHC.setSessionDynFlags dflags'
+  return ()
+
+-- We don't want the IO monad sprinkled around everywhere, so we hide it.
+-- This should be safe as long as we only do simple things in the GhcMonad
+-- such as interface lookups and evaluating simple expressions that
+-- don't have side effects themselves (Or rather, that don't use
+-- unsafePerformIO themselves, since normal side effectful function would
+-- just return an IO monad when they are evaluated).
+unsafeRunGhc :: GHC.Ghc a -> a
+unsafeRunGhc m =
+  System.IO.Unsafe.unsafePerformIO $ 
+      GHC.runGhc (Just GHC.Paths.libdir) $ do
+        dflags <- GHC.getSessionDynFlags
+        GHC.setSessionDynFlags dflags
+        m
+
+runTcM :: TcRnMonad.TcM a -> IO a
+runTcM thing_inside = do
+  GHC.runGhc (Just GHC.Paths.libdir) $ do   
+    dflags <- GHC.getSessionDynFlags
+    GHC.setSessionDynFlags dflags
+    env <- GHC.getSession
+    HscTypes.ioMsgMaybe . MonadUtils.liftIO .  TcRnMonad.initTcPrintErrors env PrelNames.iNTERACTIVE $ do
+      thing_inside