X-Git-Url: https://git.stderr.nl/gitweb?a=blobdiff_plain;f=c%CE%BBash%2FCLasH%2FTranslator.hs;h=8884506ea47f27f80a0b3a93bae20384711e0159;hb=466f80bdde9511508c38e951d208a2a52c90c7da;hp=b61f5f942b8ba7b62eb0ea8200045b295899ef08;hpb=d12fa2e2d090cb0792e1d94413787ee20946c655;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 b61f5f9..8884506 100644
--- "a/c\316\273ash/CLasH/Translator.hs"
+++ "b/c\316\273ash/CLasH/Translator.hs"
@@ -1,6 +1,6 @@
 module CLasH.Translator 
-  ( makeVHDLStrings
-  , makeVHDLAnnotations
+  ( -- makeVHDLStrings
+   makeVHDLAnnotations
   ) where
 
 -- Standard Modules
@@ -12,6 +12,7 @@ import qualified Control.Monad.Trans.State as State
 import Text.PrettyPrint.HughesPJ (render)
 import Data.Accessor
 import qualified Data.Map as Map
+import Debug.Trace
 
 -- GHC API
 import qualified CoreSyn
@@ -32,23 +33,25 @@ 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)
+-- 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. 
@@ -61,6 +64,7 @@ makeVHDLAnnotations libdir filenames = do
     where
       finder = findSpec (hasCLasHAnnotation isTopEntity)
                         (hasCLasHAnnotation isInitState)
+                        (isCLasHAnnotation isInitState)
                         (hasCLasHAnnotation isTestInput)
 
 -- | Turn Haskell to VHDL, using the given finder functions to find the Top
@@ -76,7 +80,7 @@ makeVHDL libdir filenames finder = do
   -- 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
@@ -92,19 +96,28 @@ moduleToVHDL env cores specs = do
   vhdl <- runTranslatorSession env $ do
     let all_bindings = concat (map (\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 = concat (map (\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_ printAnns specs
+    let topbinds = Maybe.catMaybes $ map (\(top, _, _) -> top) specs
+    case topbinds of
+      []  -> error $ "Could not find top entity requested"
+      tops -> createDesignFiles (tops ++ test_binds)
   mapM (putStr . render . Ppr.ppr . snd) vhdl
   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
+    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.
@@ -116,8 +129,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
   return $ State.evalState session init_state
 
 -- | Prepares the directory for writing VHDL files. This means creating the