Create state procs for state signals.

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

diff --git a/Translator.hs b/Translator.hs
index 37a812b2bceca493cf1e95824c6b7ea4b4484d4e..c037a1e24a0d30a8f97aeca69c815fa65ad9e97d 100644 (file)
--- a/Translator.hs
+++ b/Translator.hs
@@ -37,6 +37,7 @@ import HsValueMap
 import Pretty
 import Flatten
 import FlattenTypes
+import VHDLTypes
 import qualified VHDL
 
 main = 
@@ -53,7 +54,7 @@ main =
           --core <- GHC.compileToCoreSimplified "Adders.hs"
           core <- GHC.compileToCoreSimplified "Adders.hs"
           --liftIO $ printBinds (cm_binds core)
-          let binds = Maybe.mapMaybe (findBind (cm_binds core)) ["sfull_adder"]
+          let binds = Maybe.mapMaybe (findBind (cm_binds core)) ["dff"]
           liftIO $ putStr $ prettyShow binds
           -- Turn bind into VHDL
           let (vhdl, sess) = State.runState (mkVHDL binds) (VHDLSession core 0 Map.empty)
@@ -187,7 +188,7 @@ nameFlatFunction hsfunc fdata =
     -- Name the signals in all other functions
     Just flatfunc ->
       let s = flat_sigs flatfunc in
-      let s' = map (\(id, (SignalInfo Nothing ty)) -> (id, SignalInfo (Just $ "sig_" ++ (show id)) ty)) s in
+      let s' = map (\(id, (SignalInfo Nothing use ty)) -> (id, SignalInfo (Just $ "sig_" ++ (show id)) use ty)) s in
       let flatfunc' = flatfunc { flat_sigs = s' } in
       setFlatFunc hsfunc flatfunc'
 
@@ -211,13 +212,20 @@ type PortMap = HsValueMap (String, AST.TypeMark)
 -- | A consise representation of a builtin function
 data BuiltIn = BuiltIn String [PortMap] PortMap
 
+-- | Map a port specification of a builtin function to a VHDL Signal to put in
+--   a VHDLSignalMap
+toVHDLSignalMap :: HsValueMap (String, AST.TypeMark) -> VHDLSignalMap
+toVHDLSignalMap = fmap (\(name, ty) -> (VHDL.mkVHDLId name, ty))
+
 -- | Translate a concise representation of a builtin function to something
 --   that can be put into FuncMap directly.
 addBuiltIn :: BuiltIn -> VHDLState ()
 addBuiltIn (BuiltIn name args res) = do
     addFunc hsfunc
+    setEntity hsfunc entity
   where
     hsfunc = HsFunction name (map useAsPort args) (useAsPort res)
+    entity = Entity (VHDL.mkVHDLId name) (map toVHDLSignalMap args) (toVHDLSignalMap res) Nothing
 
 builtin_funcs = 
   [