--
module VHDL where
+-- Standard modules
import qualified Data.Foldable as Foldable
import qualified Data.List as List
import qualified Data.Map as Map
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 ::
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
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
-- 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: