From: Christiaan Baaij <christiaan.baaij@gmail.com>
Date: Wed, 22 Jul 2009 11:33:44 +0000 (+0200)
Subject: Removed need for GHC.Paths, some functions however require a top libdir
X-Git-Url: https://git.stderr.nl/gitweb?a=commitdiff_plain;h=4495e7a13be4643f342c5b05dcb819b60dc1b108;p=matthijs%2Fmaster-project%2Fc%CE%BBash.git

Removed need for GHC.Paths, some functions however require a top libdir
---

diff --git "a/c\316\273ash/CLasH/Translator.hs" "b/c\316\273ash/CLasH/Translator.hs"
index ca660a7..c1e853a 100644
--- "a/c\316\273ash/CLasH/Translator.hs"
+++ "b/c\316\273ash/CLasH/Translator.hs"
@@ -31,7 +31,6 @@ import qualified HscTypes
 import HscTypes ( cm_binds, cm_types )
 import MonadUtils ( liftIO )
 import Outputable ( showSDoc, ppr, showSDocDebug )
-import GHC.Paths ( libdir )
 import DynFlags ( defaultDynFlags )
 import qualified UniqSupply
 import List ( find )
@@ -56,10 +55,10 @@ import CLasH.Normalize
 import CLasH.VHDL.VHDLTypes
 import qualified CLasH.VHDL as VHDL
 
-makeVHDL :: String -> String -> Bool -> IO ()
-makeVHDL filename name stateful = do
+makeVHDL :: FilePath -> String -> String -> Bool -> IO ()
+makeVHDL libdir filename name stateful = do
   -- Load the module
-  (core, env) <- loadModule filename
+  (core, env) <- loadModule libdir filename
   -- Translate to VHDL
   vhdl <- moduleToVHDL env core [(name, stateful)]
   -- Write VHDL to file
@@ -68,9 +67,9 @@ makeVHDL filename name stateful = do
   mapM (writeVHDL dir) vhdl
   return ()
   
-makeVHDLAnn :: String -> Bool -> IO ()
-makeVHDLAnn filename stateful = do
-  (core, top, init, env) <- loadModuleAnn filename
+makeVHDLAnn :: FilePath -> String -> IO ()
+makeVHDLAnn libdir filename = do
+  (core, top, init, env) <- loadModuleAnn libdir filename
   let top_entity = head top
   vhdl <- case init of 
     [] -> moduleToVHDLAnn env core [top_entity]
@@ -80,9 +79,9 @@ makeVHDLAnn filename stateful = do
   mapM (writeVHDL dir) vhdl
   return ()
 
-listBindings :: String -> IO [()]
-listBindings filename = do
-  (core, env) <- loadModule filename
+listBindings :: FilePath -> String -> IO [()]
+listBindings libdir filename = do
+  (core, env) <- loadModule libdir filename
   let binds = CoreSyn.flattenBinds $ cm_binds core
   mapM (listBinding) binds
 
@@ -99,9 +98,9 @@ listBinding (b, e) = do
   putStr "\n\n"
   
 -- | Show the core structure of the given binds in the given file.
-listBind :: String -> String -> IO ()
-listBind filename name = do
-  (core, env) <- loadModule filename
+listBind :: FilePath -> String -> String -> IO ()
+listBind libdir filename name = do
+  (core, env) <- loadModule libdir filename
   let [(b, expr)] = findBinds core [name]
   putStr "\n"
   putStr $ prettyShow expr
@@ -190,8 +189,8 @@ writeVHDL dir (name, vhdl) = do
   Language.VHDL.FileIO.writeDesignFile vhdl fname
 
 -- | Loads the given file and turns it into a core module.
-loadModule :: String -> IO (HscTypes.CoreModule, HscTypes.HscEnv)
-loadModule filename =
+loadModule :: FilePath -> String -> IO (HscTypes.CoreModule, HscTypes.HscEnv)
+loadModule libdir filename =
   defaultErrorHandler defaultDynFlags $ do
     runGhc (Just libdir) $ do
       dflags <- getSessionDynFlags
@@ -207,8 +206,8 @@ loadModule filename =
       return (core, env)
       
 -- | Loads the given file and turns it into a core module.
-loadModuleAnn :: String -> IO (HscTypes.CoreModule, [CoreSyn.CoreBndr], [CoreSyn.CoreBndr], HscTypes.HscEnv)
-loadModuleAnn filename =
+loadModuleAnn :: FilePath -> String -> IO (HscTypes.CoreModule, [CoreSyn.CoreBndr], [CoreSyn.CoreBndr], HscTypes.HscEnv)
+loadModuleAnn libdir filename =
   defaultErrorHandler defaultDynFlags $ do
     runGhc (Just libdir) $ do
       dflags <- getSessionDynFlags
diff --git "a/c\316\273ash/CLasH/Utils/Core/CoreTools.hs" "b/c\316\273ash/CLasH/Utils/Core/CoreTools.hs"
index 45721a8..e0a5c11 100644
--- "a/c\316\273ash/CLasH/Utils/Core/CoreTools.hs"
+++ "b/c\316\273ash/CLasH/Utils/Core/CoreTools.hs"
@@ -40,7 +40,7 @@ import CLasH.Utils.Pretty
 -- library to a real int.
 eval_tfp_int :: HscTypes.HscEnv -> Type.Type -> Int
 eval_tfp_int env ty =
-  unsafeRunGhc $ do
+  unsafeRunGhc libdir $ do
     GHC.setSession env
     -- Automatically import modules for any fully qualified identifiers
     setDynFlag DynFlags.Opt_ImplicitImportQualified
@@ -52,7 +52,10 @@ eval_tfp_int env ty =
     let int_ty = SrcLoc.noLoc $ HsTypes.HsTyVar TysWiredIn.intTyCon_RDR
     let expr = HsExpr.ExprWithTySig app int_ty
     core <- toCore expr
-    execCore core 
+    execCore core
+  where
+    libdir = DynFlags.topDir dynflags
+    dynflags = HscTypes.hsc_dflags env
 
 normalise_tfp_int :: HscTypes.HscEnv -> Type.Type -> Type.Type
 normalise_tfp_int env ty =
diff --git "a/c\316\273ash/CLasH/Utils/GhcTools.hs" "b/c\316\273ash/CLasH/Utils/GhcTools.hs"
index 5f6e671..3f032d9 100644
--- "a/c\316\273ash/CLasH/Utils/GhcTools.hs"
+++ "b/c\316\273ash/CLasH/Utils/GhcTools.hs"
@@ -4,7 +4,6 @@ import qualified System.IO.Unsafe
 
 -- GHC API
 import qualified GHC
-import qualified GHC.Paths
 import qualified DynFlags
 import qualified TcRnMonad
 import qualified MonadUtils
@@ -26,19 +25,19 @@ setDynFlag dflag = do
 -- 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
+unsafeRunGhc :: FilePath -> GHC.Ghc a -> a
+unsafeRunGhc libDir m =
+  System.IO.Unsafe.unsafePerformIO $ do
+      GHC.runGhc (Just 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
+-- 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
diff --git "a/c\316\273ash/clash.cabal" "b/c\316\273ash/clash.cabal"
index 6daa843..69fd79f 100644
--- "a/c\316\273ash/clash.cabal"
+++ "b/c\316\273ash/clash.cabal"
@@ -16,23 +16,11 @@ stability:          alpha
 maintainer:         christiaan.baaij@gmail.com & matthijs@stdin.nl
 Cabal-Version:      >= 1.2
 
-flag out-ghc-tree
-  description: Are we outside a GHC tree?
-  default: False
-  manual: True
-
 Library
-  if flag(out-ghc-tree)
-    build-depends:  ghc-paths
-  else
-    cpp-options:    -DIN_GHC_TREE
-
   build-depends:    ghc >= 6.11, pretty, vhdl, haskell98, syb, data-accessor, 
                     containers, base >= 4, transformers, filepath, 
                     template-haskell, data-accessor-template, prettyclass
                     
-  extensions:       CPP
-                    
   exposed-modules:  CLasH.Translator,
                     CLasH.Translator.Annotations