Add support for translating designs defined over multiple modules

Have to test the stability, it works for HighOrdAlu

diff --git a/HighOrdAlu.hs b/HighOrdAlu.hs
index e5dcbfddfd22eb96021e03315b462d41c16dcef6..bdbdc3c28821a8aae361e33d445cffb5c05d41bc 100644 (file)
--- a/HighOrdAlu.hs
+++ b/HighOrdAlu.hs
@@ -6,28 +6,7 @@ import qualified Prelude as P
 import CLasH.HardwareTypes
 import CLasH.Translator.Annotations
 
-constant :: NaturalT n => e -> Op n e
-constant e a b = copy e
-
-invop :: Op n Bit
-invop a b = map hwnot a
-
-andop :: (e -> e -> e) -> Op n e
-andop f a b = zipWith f a b
-
--- Is any bit set?
---anyset :: (PositiveT n) => Op n Bit
-anyset :: NaturalT n => (e -> e -> e) -> e -> Op n e
---anyset a b = copy undefined (a' `hwor` b')
-anyset f s a b = constant (f a' b') a b
-  where 
-    a' = foldl f s a
-    b' = foldl f s b
-
-xhwor = hwor
-
-type Op n e = (Vector n e -> Vector n e -> Vector n e)
-type Opcode = Bit
+import HighOrdAluOps
 
 {-# ANN sim_input TestInput#-}
 sim_input :: [(Opcode, Vector D4 (SizedInt D8), Vector D4 (SizedInt D8))]

diff --git a/HighOrdAluOps.hs b/HighOrdAluOps.hs
new file mode 100644 (file)
index 0000000..3d05ab9
--- /dev/null
+++ b/HighOrdAluOps.hs
@@ -0,0 +1,28 @@
+module HighOrdAluOps where
+
+import qualified Prelude as P
+import CLasH.HardwareTypes
+import CLasH.Translator.Annotations
+
+constant :: NaturalT n => e -> Op n e
+constant e a b = copy e
+
+invop :: Op n Bit
+invop a b = map hwnot a
+
+andop :: (e -> e -> e) -> Op n e
+andop f a b = zipWith f a b
+
+-- Is any bit set?
+--anyset :: (PositiveT n) => Op n Bit
+anyset :: NaturalT n => (e -> e -> e) -> e -> Op n e
+--anyset a b = copy undefined (a' `hwor` b')
+anyset f s a b = constant (f a' b') a b
+  where 
+    a' = foldl f s a
+    b' = foldl f s b
+
+xhwor = hwor
+
+type Op n e = (Vector n e -> Vector n e -> Vector n e)
+type Opcode = Bit
\ No newline at end of file

diff --git a/cλash/CLasH/Translator.hs b/cλash/CLasH/Translator.hs
index c120edc9badd448ee71837540c98d4e89adec115..f60d225f8bed1ac4f80804bf0dfc5b66178ffa35 100644 (file)
--- a/cλash/CLasH/Translator.hs
+++ b/cλash/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,15 +94,18 @@ 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
+    mkTest (Nothing, _, _) = return Nothing
+    mkTest (Just top, _, Just input) = do
       bndr <- createTestbench Nothing cores input top
       return $ Just bndr
 

diff --git a/cλash/CLasH/Translator/TranslatorTypes.hs b/cλash/CLasH/Translator/TranslatorTypes.hs
index 47deeef9844d6089871ac3af4277c17513acae29..280a2177fdf3414bec638a5b41da979bb8101874 100644 (file)
--- a/cλash/CLasH/Translator/TranslatorTypes.hs
+++ b/cλash/CLasH/Translator/TranslatorTypes.hs
@@ -27,7 +27,7 @@ import CLasH.VHDL.VHDLTypes
 -- | A specification of an entity we can generate VHDL for. Consists of the
 --   binder of the top level entity, an optional initial state and an optional
 --   test input.
-type EntitySpec = (CoreSyn.CoreBndr, Maybe CoreSyn.CoreExpr, Maybe CoreSyn.CoreExpr)
+type EntitySpec = (Maybe CoreSyn.CoreBndr, Maybe CoreSyn.CoreExpr, Maybe CoreSyn.CoreExpr)
 
 -- | A function that knows which parts of a module to compile
 type Finder =

diff --git a/cλash/CLasH/Utils/GhcTools.hs b/cλash/CLasH/Utils/GhcTools.hs
index 5b9bc350e3da973f678c679308b73cc4fd2abeb7..9139c786d13c13c01674531a5eecdda3fb0477e2 100644 (file)
--- a/cλash/CLasH/Utils/GhcTools.hs
+++ b/cλash/CLasH/Utils/GhcTools.hs
@@ -161,6 +161,7 @@ findSpec topc statec testc mod = do
   top <- findBind topc mod
   state <- findExpr statec mod
   test <- findExpr testc mod
-  case top of
-    Just t -> return [(t, state, test)]
-    Nothing -> error $ "Could not find top entity requested"
+  return [(top, state, test)]
+  -- case top of
+  --   Just t -> return [(t, state, test)]
+  --   Nothing -> return error $ "Could not find top entity requested"