Let mkCompInsSm look up the actual VHDL entity id.

Previously, it would always instantiate "foo". This also adds another
entity id field to the "Entity" type, since builtin function don't have a
VHDL EntityDec, but do need an id.

diff --git a/Pretty.hs b/Pretty.hs
index 78876b30127b835e314dfcf4493edf77d69d6d01..2bf57f761541e3280bec0a32175c78a12d81b344 100644 (file)
--- a/Pretty.hs
+++ b/Pretty.hs
@@ -74,8 +74,9 @@ instance Pretty FuncData where
       pparch (Just _) = text "VHDL architecture present"
 
 instance Pretty Entity where
-  pPrint (Entity args res decl) =
-    text "Args: " $$ nest 10 (pPrint args)
+  pPrint (Entity id args res decl) =
+    text "Entity id: " $$ nest 10 (pPrint id)
+    $+$ text "Args: " $$ nest 10 (pPrint args)
     $+$ text "Result: " $$ nest 10 (pPrint res)
     $+$ ppdecl decl
     where

diff --git a/VHDL.hs b/VHDL.hs
index 8c0a2ec93835605f964ea0745159b86a59739fd2..38a3bd6f185fad3267a4050b7cfc8b77902aec2e 100644 (file)
--- a/VHDL.hs
+++ b/VHDL.hs
@@ -5,6 +5,7 @@ module VHDL where
 
 import qualified Data.Foldable as Foldable
 import qualified Maybe
+import qualified Control.Monad as Monad
 
 import qualified Type
 import qualified Name
@@ -16,6 +17,7 @@ import qualified ForSyDe.Backend.VHDL.AST as AST
 import VHDLTypes
 import FlattenTypes
 import TranslatorTypes
+import Pretty
 
 -- | Create an entity for a given function
 createEntity ::
@@ -38,7 +40,8 @@ createEntity hsfunc fdata =
         args'   = map (fmap (mkMap sigs)) args
         res'    = fmap (mkMap sigs) res
         ent_decl' = createEntityAST hsfunc args' res'
-        entity' = Entity args' res' (Just ent_decl')
+        AST.EntityDec entity_id _ = ent_decl' 
+        entity' = Entity entity_id args' res' (Just ent_decl')
       in
         setEntity hsfunc entity'
   where
@@ -128,9 +131,17 @@ mkCompInsSm ::
   -> VHDLState AST.CompInsSm    -- | The corresponding VHDL component instantiation.
 
 mkCompInsSm app = do
+  let hsfunc = appFunc app
+  fdata_maybe <- getFunc hsfunc
+  let fdata = Maybe.fromMaybe
+        (error $ "Using function '" ++ (prettyShow hsfunc) ++ "' that is not in the session? This should not happen!")
+        fdata_maybe
+  let entity = Maybe.fromMaybe
+        (error $ "Using function '" ++ (prettyShow hsfunc) ++ "' without entity declaration? This should not happen!")
+        (funcEntity fdata)
+  let entity_id = ent_id entity
   return $ AST.CompInsSm label (AST.IUEntity (AST.NSimple entity_id)) (AST.PMapAspect portmaps)
   where
-    entity_id = mkVHDLId "foo"
     label     = mkVHDLId "app"
     portmaps  = []
 

diff --git a/VHDLTypes.hs b/VHDLTypes.hs
index 44696479e6719de98c5f3f67bdcd6aa261b7e808..9ae197c4e99ea9bfa80bb858227396c3522cd810 100644 (file)
--- a/VHDLTypes.hs
+++ b/VHDLTypes.hs
@@ -13,6 +13,7 @@ type VHDLSignalMap = SignalMap (AST.VHDLId, AST.TypeMark)
 -- info on how to map a haskell value (argument / result) on to the entity's
 -- ports.
 data Entity = Entity {
+  ent_id     :: AST.VHDLId,           -- The id of the entity
   ent_args   :: [VHDLSignalMap],      -- A mapping of each function argument to port names
   ent_res    :: VHDLSignalMap,        -- A mapping of the function result to port names
   ent_decl   :: Maybe AST.EntityDec   -- The actual entity declaration. Can be empty for builtin functions.