From 059c20c7b953a21097939a47ecac7f6cad05541a Mon Sep 17 00:00:00 2001
From: Matthijs Kooijman <m.kooijman@student.utwente.nl>
Date: Mon, 9 Mar 2009 10:47:46 +0100
Subject: [PATCH] Remove createArchitecture from the VHDLState Monad.

---
 Translator.hs |  3 ++-
 VHDL.hs       | 50 +++++++++++++++++++++++++-------------------------
 2 files changed, 27 insertions(+), 26 deletions(-)

diff --git a/Translator.hs b/Translator.hs
index c66db94..2a752a7 100644
--- a/Translator.hs
+++ b/Translator.hs
@@ -93,7 +93,8 @@ moduleToVHDL core list = do
       Monad.zipWithM processBind statefuls binds
       modFuncMap $ Map.map (\fdata -> fdata {flatFunc = fmap nameFlatFunction (flatFunc fdata)})
       modFuncMap $ Map.mapWithKey (\hsfunc fdata -> fdata {funcEntity = VHDL.createEntity hsfunc fdata})
-      modFuncs VHDL.createArchitecture
+      funcs <- getFuncMap
+      modFuncMap $ Map.mapWithKey (\hsfunc fdata -> fdata {funcArch = VHDL.createArchitecture funcs hsfunc fdata})
       funcs <- getFuncs
       return $ VHDL.getDesignFiles (map snd funcs)
 
diff --git a/VHDL.hs b/VHDL.hs
index 63537c7..f176b9e 100644
--- a/VHDL.hs
+++ b/VHDL.hs
@@ -124,36 +124,36 @@ mkEntityId hsfunc =
 
 -- | Create an architecture for a given function
 createArchitecture ::
-  HsFunction        -- | The function signature
-  -> FuncData       -- | The function data collected so far
-  -> VHDLState ()
+  FuncMap           -- ^ The functions in the current session
+  -> HsFunction     -- ^ The function signature
+  -> FuncData       -- ^ The function data collected so far
+  -> Maybe AST.ArchBody -- ^ The architecture for this function
 
-createArchitecture hsfunc fdata = 
-  let func = flatFunc fdata in
-  case func of
+createArchitecture funcs hsfunc fdata = 
+  case flatFunc fdata of
     -- Skip (builtin) functions without a FlatFunction
-    Nothing -> do return ()
+    Nothing -> funcArch fdata
     -- Create an architecture for all other functions
-    Just flatfunc -> do
-      let sigs = flat_sigs flatfunc
-      let args = flat_args flatfunc
-      let res  = flat_res  flatfunc
-      let defs = flat_defs flatfunc
-      let entity_id = Maybe.fromMaybe
+    Just flatfunc ->
+      let
+        sigs = flat_sigs flatfunc
+        args = flat_args flatfunc
+        res  = flat_res  flatfunc
+        defs = flat_defs flatfunc
+        entity_id = Maybe.fromMaybe
                       (error $ "Building architecture without an entity? This should not happen!")
                       (getEntityId fdata)
-      -- Create signal declarations for all signals that are not in args and
-      -- res
-      let (ty_decls, sig_decs)  = Arrow.second Maybe.catMaybes $ Traversable.traverse (mkSigDec . snd) sigs
-      -- TODO: Unique ty_decls
-      -- TODO: Store ty_decls somewhere
-      -- Create concurrent statements for all signal definitions
-      funcs <- getFuncMap
-      let statements = zipWith (mkConcSm funcs sigs) defs [0..]
-      let procs = map mkStateProcSm (makeStatePairs flatfunc)
-      let procs' = map AST.CSPSm procs
-      let arch = AST.ArchBody (mkVHDLId "structural") (AST.NSimple entity_id) (map AST.BDISD sig_decs) (statements ++ procs')
-      setArchitecture hsfunc arch
+        -- Create signal declarations for all signals that are not in args and
+        -- res
+        (ty_decls, sig_decs)  = Arrow.second Maybe.catMaybes $ Traversable.traverse (mkSigDec . snd) sigs
+        -- TODO: Unique ty_decls
+        -- TODO: Store ty_decls somewhere
+        -- Create concurrent statements for all signal definitions
+        statements = zipWith (mkConcSm funcs sigs) defs [0..]
+        procs = map mkStateProcSm (makeStatePairs flatfunc)
+        procs' = map AST.CSPSm procs
+      in
+        Just $ AST.ArchBody (mkVHDLId "structural") (AST.NSimple entity_id) (map AST.BDISD sig_decs) (statements ++ procs')
 
 -- | Looks up all pairs of old state, new state signals, together with
 --   the state id they represent.
-- 
2.30.2