Add the new HsTools module.

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

diff --git a/VHDL.hs b/VHDL.hs
index 4d8b6669d69503a7f8977eaac1996488648a9ccd..b577110db761643e37d83fa0e7caad7a4a7f061b 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,14 +16,16 @@ 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 VHDLTypes
 import Flatten
 import FlattenTypes


@@ -35,7 +38,6 @@ createDesignFiles ::
   -> [(AST.VHDLId, AST.DesignFile)]
 
 createDesignFiles flatfuncmap =
   -> [(AST.VHDLId, AST.DesignFile)]
 
 createDesignFiles flatfuncmap =

-  -- TODO: Output types

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


@@ -171,8 +173,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


@@ -378,6 +378,7 @@ mk_fsvec_ty ty args = do
   let range = AST.IndexConstraint [AST.ToRange (AST.PrimLit "0") (AST.PrimLit "16")]
   let ty_def = AST.TDA $ AST.ConsArrayDef range std_logic_ty
   let ty_dec = AST.TypeDec ty_id ty_def
   let range = AST.IndexConstraint [AST.ToRange (AST.PrimLit "0") (AST.PrimLit "16")]
   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
 


@@ -428,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: