X-Git-Url: https://git.stderr.nl/gitweb?a=blobdiff_plain;ds=sidebyside;f=VHDL.hs;h=dabd85ab5447eb7ea6bb9f7b04ecf2e6343a6330;hb=fb29d85dcdc8ccc48f4d37f5997c7182e0b8776d;hp=ae72368f4f9fd0b6eccbe9f20f7836ef0d4da733;hpb=527a6aa73e730b0837d9cec13554ceaacb0a2fca;p=matthijs%2Fmaster-project%2Fc%CE%BBash.git

diff --git a/VHDL.hs b/VHDL.hs
index ae72368..dabd85a 100644
--- a/VHDL.hs
+++ b/VHDL.hs
@@ -3,6 +3,7 @@
 --
 module VHDL where
 
+-- Standard modules
 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
 
+-- ForSyDe
+import qualified ForSyDe.Backend.VHDL.AST as AST
+
+-- GHC API
 import qualified Type
-import qualified TysWiredIn
 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 HsTools
 
 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)
-    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 ::
@@ -168,8 +174,6 @@ createArchitecture hsfunc flatfunc = do
     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
@@ -368,13 +372,13 @@ mk_fsvec_ty ::
 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
-  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
+  -- TODO: Check name uniqueness
   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))
+
+-- vim: set ts=8 sw=2 sts=2 expandtab: