From 579289ed9e6b89fcf1da4f6ee4234332f2905195 Mon Sep 17 00:00:00 2001
From: Christiaan Baaij <christiaan.baaij@gmail.com>
Date: Fri, 7 Aug 2009 15:58:14 +0200
Subject: [PATCH] Add support for translating designs defined over multiple
 modules

Have to test the stability, it works for HighOrdAlu
---
 HighOrdAlu.hs                                 | 23 +--------------
 HighOrdAluOps.hs                              | 28 +++++++++++++++++++
 "c\316\273ash/CLasH/Translator.hs"            | 11 +++++---
 .../CLasH/Translator/TranslatorTypes.hs"      |  2 +-
 "c\316\273ash/CLasH/Utils/GhcTools.hs"        |  7 +++--
 5 files changed, 41 insertions(+), 30 deletions(-)
 create mode 100644 HighOrdAluOps.hs

diff --git a/HighOrdAlu.hs b/HighOrdAlu.hs
index e5dcbfd..bdbdc3c 100644
--- 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
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\316\273ash/CLasH/Translator.hs" "b/c\316\273ash/CLasH/Translator.hs"
index c120edc..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,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\316\273ash/CLasH/Translator/TranslatorTypes.hs" "b/c\316\273ash/CLasH/Translator/TranslatorTypes.hs"
index 47deeef..280a217 100644
--- "a/c\316\273ash/CLasH/Translator/TranslatorTypes.hs"
+++ "b/c\316\273ash/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\316\273ash/CLasH/Utils/GhcTools.hs" "b/c\316\273ash/CLasH/Utils/GhcTools.hs"
index 5b9bc35..9139c78 100644
--- "a/c\316\273ash/CLasH/Utils/GhcTools.hs"
+++ "b/c\316\273ash/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"
-- 
2.30.2