X-Git-Url: https://git.stderr.nl/gitweb?a=blobdiff_plain;f=VHDL.hs;h=5d57bb574c98fe55f51e041306e42ccabfcf6950;hb=e73057cb92295256ab62810771da8e723f4a8223;hp=b23e5f3117acc6481e37062d2816c28754365d46;hpb=20fbdf46508998bd11da03f3abd6e8725508b0a1;p=matthijs%2Fmaster-project%2Fc%CE%BBash.git

diff --git a/VHDL.hs b/VHDL.hs
index b23e5f3..5d57bb5 100644
--- a/VHDL.hs
+++ b/VHDL.hs
@@ -15,10 +15,21 @@ import Outputable ( showSDoc, ppr )
 import qualified ForSyDe.Backend.VHDL.AST as AST
 
 import VHDLTypes
+import Flatten
 import FlattenTypes
 import TranslatorTypes
 import Pretty
 
+getDesignFile :: VHDLState AST.DesignFile
+getDesignFile = do
+  -- Extract the library units generated from all the functions in the
+  -- session.
+  funcs <- getFuncs
+  let units = concat $ map getLibraryUnits funcs
+  return $ AST.DesignFile 
+    []
+    units
+  
 -- | Create an entity for a given function
 createEntity ::
   HsFunction        -- | The function signature
@@ -57,7 +68,7 @@ createEntity hsfunc fdata =
           (sigName info)
         ty = sigTy info
 
--- | Create the VHDL AST for an entity
+  -- | Create the VHDL AST for an entity
 createEntityAST ::
   HsFunction            -- | The signature of the function we're working with
   -> [VHDLSignalMap]    -- | The entity's arguments
@@ -70,9 +81,16 @@ createEntityAST hsfunc args res =
     vhdl_id = mkEntityId hsfunc
     ports = concatMap (mapToPorts AST.In) args
             ++ mapToPorts AST.Out res
+            ++ clk_port
     mapToPorts :: AST.Mode -> VHDLSignalMap -> [AST.IfaceSigDec] 
     mapToPorts mode m =
       map (mkIfaceSigDec mode) (Foldable.toList m)
+    -- Add a clk port if we have state
+    clk_port = if hasState hsfunc
+      then
+        [AST.IfaceSigDec (mkVHDLId "clk") AST.In VHDL.std_logic_ty]
+      else
+        []
 
 -- | Create a port declaration
 mkIfaceSigDec ::
@@ -112,18 +130,37 @@ createArchitecture hsfunc fdata =
       let sig_decs = [mkSigDec info | (id, info) <- sigs, (all (id `Foldable.notElem`) (res:args)) ]
       -- Create component instantiations for all function applications
       insts <- mapM (mkCompInsSm sigs) apps
+      let procs = map mkStateProcSm (getOwnStates hsfunc flatfunc)
       let insts' = map AST.CSISm insts
-      let arch = AST.ArchBody (mkVHDLId "structural") (AST.NSimple entity_id) (map AST.BDISD sig_decs) insts'
+      let procs' = map AST.CSPSm procs
+      let arch = AST.ArchBody (mkVHDLId "structural") (AST.NSimple entity_id) (map AST.BDISD sig_decs) (insts' ++ procs')
       setArchitecture hsfunc arch
 
+mkStateProcSm :: (Int, SignalInfo, SignalInfo) -> AST.ProcSm
+mkStateProcSm (num, old, new) =
+  AST.ProcSm label [clk] [statement]
+  where
+    label       = mkVHDLId $ "state_" ++ (show num)
+    clk         = mkVHDLId "clk"
+    rising_edge = AST.NSimple $ mkVHDLId "rising_edge"
+    wform       = AST.Wform [AST.WformElem (AST.PrimName $ AST.NSimple $ getSignalId new) Nothing]
+    assign      = AST.SigAssign (AST.NSimple $ getSignalId old) wform
+    rising_edge_clk = AST.PrimFCall $ AST.FCall rising_edge [Nothing AST.:=>: (AST.ADName $ AST.NSimple clk)]
+    statement   = AST.IfSm rising_edge_clk [assign] [] Nothing
+
 mkSigDec :: SignalInfo -> AST.SigDec
 mkSigDec info =
-    AST.SigDec (mkVHDLId name) (vhdl_ty ty) Nothing
+    AST.SigDec (getSignalId info) (vhdl_ty ty) Nothing
   where
-    name = Maybe.fromMaybe
+    ty = sigTy info
+
+-- | Creates a VHDL Id from a named SignalInfo. Errors out if the SignalInfo
+--   is not named.
+getSignalId :: SignalInfo -> AST.VHDLId
+getSignalId info =
+    mkVHDLId $ Maybe.fromMaybe
       (error $ "Unnamed signal? This should not happen!")
       (sigName info)
-    ty = sigTy info
 
 -- | Transforms a flat function application to a VHDL component instantiation.
 mkCompInsSm ::
@@ -210,6 +247,10 @@ getLibraryUnits (hsfunc, fdata) =
 bit_ty :: AST.TypeMark
 bit_ty = AST.unsafeVHDLBasicId "Bit"
 
+-- | The VHDL std_logic
+std_logic_ty :: AST.TypeMark
+std_logic_ty = AST.unsafeVHDLBasicId "std_logic"
+
 -- Translate a Haskell type to a VHDL type
 vhdl_ty :: Type.Type -> AST.TypeMark
 vhdl_ty ty = Maybe.fromMaybe