Remove createArchitecture from the VHDLState Monad.

diff --git a/Translator.hs b/Translator.hs
index c66db947dfecdf19b9859303d3bf2368aff7e03f..2a752a79d34c94cc5ccc4b32cc296b7aaeade5d2 100644 (file)
--- 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 63537c7e6f58c1a1de605ab291185a2bbdfbfdcc..f176b9eea6be2c9457280f7e720a678d4fe3f420 100644 (file)
--- 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.