Generate more unique variable names, generate truely unique entity names

diff --git a/cλash/CLasH/Translator.hs b/cλash/CLasH/Translator.hs
index f60d225f8bed1ac4f80804bf0dfc5b66178ffa35..6528f540d7a4d639a6a5dc4eab1a61d1db0bce44 100644 (file)
--- a/cλash/CLasH/Translator.hs
+++ b/cλash/CLasH/Translator.hs
@@ -120,7 +120,7 @@ runTranslatorSession env session = do
   -- 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_state = TranslatorState uniqSupply init_typestate Map.empty Map.empty 0 Map.empty Map.empty
   return $ State.evalState session init_state
 
 -- | Prepares the directory for writing VHDL files. This means creating the

diff --git a/cλash/CLasH/Translator/TranslatorTypes.hs b/cλash/CLasH/Translator/TranslatorTypes.hs
index 280a2177fdf3414bec638a5b41da979bb8101874..7483504fd08c12083c4ff58038eca4a916ffafe5 100644 (file)
--- a/cλash/CLasH/Translator/TranslatorTypes.hs
+++ b/cλash/CLasH/Translator/TranslatorTypes.hs
@@ -86,6 +86,7 @@ data TranslatorState = TranslatorState {
   , tsType_ :: TypeState
   , tsBindings_ :: Map.Map CoreSyn.CoreBndr CoreSyn.CoreExpr
   , tsNormalized_ :: Map.Map CoreSyn.CoreBndr CoreSyn.CoreExpr
+  , tsEntityCounter_ :: Integer
   , tsEntities_ :: Map.Map CoreSyn.CoreBndr Entity
   , tsArchitectures_ :: Map.Map CoreSyn.CoreBndr (Architecture, [CoreSyn.CoreBndr])
 }

diff --git a/cλash/CLasH/Utils/GhcTools.hs b/cλash/CLasH/Utils/GhcTools.hs
index 9139c786d13c13c01674531a5eecdda3fb0477e2..6e9a6dca85e57039159e2d925da536023cc59933 100644 (file)
--- a/cλash/CLasH/Utils/GhcTools.hs
+++ b/cλash/CLasH/Utils/GhcTools.hs
@@ -89,7 +89,7 @@ loadModules libdir filenames finder =
     GHC.runGhc (Just libdir) $ do
       dflags <- GHC.getSessionDynFlags
       GHC.setSessionDynFlags dflags
-      cores <- mapM GHC.compileToCoreSimplified filenames
+      cores <- mapM GHC.compileToCoreModule filenames
       env <- GHC.getSession
       specs <- case finder of
         Nothing -> return []

diff --git a/cλash/CLasH/VHDL/Generate.hs b/cλash/CLasH/VHDL/Generate.hs
index 0e147b369c8fd77159908907f1a95f9fb18e23e7..99d5d270dc976ef84abe470bac6249a02db1feaa 100644 (file)
--- a/cλash/CLasH/VHDL/Generate.hs
+++ b/cλash/CLasH/VHDL/Generate.hs
@@ -52,7 +52,9 @@ getEntity fname = Utils.makeCached fname tsEntities $ do
       let (CoreSyn.Let binds (CoreSyn.Var res)) = letexpr
       -- TODO: Handle Nothing
       res' <- mkMap res
-      let vhdl_id = mkVHDLBasicId $ varToString fname ++ "_" ++ varToStringUniq fname
+      count <- getA tsEntityCounter 
+      let vhdl_id = mkVHDLBasicId $ varToString fname ++ "Component_" ++ show count
+      putA tsEntityCounter (count + 1)
       let ent_decl = createEntityAST vhdl_id args' res'
       let signature = Entity vhdl_id args' res' ent_decl
       return signature

diff --git a/cλash/CLasH/VHDL/VHDLTools.hs b/cλash/CLasH/VHDL/VHDLTools.hs
index 4c41d8fab2221de65114f68a8c62ee62eaf2d674..2cd647bad3a5f0b0ca55d57ae7ad12e2b2eb95cf 100644 (file)
--- a/cλash/CLasH/VHDL/VHDLTools.hs
+++ b/cλash/CLasH/VHDL/VHDLTools.hs
@@ -183,7 +183,7 @@ dataconToVHDLExpr dc = AST.PrimLit lit
 varToVHDLId ::
   CoreSyn.CoreBndr
   -> AST.VHDLId
-varToVHDLId = mkVHDLExtId . varToString
+varToVHDLId var = mkVHDLExtId $ (varToString var ++ varToStringUniq var)
 
 -- Creates a VHDL Name from a binder
 varToVHDLName ::

diff --git a/reducer.hs b/reducer.hs
index 7c224f2a8903870b8477a55a154859c9f9f75f7b..65730f4ec084f652c029f1e742d6d5a368e57e9e 100644 (file)
--- a/reducer.hs
+++ b/reducer.hs
@@ -50,6 +50,7 @@ type InputState     = State ( Vector (AdderDepth :+: D1) ReducerSignal
 type FpAdderState   = State (Vector AdderDepth ReducerSignal)
 
 type OutputState    = State ( MemState DataInt
+                            , MemState DataInt
                             , RAM ArrayIndex
                             , RAM Bit
                       )
@@ -193,22 +194,22 @@ wrenable: write enable flag
 Output:
 data_out: value of 'mem' at location 'rdaddr'
 -}
+{-# NOINLINE blockRAM #-}
 blockRAM :: (MemState a) -> 
             ( a
             , Discr
             , Discr
-            , Discr
             , Bit
             ) -> 
-            (MemState a, (a, a) )
-blockRAM (State mem) (data_in, rdaddr1, rdaddr2, wraddr, wrenable) = 
-  ((State mem'), (data_out1,data_out2))
+            ((MemState a), a )
+blockRAM (State mem) (data_in, rdaddr, wraddr, wrenable) = 
+  ((State mem'), data_out)
   where
-    data_out1               = mem!rdaddr1 
-    data_out2               = mem!rdaddr2
+    data_out  = mem!rdaddr
     -- Only write data_in to memory if write is enabled
-    mem'  | wrenable == Low = mem
-          | otherwise       = replace mem wraddr data_in
+    mem' = case wrenable of
+      Low   ->  mem
+      High  ->  replace mem wraddr data_in
 
 {-
 Output logic - Determines when values are released from blockram to the output
@@ -241,9 +242,9 @@ outputter ::  OutputState ->
               , Bit
               ) -> 
               (OutputState, (ReducerSignal, OutputSignal))                 
-outputter (State (mem,  lut, valid))
+outputter (State (mem1, mem2, lut, valid))
   (discr, index, new_discr, data_in, rdaddr, wraddr, wrenable) = 
-  ((State (mem', lut', valid')), (data_out, output))
+  ((State (mem1', mem2', lut', valid')), (data_out, output))
   where
     -- Lut is updated when new discriminator/index combination enters system        
     lut'    | new_discr /= Low  = replace lut discr index
@@ -255,20 +256,24 @@ outputter (State (mem,  lut, valid))
     -- Location becomes invalid when it is fed back into the pipeline
     valid'  | wrenable == Low   = replace valid'' rdaddr Low
             | otherwise         = replace valid'' wraddr High
-    (mem', mem_out)             = blockRAM mem ( data_in
+    (mem1', mem_out1)           = blockRAM mem1 ( data_in
                                                 , rdaddr
-                                                , discr
                                                 , wraddr
                                                 , wrenable
                                                 )
-    data_out                    = ( ( (fst mem_out)
+    (mem2', mem_out2)           = blockRAM mem2 ( data_in
+                                            , discr
+                                            , wraddr
+                                            , wrenable
+                                            )
+    data_out                    = ( ( (mem_out1)
                                     , rdaddr
                                     )
                                   , (valid!rdaddr)
                                   )
     -- Reduced row is released when new discriminator enters system
     -- And the position at the discriminator holds a valid value
-    output                      = ( ( (snd mem_out)
+    output                      = ( ( (mem_out2)
                                     , (lut!discr)
                                     )
                                   , (new_discr `hwand` (valid!discr))
@@ -478,6 +483,7 @@ initstate = State
     )
   , State (copy ((0::DataInt,0::Discr),Low))
   , State ( State (copy (0::DataInt))
+          , State (copy (0::DataInt))
           , (copy (0::ArrayIndex))
           , (copy Low)
           )