X-Git-Url: https://git.stderr.nl/gitweb?a=blobdiff_plain;f=c%CE%BBash%2FCLasH%2FTranslator.hs;h=6177dabaca9fc069374da39caf6995e4f8c69ba7;hb=e1ef152dc63f28dddce2de4950ec739c79c8d18f;hp=c4daf04d0dedb9963e79b1d860b24644321c5d05;hpb=adf357ab8731531dfea0a21254cfc613031e083a;p=matthijs%2Fmaster-project%2Fc%CE%BBash.git diff --git "a/c\316\273ash/CLasH/Translator.hs" "b/c\316\273ash/CLasH/Translator.hs" index c4daf04..6177dab 100644 --- "a/c\316\273ash/CLasH/Translator.hs" +++ "b/c\316\273ash/CLasH/Translator.hs" @@ -1,6 +1,6 @@ module CLasH.Translator - ( makeVHDLStrings - , makeVHDLAnnotations + ( + makeVHDLAnnotations ) where -- Standard Modules @@ -10,59 +10,42 @@ import qualified Monad 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 - -> Bool -- ^ Is it stateful? (in case InitState is empty) - -> IO () -makeVHDLStrings libdir filenames topentity initstate testinput stateful = do - makeVHDL libdir filenames finder stateful - 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 - -> Bool -- ^ Is it stateful? (in case InitState is not specified) -> IO () -makeVHDLAnnotations libdir filenames stateful = do - makeVHDL libdir filenames finder stateful +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 @@ -71,45 +54,52 @@ makeVHDL :: FilePath -- ^ The GHC Library Dir -> [FilePath] -- ^ The Filenames -> Finder - -> Bool -- ^ Indicates if it is meant to be stateful -> IO () -makeVHDL libdir filenames finder stateful = do +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 stateful + 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 binds with the given names from the given core module to --- VHDL. The Bool in the tuple makes the function stateful (True) or --- stateless (False). +-- | Translate the specified entities in the given modules to VHDL. moduleToVHDL :: HscTypes.HscEnv -- ^ The GHC Environment -> [HscTypes.CoreModule] -- ^ The Core Modules -> [EntitySpec] -- ^ The entities to generate - -> Bool -- ^ Is it stateful (in case InitState is not specified) -> IO [(AST.VHDLId, AST.DesignFile)] -moduleToVHDL env cores specs stateful = do - vhdl <- runTranslatorSession env $ do - let all_bindings = concat (map (\x -> CoreSyn.flattenBinds (HscTypes.cm_binds x)) cores) +moduleToVHDL env cores specs = do + (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 @@ -122,8 +112,8 @@ runTranslatorSession env session = do -- 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 @@ -147,6 +137,6 @@ writeVHDL dir (name, vhdl) = do -- 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: