X-Git-Url: https://git.stderr.nl/gitweb?a=blobdiff_plain;f=c%CE%BBash%2FCLasH%2FTranslator.hs;h=6177dabaca9fc069374da39caf6995e4f8c69ba7;hb=75978cf28a619d14ae27ea2bb4a53246b6a0bcd8;hp=8884506ea47f27f80a0b3a93bae20384711e0159;hpb=466f80bdde9511508c38e951d208a2a52c90c7da;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 8884506..6177dab 100644
--- "a/c\316\273ash/CLasH/Translator.hs"
+++ "b/c\316\273ash/CLasH/Translator.hs"
@@ -1,5 +1,5 @@
 module CLasH.Translator 
-  ( -- makeVHDLStrings
+  (
    makeVHDLAnnotations
   ) where
 
@@ -10,56 +10,37 @@ 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
---   -> IO ()
--- makeVHDLStrings libdir filenames topentity initstate testinput = do
---   makeVHDL libdir filenames finder
---     where
---       finder = findSpec (hasVarName topentity)
---                         (hasVarName initstate)
---                         (isCLasHAnnotation isInitState)
---                         (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)
@@ -75,6 +56,7 @@ makeVHDL ::
   -> Finder
   -> IO ()
 makeVHDL libdir filenames finder = do
+  start <- Clock.getCurrentTime
   -- Load the modules
   (cores, env, specs) <- loadModules libdir filenames (Just finder)
   -- Translate to VHDL
@@ -83,8 +65,10 @@ makeVHDL libdir filenames finder = do
   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 ::
@@ -93,19 +77,21 @@ 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
-    let all_initstates = concat (map (\x -> case x of (_, Nothing, _) -> []; (_, Just inits, _) -> inits) specs) 
+    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
-    mapM_ printAnns specs
     let topbinds = Maybe.catMaybes $ map (\(top, _, _) -> top) specs
-    case topbinds of
-      []  -> error $ "Could not find top entity requested"
+    vhdl <- case topbinds of
+      []  -> error "Could not find top entity requested"
       tops -> createDesignFiles (tops ++ test_binds)
-  mapM (putStr . render . Ppr.ppr . snd) vhdl
+    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)
@@ -115,9 +101,6 @@ moduleToVHDL env cores specs = do
     mkTest (Just top, _, Just input) = do
       bndr <- createTestbench Nothing cores input top
       return $ Just bndr
-    printAnns :: EntitySpec -> TranslatorSession ()
-    printAnns (_, Nothing, _) = trace ("no anns found:\n\n") $ return ()
-    printAnns (_, (Just anns), _) = trace ("anns:\n\n" ++ show anns ++ "\n") $ return ()
 
 -- Run the given translator session. Generates a new UniqSupply for that
 -- session.
@@ -130,7 +113,7 @@ runTranslatorSession env session = do
   -- a unique supply anywhere.
   uniqSupply <- UniqSupply.mkSplitUniqSupply 'z'
   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
+  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
@@ -154,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: