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
32 import CLasH.Utils.Core.CoreTools
33 import CLasH.Utils.GhcTools
35 import CLasH.VHDL.Testbench
37 -- | Turn Haskell to VHDL, Usings Strings to indicate the Top Entity, Initial
38 -- State and Test Inputs.
40 FilePath -- ^ The GHC Library Dir
41 -> [FilePath] -- ^ The FileNames
42 -> String -- ^ The TopEntity
43 -> String -- ^ The InitState
44 -> String -- ^ The TestInput
45 -> Bool -- ^ Is it stateful? (in case InitState is empty)
47 makeVHDLStrings libdir filenames topentity initstate testinput stateful = do
48 makeVHDL libdir filenames finder stateful
50 finder = findSpec (hasVarName topentity)
51 (hasVarName initstate)
52 (hasVarName testinput)
54 -- | Turn Haskell to VHDL, Using the Annotations for Top Entity, Initial State
55 -- and Test Inputs found in the Files.
56 makeVHDLAnnotations ::
57 FilePath -- ^ The GHC Library Dir
58 -> [FilePath] -- ^ The FileNames
59 -> Bool -- ^ Is it stateful? (in case InitState is not specified)
61 makeVHDLAnnotations libdir filenames stateful = do
62 makeVHDL libdir filenames finder stateful
64 finder = findSpec (hasCLasHAnnotation isTopEntity)
65 (hasCLasHAnnotation isInitState)
66 (hasCLasHAnnotation isTestInput)
68 -- | Turn Haskell to VHDL, using the given finder functions to find the Top
69 -- Entity, Initial State and Test Inputs in the Haskell Files.
71 FilePath -- ^ The GHC Library Dir
72 -> [FilePath] -- ^ The Filenames
74 -> Bool -- ^ Indicates if it is meant to be stateful
76 makeVHDL libdir filenames finder stateful = do
78 (cores, env, specs) <- loadModules libdir filenames (Just finder)
80 vhdl <- moduleToVHDL env cores specs stateful
81 -- Write VHDL to file. Just use the first entity for the name
82 let top_entity = (\(t, _, _) -> t) $ head specs
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 -> [EntitySpec] -- ^ The entities to generate
95 -> Bool -- ^ Is it stateful (in case InitState is not specified)
96 -> IO [(AST.VHDLId, AST.DesignFile)]
97 moduleToVHDL env cores specs stateful = do
98 vhdl <- runTranslatorSession env $ do
99 let all_bindings = concat (map (\x -> CoreSyn.flattenBinds (HscTypes.cm_binds x)) cores)
100 -- Store the bindings we loaded
101 tsBindings %= Map.fromList all_bindings
102 test_binds <- catMaybesM $ Monad.mapM mkTest specs
103 let topbinds = map (\(top, _, _) -> top) specs
104 createDesignFiles (topbinds ++ test_binds)
105 mapM (putStr . render . Ppr.ppr . snd) vhdl
108 mkTest :: EntitySpec -> TranslatorSession (Maybe CoreSyn.CoreBndr)
109 -- Create a testbench for any entry that has test input
110 mkTest (_, _, Nothing) = return Nothing
111 mkTest (top, _, Just input) = do
112 bndr <- createTestbench Nothing input top
115 -- Run the given translator session. Generates a new UniqSupply for that
117 runTranslatorSession :: HscTypes.HscEnv -> TranslatorSession a -> IO a
118 runTranslatorSession env session = do
119 -- Generate a UniqSupply
121 -- egrep -r "(initTcRnIf|mkSplitUniqSupply)" .
122 -- on the compiler dir of ghc suggests that 'z' is not used to generate
123 -- a unique supply anywhere.
124 uniqSupply <- UniqSupply.mkSplitUniqSupply 'z'
125 let init_typestate = TypeState Map.empty [] Map.empty Map.empty env
126 let init_state = TranslatorState uniqSupply init_typestate Map.empty Map.empty Map.empty Map.empty
127 return $ State.evalState session init_state
129 -- | Prepares the directory for writing VHDL files. This means creating the
130 -- dir if it does not exist and removing all existing .vhdl files from it.
131 prepareDir :: String -> IO()
133 -- Create the dir if needed
134 Directory.createDirectoryIfMissing True dir
135 -- Find all .vhdl files in the directory
136 files <- Directory.getDirectoryContents dir
137 let to_remove = filter ((==".vhdl") . FilePath.takeExtension) files
138 -- Prepend the dirname to the filenames
139 let abs_to_remove = map (FilePath.combine dir) to_remove
141 mapM_ Directory.removeFile abs_to_remove
143 -- | Write the given design file to a file with the given name inside the
145 writeVHDL :: String -> (AST.VHDLId, AST.DesignFile) -> IO ()
146 writeVHDL dir (name, vhdl) = do
148 let fname = dir ++ (AST.fromVHDLId name) ++ ".vhdl"
150 Language.VHDL.FileIO.writeDesignFile vhdl fname
152 -- vim: set ts=8 sw=2 sts=2 expandtab: