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)
13 import Data.Accessor.Monad.Trans.State
14 import qualified Data.Map as Map
17 import qualified CoreSyn
18 import qualified HscTypes
19 import qualified UniqSupply
22 import qualified Language.VHDL.AST as AST
23 import qualified Language.VHDL.FileIO as FileIO
24 import qualified Language.VHDL.Ppr as Ppr
27 import CLasH.Translator.TranslatorTypes
28 import CLasH.Translator.Annotations
30 import CLasH.Utils.GhcTools
32 import CLasH.VHDL.VHDLTools
33 import CLasH.VHDL.Testbench
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
44 -- makeVHDLStrings libdir filenames topentity initstate testinput = do
45 -- makeVHDL libdir filenames finder
47 -- finder = findSpec (hasVarName topentity)
48 -- (hasVarName initstate)
49 -- (isCLasHAnnotation isInitState)
50 -- (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
58 makeVHDLAnnotations libdir filenames =
59 makeVHDL libdir filenames finder
61 finder = findSpec (hasCLasHAnnotation isTopEntity)
62 (hasCLasHAnnotation isInitState)
63 (isCLasHAnnotation isInitState)
64 (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
73 makeVHDL libdir filenames finder = do
75 (cores, env, specs) <- loadModules libdir filenames (Just finder)
77 vhdl <- moduleToVHDL env cores specs
78 -- Write VHDL to file. Just use the first entity for the name
79 let top_entity = head $ Maybe.catMaybes $ map (\(t, _, _) -> t) specs
80 let dir = "./vhdl/" ++ (show top_entity) ++ "/"
82 mapM_ (writeVHDL dir) vhdl
85 -- | Translate the specified entities in the given modules to VHDL.
87 HscTypes.HscEnv -- ^ The GHC Environment
88 -> [HscTypes.CoreModule] -- ^ The Core Modules
89 -> [EntitySpec] -- ^ The entities to generate
90 -> IO [(AST.VHDLId, AST.DesignFile)]
91 moduleToVHDL env cores specs = do
92 vhdl <- runTranslatorSession env $ do
93 let all_bindings = concatMap (\x -> CoreSyn.flattenBinds (HscTypes.cm_binds x)) cores
94 -- Store the bindings we loaded
95 tsBindings %= Map.fromList all_bindings
96 let all_initstates = concatMap (\x -> case x of (_, Nothing, _) -> []; (_, Just inits, _) -> inits) specs
97 tsInitStates %= Map.fromList all_initstates
98 test_binds <- catMaybesM $ Monad.mapM mkTest specs
99 let topbinds = Maybe.catMaybes $ map (\(top, _, _) -> top) specs
101 [] -> error "Could not find top entity requested"
102 tops -> createDesignFiles (tops ++ test_binds)
103 mapM_ (putStr . render . Ppr.ppr . snd) vhdl
106 mkTest :: EntitySpec -> TranslatorSession (Maybe CoreSyn.CoreBndr)
107 -- Create a testbench for any entry that has test input
108 mkTest (_, _, Nothing) = return Nothing
109 mkTest (Nothing, _, _) = return Nothing
110 mkTest (Just top, _, Just input) = do
111 bndr <- createTestbench Nothing cores input top
114 -- Run the given translator session. Generates a new UniqSupply for that
116 runTranslatorSession :: HscTypes.HscEnv -> TranslatorSession a -> IO a
117 runTranslatorSession env session = do
118 -- Generate a UniqSupply
120 -- egrep -r "(initTcRnIf|mkSplitUniqSupply)" .
121 -- on the compiler dir of ghc suggests that 'z' is not used to generate
122 -- a unique supply anywhere.
123 uniqSupply <- UniqSupply.mkSplitUniqSupply 'z'
124 let init_typestate = TypeState builtin_types [] Map.empty Map.empty env
125 let init_state = TranslatorState uniqSupply init_typestate Map.empty Map.empty 0 Map.empty Map.empty Map.empty
126 return $ State.evalState session init_state
128 -- | Prepares the directory for writing VHDL files. This means creating the
129 -- dir if it does not exist and removing all existing .vhdl files from it.
130 prepareDir :: String -> IO()
132 -- Create the dir if needed
133 Directory.createDirectoryIfMissing True dir
134 -- Find all .vhdl files in the directory
135 files <- Directory.getDirectoryContents dir
136 let to_remove = filter ((==".vhdl") . FilePath.takeExtension) files
137 -- Prepend the dirname to the filenames
138 let abs_to_remove = map (FilePath.combine dir) to_remove
140 mapM_ Directory.removeFile abs_to_remove
142 -- | Write the given design file to a file with the given name inside the
144 writeVHDL :: String -> (AST.VHDLId, AST.DesignFile) -> IO ()
145 writeVHDL dir (name, vhdl) = do
147 let fname = dir ++ (AST.fromVHDLId name) ++ ".vhdl"
149 FileIO.writeDesignFile vhdl fname
151 -- vim: set ts=8 sw=2 sts=2 expandtab: