From fcd5e88b1c14a3129253de9e8c225e3b13e041e7 Mon Sep 17 00:00:00 2001
From: Matthijs Kooijman <m.kooijman@student.utwente.nl>
Date: Fri, 13 Feb 2009 12:17:58 +0100
Subject: [PATCH] Create an entity for each function.

The entity does not yet contain the actual VHDL entity, but does contain
the argument / result to port name map.
---
 Pretty.hs          | 21 +++++++++++++++++++-
 Translator.hs      |  1 +
 TranslatorTypes.hs | 10 +++++++---
 VHDL.hs            | 49 ++++++++++++++++++++++++++++++++++++++++++++--
 4 files changed, 75 insertions(+), 6 deletions(-)

diff --git a/Pretty.hs b/Pretty.hs
index d4ed8f0..3797fe2 100644
--- a/Pretty.hs
+++ b/Pretty.hs
@@ -7,9 +7,13 @@ import qualified HscTypes
 import Text.PrettyPrint.HughesPJClass
 import Outputable ( showSDoc, ppr, Outputable, OutputableBndr)
 
+import qualified ForSyDe.Backend.Ppr
+import qualified ForSyDe.Backend.VHDL.AST as AST
+
 import HsValueMap
 import FlattenTypes
 import TranslatorTypes
+import VHDLTypes
 
 instance Pretty HsFunction where
   pPrint (HsFunction name args res) =
@@ -52,18 +56,33 @@ instance Pretty VHDLSession where
     $+$ text "NameCount: " $$ nest 15 (int nameCount)
     $+$ text "Functions: " $$ nest 15 (vcat (map ppfunc (Map.toList funcs)))
     where
-      ppfunc (hsfunc, (FuncData flatfunc)) =
+      ppfunc (hsfunc, (FuncData flatfunc entity)) =
         pPrint hsfunc $+$ (text "Flattened: " $$ nest 15 (ppffunc flatfunc))
+        $+$ (text "Entity") $$ nest 15 (ppent entity)
       ppffunc (Just f) = pPrint f
       ppffunc Nothing  = text "Nothing"
+      ppent (Just e)   = pPrint e
+      ppent Nothing    = text "Nothing"
       modname = showSDoc $ Module.pprModule (HscTypes.cm_module mod)
 
+instance Pretty Entity where
+  pPrint (Entity args res decl) =
+    text "Args: " $$ nest 10 (pPrint args)
+    $+$ text "Result: " $$ nest 10 (pPrint res)
+    $+$ ppdecl decl
+    where
+      ppdecl Nothing = text "VHDL entity not present"
+      ppdecl (Just _) = text "VHDL entity present"
+
 instance (OutputableBndr b) => Pretty (CoreSyn.Bind b) where
   pPrint (CoreSyn.NonRec b expr) =
     text "NonRec: " $$ nest 10 (prettyBind (b, expr))
   pPrint (CoreSyn.Rec binds) =
     text "Rec: " $$ nest 10 (vcat $ map (prettyBind) binds)
 
+instance Pretty AST.VHDLId where
+  pPrint id = ForSyDe.Backend.Ppr.ppr id
+
 prettyBind :: (Outputable b, Outputable e) => (b, e) -> Doc
 prettyBind (b, expr) =
   text b' <> text " = " <> text expr'
diff --git a/Translator.hs b/Translator.hs
index 6b96ebc..30a71c5 100644
--- a/Translator.hs
+++ b/Translator.hs
@@ -69,6 +69,7 @@ main =
       -- Create entities and architectures for them
       mapM processBind binds
       modFuncs nameFlatFunction
+      modFuncs VHDL.createEntity
       return $ AST.DesignFile 
         []
         []
diff --git a/TranslatorTypes.hs b/TranslatorTypes.hs
index 271a5d3..75967c2 100644
--- a/TranslatorTypes.hs
+++ b/TranslatorTypes.hs
@@ -5,9 +5,12 @@
 module TranslatorTypes where
 
 import qualified Control.Monad.State as State
-import qualified HscTypes
 import qualified Data.Map as Map
+
+import qualified HscTypes
+
 import FlattenTypes
+import VHDLTypes
 import HsValueMap
 
 
@@ -17,7 +20,8 @@ type FuncMap  = Map.Map HsFunction FuncData
 
 -- | Some stuff we collect about a function along the way.
 data FuncData = FuncData {
-  flatFunc :: Maybe FlatFunction
+  flatFunc :: Maybe FlatFunction,
+  entity   :: Maybe Entity
 }
 
 data VHDLSession = VHDLSession {
@@ -30,7 +34,7 @@ data VHDLSession = VHDLSession {
 addFunc :: HsFunction -> VHDLState ()
 addFunc hsfunc = do
   fs <- State.gets funcs -- Get the funcs element from the session
-  let fs' = Map.insert hsfunc (FuncData Nothing) fs -- Insert function
+  let fs' = Map.insert hsfunc (FuncData Nothing Nothing) fs -- Insert function
   State.modify (\x -> x {funcs = fs' })
 
 -- | Find the given function in the current session
diff --git a/VHDL.hs b/VHDL.hs
index c5e7cbc..9562377 100644
--- a/VHDL.hs
+++ b/VHDL.hs
@@ -3,14 +3,59 @@
 --
 module VHDL where
 
-import Flatten
+import Data.Traversable
+import qualified Maybe
+
 import qualified Type
 import qualified Name
 import qualified TyCon
-import qualified Maybe
 import Outputable ( showSDoc, ppr )
+
 import qualified ForSyDe.Backend.VHDL.AST as AST
 
+import VHDLTypes
+import FlattenTypes
+import TranslatorTypes
+
+-- | Create an entity for a given function
+createEntity ::
+  HsFunction        -- | The function signature
+  -> FuncData       -- | The function data collected so far
+  -> FuncData       -- | The modified function data
+
+createEntity hsfunc fdata = 
+  let func = flatFunc fdata in
+  case func of
+    -- Skip (builtin) functions without a FlatFunction
+    Nothing -> fdata
+    -- Create an entity for all other functions
+    Just flatfunc ->
+      
+      let 
+        s       = sigs flatfunc
+        a       = args flatfunc
+        r       = res  flatfunc
+        args'   = map (fmap (mkMap s)) a
+        res'    = fmap (mkMap s) r
+        entity' = Entity args' res' Nothing
+      in
+        fdata { entity = Just entity' }
+  where
+    mkMap :: Eq id => [(id, SignalInfo)] -> id -> AST.VHDLId
+    mkMap sigmap id =
+      mkVHDLId nm
+      where
+        info = Maybe.fromMaybe
+          (error $ "Signal not found in the name map? This should not happen!")
+          (lookup id sigmap)
+        nm = Maybe.fromMaybe
+          (error $ "Signal not named? This should not happen!")
+          (name info)
+      
+
+
+
+
 -- | The VHDL Bit type
 bit_ty :: AST.TypeMark
 bit_ty = AST.unsafeVHDLBasicId "Bit"
-- 
2.30.2