Remove mkConcSm from the VHDLState monad.

diff --git a/VHDL.hs b/VHDL.hs
index cdff47a0c1db9a257f9957f8299cdc8ace713343..63537c7e6f58c1a1de605ab291185a2bbdfbfdcc 100644 (file)
--- a/VHDL.hs
+++ b/VHDL.hs
@@ -5,6 +5,7 @@ module VHDL where
 
 import qualified Data.Foldable as Foldable
 import qualified Data.List as List
 
 import qualified Data.Foldable as Foldable
 import qualified Data.List as List

+import qualified Data.Map as Map

 import qualified Maybe
 import qualified Control.Monad as Monad
 import qualified Control.Arrow as Arrow
 import qualified Maybe
 import qualified Control.Monad as Monad
 import qualified Control.Arrow as Arrow


@@ -147,7 +148,8 @@ createArchitecture hsfunc fdata =
       -- TODO: Unique ty_decls
       -- TODO: Store ty_decls somewhere
       -- Create concurrent statements for all signal definitions
       -- TODO: Unique ty_decls
       -- TODO: Store ty_decls somewhere
       -- Create concurrent statements for all signal definitions

-      statements <- mapM (mkConcSm sigs) defs
+      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')
       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')


@@ -201,31 +203,38 @@ getSignalId info =
 
 -- | Transforms a signal definition into a VHDL concurrent statement
 mkConcSm ::
 
 -- | Transforms a signal definition into a VHDL concurrent statement
 mkConcSm ::

-  [(SignalId, SignalInfo)] -- | The signals in the current architecture
-  -> SigDef                -- | The signal definition
-  -> VHDLState AST.ConcSm    -- | The corresponding VHDL component instantiation.
-
-mkConcSm sigs (FApp hsfunc args res) = do
-  fdata_maybe <- getFunc hsfunc
-  let fdata = Maybe.fromMaybe
+  FuncMap                  -- ^ The functions in the current session
+  -> [(SignalId, SignalInfo)] -- ^ The signals in the current architecture
+  -> SigDef                -- ^ The signal definition 
+  -> Int                   -- ^ A number that will be unique for all
+                           --   concurrent statements in the architecture.
+  -> AST.ConcSm            -- ^ The corresponding VHDL component instantiation.
+
+mkConcSm funcs sigs (FApp hsfunc args res) num =
+  let 
+    fdata_maybe = Map.lookup hsfunc funcs
+    fdata = Maybe.fromMaybe

         (error $ "Using function '" ++ (prettyShow hsfunc) ++ "' that is not in the session? This should not happen!")
         fdata_maybe
         (error $ "Using function '" ++ (prettyShow hsfunc) ++ "' that is not in the session? This should not happen!")
         fdata_maybe

-  let entity = Maybe.fromMaybe
+    entity = Maybe.fromMaybe

         (error $ "Using function '" ++ (prettyShow hsfunc) ++ "' without entity declaration? This should not happen!")
         (funcEntity fdata)
         (error $ "Using function '" ++ (prettyShow hsfunc) ++ "' without entity declaration? This should not happen!")
         (funcEntity fdata)

-  let entity_id = ent_id entity
-  label <- uniqueName (AST.fromVHDLId entity_id)
-  -- Add a clk port if we have state
-  let clk_port = Maybe.fromJust $ mkAssocElem (Just $ mkVHDLId "clk") "clk"
-  let portmaps = mkAssocElems sigs args res entity ++ (if hasState hsfunc then [clk_port] else [])
-  return $ AST.CSISm $ AST.CompInsSm (mkVHDLId label) (AST.IUEntity (AST.NSimple entity_id)) (AST.PMapAspect portmaps)
-
-mkConcSm sigs (UncondDef src dst) = do
-  let src_expr  = vhdl_expr src
-  let src_wform = AST.Wform [AST.WformElem src_expr Nothing]
-  let dst_name  = AST.NSimple (getSignalId $ signalInfo sigs dst)
-  let assign    = dst_name AST.:<==: (AST.ConWforms [] src_wform Nothing)
-  return $ AST.CSSASm assign
+    entity_id = ent_id entity
+    label = (AST.fromVHDLId entity_id) ++ "_" ++ (show num)
+    -- Add a clk port if we have state
+    clk_port = Maybe.fromJust $ mkAssocElem (Just $ mkVHDLId "clk") "clk"
+    portmaps = mkAssocElems sigs args res entity ++ (if hasState hsfunc then [clk_port] else [])
+  in
+    AST.CSISm $ AST.CompInsSm (mkVHDLId label) (AST.IUEntity (AST.NSimple entity_id)) (AST.PMapAspect portmaps)
+
+mkConcSm _ sigs (UncondDef src dst) _ =
+  let
+    src_expr  = vhdl_expr src
+    src_wform = AST.Wform [AST.WformElem src_expr Nothing]
+    dst_name  = AST.NSimple (getSignalId $ signalInfo sigs dst)
+    assign    = dst_name AST.:<==: (AST.ConWforms [] src_wform Nothing)
+  in
+    AST.CSSASm assign

   where
     vhdl_expr (Left id) = mkIdExpr sigs id
     vhdl_expr (Right expr) =
   where
     vhdl_expr (Left id) = mkIdExpr sigs id
     vhdl_expr (Right expr) =


@@ -237,16 +246,18 @@ mkConcSm sigs (UncondDef src dst) = do
         (Eq a b) ->
           (mkIdExpr sigs a) AST.:=: (mkIdExpr sigs b)
 
         (Eq a b) ->
           (mkIdExpr sigs a) AST.:=: (mkIdExpr sigs b)
 

-mkConcSm sigs (CondDef cond true false dst) = do
-  let cond_expr  = mkIdExpr sigs cond
-  let true_expr  = mkIdExpr sigs true
-  let false_expr  = mkIdExpr sigs false
-  let false_wform = AST.Wform [AST.WformElem false_expr Nothing]
-  let true_wform = AST.Wform [AST.WformElem true_expr Nothing]
-  let whenelse = AST.WhenElse true_wform cond_expr
-  let dst_name  = AST.NSimple (getSignalId $ signalInfo sigs dst)
-  let assign    = dst_name AST.:<==: (AST.ConWforms [whenelse] false_wform Nothing)
-  return $ AST.CSSASm assign
+mkConcSm _ sigs (CondDef cond true false dst) _ =
+  let
+    cond_expr  = mkIdExpr sigs cond
+    true_expr  = mkIdExpr sigs true
+    false_expr  = mkIdExpr sigs false
+    false_wform = AST.Wform [AST.WformElem false_expr Nothing]
+    true_wform = AST.Wform [AST.WformElem true_expr Nothing]
+    whenelse = AST.WhenElse true_wform cond_expr
+    dst_name  = AST.NSimple (getSignalId $ signalInfo sigs dst)
+    assign    = dst_name AST.:<==: (AST.ConWforms [whenelse] false_wform Nothing)
+  in
+    AST.CSSASm assign

 
 -- | Turn a SignalId into a VHDL Expr
 mkIdExpr :: [(SignalId, SignalInfo)] -> SignalId -> AST.Expr
 
 -- | Turn a SignalId into a VHDL Expr
 mkIdExpr :: [(SignalId, SignalInfo)] -> SignalId -> AST.Expr