Allow name hints to be set for a signal.

[matthijs/master-project/cλash.git] / Translator.hs

diff --git a/Translator.hs b/Translator.hs
index cf2fb966876c5ffd612d00360dfe772a4adf2110..26cf79d7bb0c86d00a0ddde95ebdb11ec616cb54 100644 (file)
--- a/Translator.hs
+++ b/Translator.hs
@@ -42,10 +42,14 @@ import VHDLTypes
 import qualified VHDL
 
 main = do
+  makeVHDL "Alu.hs" "register_bank"
+
+makeVHDL :: String -> String -> IO ()
+makeVHDL filename name = do
   -- Load the module
-  core <- loadModule "Adders.hs"
+  core <- loadModule filename
   -- Translate to VHDL
-  vhdl <- moduleToVHDL core ["shifter"]
+  vhdl <- moduleToVHDL core [name]
   -- Write VHDL to file
   writeVHDL vhdl "../vhdl/vhdl/output.vhdl"
 
@@ -56,6 +60,7 @@ listBind filename name = do
   let binds = findBinds core [name]
   putStr "\n"
   putStr $ prettyShow binds
+  putStr $ showSDoc $ ppr binds
   putStr "\n\n"
 
 -- | Translate the binds with the given names from the given core module to
@@ -216,7 +221,7 @@ nameFlatFunction hsfunc fdata =
     -- Name the signals in all other functions
     Just flatfunc ->
       let s = flat_sigs flatfunc in
-      let s' = map (\(id, (SignalInfo Nothing use ty)) -> (id, SignalInfo (Just $ "sig_" ++ (show id)) use ty)) s in
+      let s' = map (\(id, (SignalInfo Nothing use ty hints)) -> (id, SignalInfo (Just $ "sig_" ++ (show id)) use ty hints)) s in
       let flatfunc' = flatfunc { flat_sigs = s' } in
       setFlatFunc hsfunc flatfunc'