Make modFuncs work with stateful functions.

[matthijs/master-project/cλash.git] / VHDL.hs

diff --git a/VHDL.hs b/VHDL.hs
index 8c2fe0315b525a96fa1585b14b11b0b9b9051ef1..eac7079155bd8d0b89e02aa441b321e9be890874 100644 (file)
--- a/VHDL.hs
+++ b/VHDL.hs
@@ -22,13 +22,13 @@ import TranslatorTypes
 createEntity ::
   HsFunction        -- | The function signature
   -> FuncData       -- | The function data collected so far
-  -> FuncData       -- | The modified function data
+  -> VHDLState ()
 
 createEntity hsfunc fdata = 
   let func = flatFunc fdata in
   case func of
     -- Skip (builtin) functions without a FlatFunction
-    Nothing -> fdata
+    Nothing -> do return ()
     -- Create an entity for all other functions
     Just flatfunc ->
       
@@ -41,7 +41,7 @@ createEntity hsfunc fdata =
         ent_decl' = createEntityAST hsfunc args' res'
         entity' = Entity args' res' (Just ent_decl')
       in
-        fdata { funcEntity = Just entity' }
+        setEntity hsfunc entity'
   where
     mkMap :: Eq id => [(id, SignalInfo)] -> id -> (AST.VHDLId, AST.TypeMark)
     mkMap sigmap id =
@@ -89,28 +89,31 @@ mkEntityId hsfunc =
 createArchitecture ::
   HsFunction        -- | The function signature
   -> FuncData       -- | The function data collected so far
-  -> FuncData       -- | The modified function data
+  -> VHDLState ()
 
 createArchitecture hsfunc fdata = 
   let func = flatFunc fdata in
   case func of
     -- Skip (builtin) functions without a FlatFunction
-    Nothing -> fdata
+    Nothing -> do return ()
     -- Create an architecture for all other functions
     Just flatfunc ->
       let 
         sigs      = flat_sigs flatfunc
         args      = flat_args flatfunc
         res       = flat_res  flatfunc
+        apps      = flat_apps 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
         sig_decs = [mkSigDec info | (id, info) <- sigs, (all (id `Foldable.notElem`) (res:args)) ]
-        arch     = AST.ArchBody (mkVHDLId "structural") (AST.NSimple entity_id) (map AST.BDISD sig_decs) []
+        -- Create component instantiations for all function applications
+        insts    = map (AST.CSISm . mkCompInsSm) apps
+        arch     = AST.ArchBody (mkVHDLId "structural") (AST.NSimple entity_id) (map AST.BDISD sig_decs) insts
       in
-        fdata { funcArch = Just arch }
+        setArchitecture hsfunc arch
 
 mkSigDec :: SignalInfo -> AST.SigDec
 mkSigDec info =
@@ -120,7 +123,19 @@ mkSigDec info =
       (error $ "Unnamed signal? This should not happen!")
       (sigName info)
     ty = sigTy info
-    
+
+-- | Transforms a flat function application to a VHDL component instantiation.
+mkCompInsSm ::
+  FApp UnnamedSignal  -- | The application to look at.
+  -> AST.CompInsSm    -- | The corresponding VHDL component instantiation.
+
+mkCompInsSm app =
+  AST.CompInsSm label (AST.IUEntity (AST.NSimple entity_id)) (AST.PMapAspect portmaps)
+  where
+    entity_id = mkVHDLId "foo"
+    label     = mkVHDLId "app"
+    portmaps  = []
+
 -- | Extracts the generated entity id from the given funcdata
 getEntityId :: FuncData -> Maybe AST.VHDLId
 getEntityId fdata =