X-Git-Url: https://git.stderr.nl/gitweb?a=blobdiff_plain;f=Translator.hs;h=eb4e59f5da01448e8390445e6a511593c626941d;hb=6917dbf733c6c9d7ecfe1796133664be26b6b1dc;hp=6a784251d3c310240fc657b8a0c183980cc80202;hpb=d3a445954d4e2f93ff64839f4db72e7541b69a86;p=matthijs%2Fmaster-project%2Fc%CE%BBash.git

diff --git a/Translator.hs b/Translator.hs
index 6a78425..eb4e59f 100644
--- a/Translator.hs
+++ b/Translator.hs
@@ -14,6 +14,7 @@ import qualified Control.Monad.State as State
 import qualified Data.Foldable as Foldable
 import Name
 import qualified Data.Map as Map
+import Data.Accessor
 import Data.Generics
 import NameEnv ( lookupNameEnv )
 import qualified HscTypes
@@ -91,9 +92,10 @@ moduleToVHDL core list = do
       mapM addBuiltIn builtin_funcs
       -- Create entities and architectures for them
       Monad.zipWithM processBind statefuls binds
-      modFuncs nameFlatFunction
-      modFuncMap $ Map.mapWithKey (\hsfunc fdata -> fdata {funcEntity = VHDL.createEntity hsfunc fdata})
-      modFuncs VHDL.createArchitecture
+      modFuncMap $ Map.map (fdFlatFunc ^: (fmap nameFlatFunction))
+      modFuncMap $ Map.mapWithKey (\hsfunc fdata -> fdEntity ^= (VHDL.createEntity hsfunc fdata) $ fdata)
+      funcs <- getFuncMap
+      modFuncMap $ Map.mapWithKey (\hsfunc fdata -> fdArch ^= (VHDL.createArchitecture funcs hsfunc fdata) $ fdata)
       funcs <- getFuncs
       return $ VHDL.getDesignFiles (map snd funcs)
 
@@ -332,21 +334,15 @@ mkHsFunction f ty stateful=
 
 -- | Adds signal names to the given FlatFunction
 nameFlatFunction ::
-  HsFunction
-  -> FuncData
-  -> VHDLState ()
+  FlatFunction
+  -> FlatFunction
 
-nameFlatFunction hsfunc fdata =
-  let func = flatFunc fdata in
-  case func of
-    -- Skip (builtin) functions without a FlatFunction
-    Nothing -> do return ()
-    -- Name the signals in all other functions
-    Just flatfunc ->
-      let s = flat_sigs flatfunc in
-      let s' = map nameSignal s in
-      let flatfunc' = flatfunc { flat_sigs = s' } in
-      setFlatFunc hsfunc flatfunc'
+nameFlatFunction flatfunc =
+  -- Name the signals
+  let 
+    s = flat_sigs flatfunc
+    s' = map nameSignal s in
+  flatfunc { flat_sigs = s' }
   where
     nameSignal :: (SignalId, SignalInfo) -> (SignalId, SignalInfo)
     nameSignal (id, info) =