X-Git-Url: https://git.stderr.nl/gitweb?a=blobdiff_plain;f=Translator.hs;h=3f60330b37a68b8680cdedec20996f28134c5a42;hb=3fb6a3a819f85d89853660347b42f6085d20fb57;hp=39446211b06e9c6c838575c3e2535b669ad9b224;hpb=3f12ee5d723fd8c01190c5971641141a8c7a9d98;p=matthijs%2Fmaster-project%2Fc%CE%BBash.git

diff --git a/Translator.hs b/Translator.hs
index 3944621..3f60330 100644
--- a/Translator.hs
+++ b/Translator.hs
@@ -1,6 +1,8 @@
 module Translator where
 import qualified Directory
 import qualified List
+import Debug.Trace
+import qualified Control.Arrow as Arrow
 import GHC hiding (loadModule, sigName)
 import CoreSyn
 import qualified CoreUtils
@@ -26,6 +28,7 @@ import MonadUtils ( liftIO )
 import Outputable ( showSDoc, ppr )
 import GHC.Paths ( libdir )
 import DynFlags ( defaultDynFlags )
+import qualified UniqSupply
 import List ( find )
 import qualified List
 import qualified Monad
@@ -43,13 +46,14 @@ import Text.PrettyPrint.HughesPJ (render)
 import TranslatorTypes
 import HsValueMap
 import Pretty
+import Normalize
 import Flatten
 import FlattenTypes
 import VHDLTypes
 import qualified VHDL
 
 main = do
-  makeVHDL "Alu.hs" "exec" True
+  makeVHDL "Adders.hs" "highordtest" True
 
 makeVHDL :: String -> String -> Bool -> IO ()
 makeVHDL filename name stateful = do
@@ -81,25 +85,31 @@ listBind filename name = do
 moduleToVHDL :: HscTypes.CoreModule -> [(String, Bool)] -> IO [(AST.VHDLId, AST.DesignFile)]
 moduleToVHDL core list = do
   let (names, statefuls) = unzip list
-  --liftIO $ putStr $ prettyShow (cm_binds core)
   let binds = findBinds core names
-  --putStr $ prettyShow binds
+  -- Generate a UniqSupply
+  -- Running 
+  --    egrep -r "(initTcRnIf|mkSplitUniqSupply)" .
+  -- on the compiler dir of ghc suggests that 'z' is not used to generate a
+  -- unique supply anywhere.
+  uniqSupply <- UniqSupply.mkSplitUniqSupply 'z'
   -- Turn bind into VHDL
-  let (vhdl, sess) = State.runState (mkVHDL binds statefuls) (TranslatorSession core 0 Map.empty)
+  let (vhdl, sess) = State.runState (mkVHDL uniqSupply binds statefuls) (TranslatorSession core 0 Map.empty)
   mapM (putStr . render . ForSyDe.Backend.Ppr.ppr . snd) vhdl
   putStr $ "\n\nFinal session:\n" ++ prettyShow sess ++ "\n\n"
   return vhdl
   where
     -- Turns the given bind into VHDL
-    mkVHDL :: [(CoreBndr, CoreExpr)] -> [Bool] -> TranslatorState [(AST.VHDLId, AST.DesignFile)]
-    mkVHDL binds statefuls = do
+    mkVHDL :: UniqSupply.UniqSupply -> [(CoreBndr, CoreExpr)] -> [Bool] -> TranslatorState [(AST.VHDLId, AST.DesignFile)]
+    mkVHDL uniqSupply binds statefuls = do
+      let binds'' = map (Arrow.second $ normalize uniqSupply) binds
+      let binds' = trace ("Before:\n\n" ++ showSDoc ( ppr binds ) ++ "\n\nAfter:\n\n" ++ showSDoc ( ppr binds'')) binds''
       -- Add the builtin functions
       --mapM addBuiltIn builtin_funcs
       -- Create entities and architectures for them
       --Monad.zipWithM processBind statefuls binds
       --modA tsFlatFuncs (Map.map nameFlatFunction)
       --flatfuncs <- getA tsFlatFuncs
-      return $ VHDL.createDesignFiles binds
+      return $ VHDL.createDesignFiles binds'
 
 -- | Write the given design file to a file with the given name inside the
 --   given dir