X-Git-Url: https://git.stderr.nl/gitweb?a=blobdiff_plain;f=c%CE%BBash%2FCLasH%2FTranslator.hs;h=f60d225f8bed1ac4f80804bf0dfc5b66178ffa35;hb=ef73954eae9eef99f0a6edc1fcdbccf024f5e31d;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..f60d225 100644
--- "a/c\316\273ash/CLasH/Translator.hs"
+++ "b/c\316\273ash/CLasH/Translator.hs"
@@ -76,7 +76,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
@@ -94,16 +94,19 @@ moduleToVHDL env cores specs = do
     -- Store the bindings we loaded
     tsBindings %= Map.fromList all_bindings 
     test_binds <- catMaybesM $ Monad.mapM mkTest specs
-    let topbinds = map (\(top, _, _) -> top) specs
-    createDesignFiles (topbinds ++ test_binds)
+    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
 
 -- Run the given translator session. Generates a new UniqSupply for that