module CLasH.Translator
- ( makeVHDLStrings
- , makeVHDLAnnotations
+ (
+ makeVHDLAnnotations
) where
-- Standard Modules
import qualified System.FilePath as FilePath
import qualified Control.Monad.Trans.State as State
import Text.PrettyPrint.HughesPJ (render)
-import Data.Accessor
+import Data.Accessor.Monad.Trans.State
import qualified Data.Map as Map
+import qualified Data.Time.Clock as Clock
+import Debug.Trace
-- GHC API
import qualified CoreSyn
-import qualified GHC
import qualified HscTypes
import qualified UniqSupply
-- VHDL Imports
import qualified Language.VHDL.AST as AST
-import qualified Language.VHDL.FileIO
+import qualified Language.VHDL.FileIO as FileIO
import qualified Language.VHDL.Ppr as Ppr
-- Local Imports
-import CLasH.Normalize
import CLasH.Translator.TranslatorTypes
import CLasH.Translator.Annotations
import CLasH.Utils
-import CLasH.Utils.Core.CoreTools
import CLasH.Utils.GhcTools
import CLasH.VHDL
+import CLasH.VHDL.VHDLTools
import CLasH.VHDL.Testbench
--- | Turn Haskell to VHDL, Usings Strings to indicate the Top Entity, Initial
--- State and Test Inputs.
-makeVHDLStrings ::
- FilePath -- ^ The GHC Library Dir
- -> [FilePath] -- ^ The FileNames
- -> String -- ^ The TopEntity
- -> String -- ^ The InitState
- -> String -- ^ The TestInput
- -> IO ()
-makeVHDLStrings libdir filenames topentity initstate testinput = do
- makeVHDL libdir filenames finder
- where
- finder = findSpec (hasVarName topentity)
- (hasVarName initstate)
- (hasVarName testinput)
-
-- | Turn Haskell to VHDL, Using the Annotations for Top Entity, Initial State
-- and Test Inputs found in the Files.
makeVHDLAnnotations ::
FilePath -- ^ The GHC Library Dir
-> [FilePath] -- ^ The FileNames
-> IO ()
-makeVHDLAnnotations libdir filenames = do
+makeVHDLAnnotations libdir filenames =
makeVHDL libdir filenames finder
where
finder = findSpec (hasCLasHAnnotation isTopEntity)
(hasCLasHAnnotation isInitState)
+ (isCLasHAnnotation isInitState)
(hasCLasHAnnotation isTestInput)
-- | Turn Haskell to VHDL, using the given finder functions to find the Top
-> Finder
-> IO ()
makeVHDL libdir filenames finder = do
+ start <- Clock.getCurrentTime
-- Load the modules
(cores, env, specs) <- loadModules libdir filenames (Just finder)
-- Translate to VHDL
vhdl <- moduleToVHDL env cores specs
-- Write VHDL to file. Just use the first entity for the name
- let top_entity = (\(t, _, _) -> t) $ head specs
+ let top_entity = head $ Maybe.catMaybes $ map (\(t, _, _) -> t) specs
let dir = "./vhdl/" ++ (show top_entity) ++ "/"
prepareDir dir
- mapM (writeVHDL dir) vhdl
- return ()
+ mapM_ (writeVHDL dir) vhdl
+ end <- Clock.getCurrentTime
+ trace ("\nTotal compilation took " ++ show (Clock.diffUTCTime end start)) $
+ return ()
-- | Translate the specified entities in the given modules to VHDL.
moduleToVHDL ::
-> [EntitySpec] -- ^ The entities to generate
-> IO [(AST.VHDLId, AST.DesignFile)]
moduleToVHDL env cores specs = do
- vhdl <- runTranslatorSession env $ do
- let all_bindings = concat (map (\x -> CoreSyn.flattenBinds (HscTypes.cm_binds x)) cores)
+ (vhdl, count) <- runTranslatorSession env $ do
+ let all_bindings = concatMap (\x -> CoreSyn.flattenBinds (HscTypes.cm_binds x)) cores
-- Store the bindings we loaded
- tsBindings %= Map.fromList all_bindings
+ tsBindings %= Map.fromList all_bindings
+ let all_initstates = concatMap (\x -> case x of (_, Nothing, _) -> []; (_, Just inits, _) -> inits) specs
+ tsInitStates %= Map.fromList all_initstates
test_binds <- catMaybesM $ Monad.mapM mkTest specs
- let topbinds = map (\(top, _, _) -> top) specs
- createDesignFiles (topbinds ++ test_binds)
- mapM (putStr . render . Ppr.ppr . snd) vhdl
+ let topbinds = Maybe.catMaybes $ map (\(top, _, _) -> top) specs
+ vhdl <- case topbinds of
+ [] -> error "Could not find top entity requested"
+ tops -> createDesignFiles (tops ++ test_binds)
+ count <- get tsTransformCounter
+ return (vhdl, count)
+ mapM_ (putStr . render . Ppr.ppr . snd) vhdl
+ putStr $ "Total number of transformations applied: " ++ (show count) ++ "\n"
return vhdl
where
mkTest :: EntitySpec -> TranslatorSession (Maybe CoreSyn.CoreBndr)
-- Create a testbench for any entry that has test input
mkTest (_, _, Nothing) = return Nothing
- mkTest (top, _, Just input) = do
- bndr <- createTestbench Nothing input top
+ mkTest (Nothing, _, _) = return Nothing
+ mkTest (Just top, _, Just input) = do
+ bndr <- createTestbench Nothing cores input top
return $ Just bndr
-- Run the given translator session. Generates a new UniqSupply for that
-- on the compiler dir of ghc suggests that 'z' is not used to generate
-- a unique supply anywhere.
uniqSupply <- UniqSupply.mkSplitUniqSupply 'z'
- let init_typestate = TypeState Map.empty [] Map.empty Map.empty env
- let init_state = TranslatorState uniqSupply init_typestate Map.empty Map.empty Map.empty Map.empty
+ let init_typestate = TypeState builtin_types [] Map.empty Map.empty env
+ let init_state = TranslatorState uniqSupply init_typestate Map.empty Map.empty 0 Map.empty Map.empty Map.empty 0
return $ State.evalState session init_state
-- | Prepares the directory for writing VHDL files. This means creating the
-- Find the filename
let fname = dir ++ (AST.fromVHDLId name) ++ ".vhdl"
-- Write the file
- Language.VHDL.FileIO.writeDesignFile vhdl fname
+ FileIO.writeDesignFile vhdl fname
-- vim: set ts=8 sw=2 sts=2 expandtab:
projects / matthijs / master-project / cλash.git / blobdiff