1 module CLasH.Translator
7 import qualified System.Directory as Directory
10 import qualified System.FilePath as FilePath
11 import qualified Control.Monad.Trans.State as State
12 import Text.PrettyPrint.HughesPJ (render)
14 import qualified Data.Map as Map
17 import qualified CoreSyn
19 import qualified HscTypes
20 import qualified UniqSupply
23 import qualified Language.VHDL.AST as AST
24 import qualified Language.VHDL.FileIO
25 import qualified Language.VHDL.Ppr as Ppr
28 import CLasH.Normalize
29 import CLasH.Translator.TranslatorTypes
30 import CLasH.Translator.Annotations
31 import CLasH.Utils.Core.CoreTools
32 import CLasH.Utils.GhcTools
35 -- | Turn Haskell to VHDL, Usings Strings to indicate the Top Entity, Initial
36 -- State and Test Inputs.
38 FilePath -- ^ The GHC Library Dir
39 -> [FilePath] -- ^ The FileNames
40 -> String -- ^ The TopEntity
41 -> String -- ^ The InitState
42 -> String -- ^ The TestInput
43 -> Bool -- ^ Is it stateful? (in case InitState is empty)
45 makeVHDLStrings libdir filenames topentity initstate testinput stateful = do
46 makeVHDL libdir filenames findTopEntity findInitState findTestInput stateful
48 findTopEntity = findBind (hasVarName topentity)
49 findInitState = findBind (hasVarName initstate)
50 findTestInput = findExpr (hasVarName testinput)
52 -- | Turn Haskell to VHDL, Using the Annotations for Top Entity, Initial State
53 -- and Test Inputs found in the Files.
54 makeVHDLAnnotations ::
55 FilePath -- ^ The GHC Library Dir
56 -> [FilePath] -- ^ The FileNames
57 -> Bool -- ^ Is it stateful? (in case InitState is not specified)
59 makeVHDLAnnotations libdir filenames stateful = do
60 makeVHDL libdir filenames findTopEntity findInitState findTestInput stateful
62 findTopEntity = findBind (hasCLasHAnnotation isTopEntity)
63 findInitState = findBind (hasCLasHAnnotation isInitState)
64 findTestInput = findExpr (hasCLasHAnnotation isTestInput)
66 -- | Turn Haskell to VHDL, using the given finder functions to find the Top
67 -- Entity, Initial State and Test Inputs in the Haskell Files.
69 FilePath -- ^ The GHC Library Dir
70 -> [FilePath] -- ^ The Filenames
71 -> (HscTypes.CoreModule -> GHC.Ghc (Maybe CoreSyn.CoreBndr)) -- ^ The Top Entity Finder
72 -> (HscTypes.CoreModule -> GHC.Ghc (Maybe CoreSyn.CoreBndr)) -- ^ The Init State Finder
73 -> (HscTypes.CoreModule -> GHC.Ghc (Maybe CoreSyn.CoreExpr)) -- ^ The Test Input Finder
74 -> Bool -- ^ Indicates if it is meant to be stateful
76 makeVHDL libdir filenames topEntFinder initStateFinder testInputFinder stateful = do
78 (cores, top, init, test, env) <- loadModules libdir filenames topEntFinder initStateFinder testInputFinder
80 vhdl <- moduleToVHDL env cores top init test stateful
82 let top_entity = Maybe.fromJust $ head top
83 let dir = "./vhdl/" ++ (show top_entity) ++ "/"
85 mapM (writeVHDL dir) vhdl
88 -- | Translate the binds with the given names from the given core module to
89 -- VHDL. The Bool in the tuple makes the function stateful (True) or
92 HscTypes.HscEnv -- ^ The GHC Environment
93 -> [HscTypes.CoreModule] -- ^ The Core Modules
94 -> [Maybe CoreSyn.CoreBndr] -- ^ The TopEntity
95 -> [Maybe CoreSyn.CoreBndr] -- ^ The InitState
96 -> [Maybe CoreSyn.CoreExpr] -- ^ The TestInput
97 -> Bool -- ^ Is it stateful (in case InitState is not specified)
98 -> IO [(AST.VHDLId, AST.DesignFile)]
99 moduleToVHDL env cores topbinds' init test stateful = do
100 let topbinds = Maybe.catMaybes topbinds'
101 let initialState = Maybe.catMaybes init
102 let testInput = Maybe.catMaybes test
103 vhdl <- runTranslatorSession env $ do
104 let all_bindings = concat (map (\x -> CoreSyn.flattenBinds (HscTypes.cm_binds x)) cores)
105 -- Store the bindings we loaded
106 tsBindings %= Map.fromList all_bindings
107 --let testexprs = case testInput of [] -> [] ; [x] -> reduceCoreListToHsList x
108 createDesignFiles topbinds
109 mapM (putStr . render . Ppr.ppr . snd) vhdl
112 -- Run the given translator session. Generates a new UniqSupply for that
114 runTranslatorSession :: HscTypes.HscEnv -> TranslatorSession a -> IO a
115 runTranslatorSession env session = do
116 -- Generate a UniqSupply
118 -- egrep -r "(initTcRnIf|mkSplitUniqSupply)" .
119 -- on the compiler dir of ghc suggests that 'z' is not used to generate
120 -- a unique supply anywhere.
121 uniqSupply <- UniqSupply.mkSplitUniqSupply 'z'
122 let init_typestate = TypeState Map.empty [] Map.empty Map.empty env
123 let init_state = TranslatorState uniqSupply init_typestate Map.empty Map.empty Map.empty Map.empty
124 return $ State.evalState session init_state
126 -- | Prepares the directory for writing VHDL files. This means creating the
127 -- dir if it does not exist and removing all existing .vhdl files from it.
128 prepareDir :: String -> IO()
130 -- Create the dir if needed
131 Directory.createDirectoryIfMissing True dir
132 -- Find all .vhdl files in the directory
133 files <- Directory.getDirectoryContents dir
134 let to_remove = filter ((==".vhdl") . FilePath.takeExtension) files
135 -- Prepend the dirname to the filenames
136 let abs_to_remove = map (FilePath.combine dir) to_remove
138 mapM_ Directory.removeFile abs_to_remove
140 -- | Write the given design file to a file with the given name inside the
142 writeVHDL :: String -> (AST.VHDLId, AST.DesignFile) -> IO ()
143 writeVHDL dir (name, vhdl) = do
145 let fname = dir ++ (AST.fromVHDLId name) ++ ".vhdl"
147 Language.VHDL.FileIO.writeDesignFile vhdl fname
149 -- vim: set ts=8 sw=2 sts=2 expandtab: