projects
/
matthijs
/
master-project
/
cλash.git
/ commitdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
| commitdiff |
tree
raw
|
patch
|
inline
| side by side (parent:
7538f04
)
Removed need for GHC.Paths, some functions however require a top libdir
author
Christiaan Baaij
<christiaan.baaij@gmail.com>
Wed, 22 Jul 2009 11:33:44 +0000
(13:33 +0200)
committer
Christiaan Baaij
<christiaan.baaij@gmail.com>
Wed, 22 Jul 2009 11:33:44 +0000
(13:33 +0200)
cλash/CLasH/Translator.hs
patch
|
blob
|
history
cλash/CLasH/Utils/Core/CoreTools.hs
patch
|
blob
|
history
cλash/CLasH/Utils/GhcTools.hs
patch
|
blob
|
history
cλash/clash.cabal
patch
|
blob
|
history
diff --git
a/cλash/CLasH/Translator.hs
b/cλash/CLasH/Translator.hs
index ca660a7d65f0401ef335f2bb1910627e35a61d30..c1e853aad6ede4f39c5c3cdcfe788f5c0d6b4747 100644
(file)
--- a/
cλash/CLasH/Translator.hs
+++ b/
cλash/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 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 )
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
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
-- 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
-- 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 ()
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]
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 ()
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
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.
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
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.
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
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.
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
defaultErrorHandler defaultDynFlags $ do
runGhc (Just libdir) $ do
dflags <- getSessionDynFlags
diff --git
a/cλash/CLasH/Utils/Core/CoreTools.hs
b/cλash/CLasH/Utils/Core/CoreTools.hs
index 45721a891a7bf6d1662465322795daa2995a67ff..e0a5c11187fc4c8b3f63f42192f859b11519a5da 100644
(file)
--- a/
cλash/CLasH/Utils/Core/CoreTools.hs
+++ b/
cλash/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 =
-- 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
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
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 =
normalise_tfp_int :: HscTypes.HscEnv -> Type.Type -> Type.Type
normalise_tfp_int env ty =
diff --git
a/cλash/CLasH/Utils/GhcTools.hs
b/cλash/CLasH/Utils/GhcTools.hs
index 5f6e671807b03eac3b55f38fbc9934d757078f38..3f032d901203325fb52cac1dd3ebef6541a8ccec 100644
(file)
--- a/
cλash/CLasH/Utils/GhcTools.hs
+++ b/
cλash/CLasH/Utils/GhcTools.hs
@@
-4,7
+4,6
@@
import qualified System.IO.Unsafe
-- GHC API
import qualified GHC
-- GHC API
import qualified GHC
-import qualified GHC.Paths
import qualified DynFlags
import qualified TcRnMonad
import qualified MonadUtils
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).
-- 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.libd
ir) $ do
+unsafeRunGhc ::
FilePath ->
GHC.Ghc a -> a
+unsafeRunGhc
libDir
m =
+ System.IO.Unsafe.unsafePerformIO $
do
+ GHC.runGhc (Just
libD
ir) $ do
dflags <- GHC.getSessionDynFlags
GHC.setSessionDynFlags dflags
m
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λash/clash.cabal
b/cλash/clash.cabal
index 6daa84322ca00577a06955fc6c1d5ebc3e962614..69fd79f4828e51e07dee1a2dfcbafa0188cca2d2 100644
(file)
--- a/
cλash/clash.cabal
+++ b/
cλash/clash.cabal
@@
-16,23
+16,11
@@
stability: alpha
maintainer: christiaan.baaij@gmail.com & matthijs@stdin.nl
Cabal-Version: >= 1.2
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
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
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
exposed-modules: CLasH.Translator,
CLasH.Translator.Annotations