Use the actual FSVec length to create VHDL vectors.

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

diff --git a/VHDL.hs b/VHDL.hs
index ae72368f4f9fd0b6eccbe9f20f7836ef0d4da733..dabd85ab5447eb7ea6bb9f7b04ecf2e6343a6330 100644 (file)
--- a/VHDL.hs
+++ b/VHDL.hs
@@ -3,6 +3,7 @@
 --
 module VHDL where
 
 --
 module VHDL where
 

+-- Standard modules

 import qualified Data.Foldable as Foldable
 import qualified Data.List as List
 import qualified Data.Map as Map
 import qualified Data.Foldable as Foldable
 import qualified Data.List as List
 import qualified Data.Map as Map


@@ -15,39 +16,44 @@ import qualified Data.Monoid as Monoid
 import Data.Accessor
 import qualified Data.Accessor.MonadState as MonadState
 
 import Data.Accessor
 import qualified Data.Accessor.MonadState as MonadState
 

+-- ForSyDe
+import qualified ForSyDe.Backend.VHDL.AST as AST
+
+-- GHC API

 import qualified Type
 import qualified Type

-import qualified TysWiredIn

 import qualified Name
 import qualified TyCon
 import Outputable ( showSDoc, ppr )
 
 import qualified Name
 import qualified TyCon
 import Outputable ( showSDoc, ppr )
 

-import qualified ForSyDe.Backend.VHDL.AST as AST
-
+-- Local imports

 import VHDLTypes
 import Flatten
 import FlattenTypes
 import TranslatorTypes
 import HsValueMap
 import Pretty
 import VHDLTypes
 import Flatten
 import FlattenTypes
 import TranslatorTypes
 import HsValueMap
 import Pretty

+import HsTools

 
 createDesignFiles ::
   FlatFuncMap
   -> [(AST.VHDLId, AST.DesignFile)]
 
 createDesignFiles flatfuncmap =
 
 createDesignFiles ::
   FlatFuncMap
   -> [(AST.VHDLId, AST.DesignFile)]
 
 createDesignFiles flatfuncmap =

-  -- TODO: Output types
-  (mkVHDLId "types", AST.DesignFile [] [type_package]) :
-  map (Arrow.second $ AST.DesignFile context) units
+  (mkVHDLId "types", AST.DesignFile ieee_context [type_package]) :
+  map (Arrow.second $ AST.DesignFile full_context) units

   
   where
     init_session = VHDLSession Map.empty builtin_funcs
     (units, final_session) = 
       State.runState (createLibraryUnits flatfuncmap) init_session
     ty_decls = Map.elems (final_session ^. vsTypes)
   
   where
     init_session = VHDLSession Map.empty builtin_funcs
     (units, final_session) = 
       State.runState (createLibraryUnits flatfuncmap) init_session
     ty_decls = Map.elems (final_session ^. vsTypes)

-    context = [
-      AST.Library $ mkVHDLId "IEEE",
-      AST.Use $ (AST.NSimple $ mkVHDLId "IEEE.std_logic_1164") AST.:.: AST.All,
-      AST.Use $ (AST.NSimple $ mkVHDLId "work.types") AST.:.: AST.All]
+    ieee_context = [
+        AST.Library $ mkVHDLId "IEEE",
+        AST.Use $ (AST.NSimple $ mkVHDLId "IEEE.std_logic_1164") AST.:.: AST.All
+      ]
+    full_context =
+      (AST.Use $ (AST.NSimple $ mkVHDLId "work.types") AST.:.: AST.All)
+      : ieee_context

     type_package = AST.LUPackageDec $ AST.PackageDec (mkVHDLId "types") (map (AST.PDITD . snd) ty_decls)
 
 createLibraryUnits ::
     type_package = AST.LUPackageDec $ AST.PackageDec (mkVHDLId "types") (map (AST.PDITD . snd) ty_decls)
 
 createLibraryUnits ::


@@ -168,8 +174,6 @@ createArchitecture hsfunc flatfunc = do
     args = flat_args flatfunc
     res  = flat_res  flatfunc
     defs = flat_defs flatfunc
     args = flat_args flatfunc
     res  = flat_res  flatfunc
     defs = flat_defs flatfunc

-    -- TODO: Unique ty_decls
-    -- TODO: Store ty_decls somewhere

     procs = map mkStateProcSm (makeStatePairs flatfunc)
     procs' = map AST.CSPSm procs
     -- mkSigDec only uses vsTypes from the state
     procs = map mkStateProcSm (makeStatePairs flatfunc)
     procs' = map AST.CSPSm procs
     -- mkSigDec only uses vsTypes from the state


@@ -368,13 +372,13 @@ mk_fsvec_ty ::
 mk_fsvec_ty ty args = do
   -- Assume there are two type arguments
   let [len, el_ty] = args 
 mk_fsvec_ty ty args = do
   -- Assume there are two type arguments
   let [len, el_ty] = args 

-  -- TODO: Find actual number
-  -- Construct the type id, but filter out dots (since these are not allowed).
-  let ty_id = mkVHDLId $ filter (/='.') ("vector_" ++ (show len))
+  let len_int = eval_type_level_int len
+  let ty_id = mkVHDLId $ "vector_" ++ (show len_int)

   -- TODO: Use el_ty
   -- TODO: Use el_ty

-  let range = AST.IndexConstraint [AST.ToRange (AST.PrimLit "0") (AST.PrimLit "16")]
+  let range = AST.IndexConstraint [AST.ToRange (AST.PrimLit "0") (AST.PrimLit $ show (len_int - 1))]

   let ty_def = AST.TDA $ AST.ConsArrayDef range std_logic_ty
   let ty_dec = AST.TypeDec ty_id ty_def
   let ty_def = AST.TDA $ AST.ConsArrayDef range std_logic_ty
   let ty_dec = AST.TypeDec ty_id ty_def

+  -- TODO: Check name uniqueness

   State.modify (Map.insert (OrdType ty) (ty_id, ty_dec))
   return ty_id
 
   State.modify (Map.insert (OrdType ty) (ty_id, ty_dec))
   return ty_id
 


@@ -425,3 +429,5 @@ builtin_funcs = mkBuiltins
 --   a VHDLSignalMap
 toVHDLSignalMap :: HsValueMap (String, AST.TypeMark) -> VHDLSignalMap
 toVHDLSignalMap = fmap (\(name, ty) -> Just (mkVHDLId name, ty))
 --   a VHDLSignalMap
 toVHDLSignalMap :: HsValueMap (String, AST.TypeMark) -> VHDLSignalMap
 toVHDLSignalMap = fmap (\(name, ty) -> Just (mkVHDLId name, ty))

+
+-- vim: set ts=8 sw=2 sts=2 expandtab: