import qualified Maybe
import qualified Data.Either as Either
import Data.Accessor
+import Data.Accessor.MonadState as MonadState
import Debug.Trace
-- ForSyDe
-- | Generate a function call from the destination binder, function name and a
-- list of expressions (its arguments)
- genFCall :: BuiltinBuilder
- genFCall = genExprArgs $ genExprRes genFCall'
- genFCall' :: Either CoreSyn.CoreBndr AST.VHDLName -> CoreSyn.CoreBndr -> [AST.Expr] -> VHDLSession AST.Expr
- genFCall' (Left res) f args = do
+ genFCall :: Bool -> BuiltinBuilder
+ genFCall switch = genExprArgs $ genExprRes (genFCall' switch)
+ genFCall' :: Bool -> Either CoreSyn.CoreBndr AST.VHDLName -> CoreSyn.CoreBndr -> [AST.Expr] -> VHDLSession AST.Expr
+ genFCall' switch (Left res) f args = do
let fname = varToString f
- let el_ty = (tfvec_elem . Var.varType) res
+ let el_ty = if switch then (Var.varType res) else ((tfvec_elem . Var.varType) res)
- id <- vectorFunId el_ty fname
+ id <- MonadState.lift vsType $ vectorFunId el_ty fname
return $ AST.PrimFCall $ AST.FCall (AST.NSimple id) $
map (\exp -> Nothing AST.:=>: AST.ADExpr exp) args
- genFCall' (Right name) _ _ = error $ "\nGenerate.genFCall': Cannot generate builtin function call assigned to a VHDLName: " ++ show name
+ genFCall' _ (Right name) _ _ = error $ "\nGenerate.genFCall': Cannot generate builtin function call assigned to a VHDLName: " ++ show name
-- | Generate a generate statement for the builtin function "map"
genMap :: BuiltinBuilder
-- temporary vector
let tmp_ty = Type.mkAppTy nvec (Var.varType start)
let error_msg = "\nGenerate.genFold': Can not construct temp vector for element type: " ++ pprString tmp_ty
- tmp_vhdl_ty <- vhdl_ty error_msg tmp_ty
+ tmp_vhdl_ty <- MonadState.lift vsType $ vhdl_ty error_msg tmp_ty
-- Setup the generate scheme
let gen_label = mkVHDLExtId ("foldlVector" ++ (varToString vec))
let block_label = mkVHDLExtId ("foldlVector" ++ (varToString start))
argexpr1 = vhdlNameToVHDLExpr $ mkIndexedName (varToVHDLName arg1) n_expr
argexpr2 = vhdlNameToVHDLExpr $ mkIndexedName (varToVHDLName arg2) n_expr
in do
- labels <- getFieldLabels (tfvec_elem (Var.varType res))
+ labels <- MonadState.lift vsType $ getFieldLabels (tfvec_elem (Var.varType res))
let resnameA = mkSelectedName resname' (labels!!0)
let resnameB = mkSelectedName resname' (labels!!1)
let resA_assign = mkUncondAssign (Right resnameA) argexpr1
resname' = varToVHDLName res
argexpr' = mkIndexedName (varToVHDLName arg) n_expr
in do
- reslabels <- getFieldLabels (Var.varType res)
- arglabels <- getFieldLabels (tfvec_elem (Var.varType arg))
+ reslabels <- MonadState.lift vsType $ getFieldLabels (Var.varType res)
+ arglabels <- MonadState.lift vsType $ getFieldLabels (tfvec_elem (Var.varType arg))
let resnameA = mkIndexedName (mkSelectedName resname' (reslabels!!0)) n_expr
let resnameB = mkIndexedName (mkSelectedName resname' (reslabels!!1)) n_expr
let argexprA = vhdlNameToVHDLExpr $ mkSelectedName argexpr' (arglabels!!0)
-- -- temporary vector
let tmp_ty = Var.varType res
let error_msg = "\nGenerate.genFold': Can not construct temp vector for element type: " ++ pprString tmp_ty
- tmp_vhdl_ty <- vhdl_ty error_msg tmp_ty
+ tmp_vhdl_ty <- MonadState.lift vsType $ vhdl_ty error_msg tmp_ty
-- Setup the generate scheme
let gen_label = mkVHDLExtId ("iterateVector" ++ (varToString start))
let block_label = mkVHDLExtId ("iterateVector" ++ (varToString res))
-- It's a datacon. Create a record from its arguments.
Left bndr -> do
-- We have the bndr, so we can get at the type
- labels <- getFieldLabels (Var.varType bndr)
+ labels <- MonadState.lift vsType $ getFieldLabels (Var.varType bndr)
return $ zipWith mkassign labels $ map (either exprToVHDLExpr id) args
where
mkassign :: AST.VHDLId -> AST.Expr -> AST.ConcSm
-- Returns the VHDLId of the vector function with the given name for the given
-- element type. Generates -- this function if needed.
-vectorFunId :: Type.Type -> String -> VHDLSession AST.VHDLId
+vectorFunId :: Type.Type -> String -> TypeSession AST.VHDLId
vectorFunId el_ty fname = do
let error_msg = "\nGenerate.vectorFunId: Can not construct vector function for element: " ++ pprString el_ty
elemTM <- vhdl_ty error_msg el_ty
-- builder function.
globalNameTable :: NameTable
globalNameTable = Map.fromList
- [ (exId , (2, genFCall ) )
- , (replaceId , (3, genFCall ) )
- , (headId , (1, genFCall ) )
- , (lastId , (1, genFCall ) )
- , (tailId , (1, genFCall ) )
- , (initId , (1, genFCall ) )
- , (takeId , (2, genFCall ) )
- , (dropId , (2, genFCall ) )
- , (selId , (4, genFCall ) )
- , (plusgtId , (2, genFCall ) )
- , (ltplusId , (2, genFCall ) )
- , (plusplusId , (2, genFCall ) )
+ [ (exId , (2, genFCall False ) )
+ , (replaceId , (3, genFCall False ) )
+ , (headId , (1, genFCall True ) )
+ , (lastId , (1, genFCall True ) )
+ , (tailId , (1, genFCall False ) )
+ , (initId , (1, genFCall False ) )
+ , (takeId , (2, genFCall False ) )
+ , (dropId , (2, genFCall False ) )
+ , (selId , (4, genFCall False ) )
+ , (plusgtId , (2, genFCall False ) )
+ , (ltplusId , (2, genFCall False ) )
+ , (plusplusId , (2, genFCall False ) )
, (mapId , (2, genMap ) )
, (zipWithId , (3, genZipWith ) )
, (foldlId , (3, genFoldl ) )
, (foldrId , (3, genFoldr ) )
, (zipId , (2, genZip ) )
, (unzipId , (1, genUnzip ) )
- , (shiftlId , (2, genFCall ) )
- , (shiftrId , (2, genFCall ) )
- , (rotlId , (1, genFCall ) )
- , (rotrId , (1, genFCall ) )
+ , (shiftlId , (2, genFCall False ) )
+ , (shiftrId , (2, genFCall False ) )
+ , (rotlId , (1, genFCall False ) )
+ , (rotrId , (1, genFCall False ) )
, (concatId , (1, genConcat ) )
- , (reverseId , (1, genFCall ) )
+ , (reverseId , (1, genFCall False ) )
, (iteratenId , (3, genIteraten ) )
, (iterateId , (2, genIterate ) )
, (generatenId , (3, genGeneraten ) )
, (generateId , (2, genGenerate ) )
- , (emptyId , (0, genFCall ) )
- , (singletonId , (1, genFCall ) )
- , (copynId , (2, genFCall ) )
+ , (emptyId , (0, genFCall False ) )
+ , (singletonId , (1, genFCall False ) )
+ , (copynId , (2, genFCall False ) )
, (copyId , (1, genCopy ) )
- , (lengthTId , (1, genFCall ) )
- , (nullId , (1, genFCall ) )
+ , (lengthTId , (1, genFCall False ) )
+ , (nullId , (1, genFCall False ) )
, (hwxorId , (2, genOperator2 AST.Xor ) )
, (hwandId , (2, genOperator2 AST.And ) )
, (hworId , (2, genOperator2 AST.Or ) )
-- Standard modules
import qualified Maybe
+import qualified Data.Either as Either
import qualified Data.List as List
import qualified Data.Map as Map
import qualified Control.Monad as Monad
]
-- Translate a Haskell type to a VHDL type, generating a new type if needed.
-vhdl_ty :: String -> Type.Type -> VHDLSession AST.TypeMark
+-- Returns an error value, using the given message, when no type could be
+-- created.
+vhdl_ty :: String -> Type.Type -> TypeSession AST.TypeMark
vhdl_ty msg ty = do
+ tm_either <- vhdl_ty_either ty
+ case tm_either of
+ Right tm -> return tm
+ Left err -> error $ msg ++ "\n" ++ err
+
+-- Translate a Haskell type to a VHDL type, generating a new type if needed.
+-- Returns either an error message or the resulting type.
+vhdl_ty_either :: Type.Type -> TypeSession (Either String AST.TypeMark)
+vhdl_ty_either ty = do
typemap <- getA vsTypes
+ htype <- mkHType ty
let builtin_ty = do -- See if this is a tycon and lookup its name
(tycon, args) <- Type.splitTyConApp_maybe ty
let name = Name.getOccString (TyCon.tyConName tycon)
Map.lookup name builtin_types
-- If not a builtin type, try the custom types
- let existing_ty = (fmap fst) $ Map.lookup (OrdType ty) typemap
+ let existing_ty = (fmap fst) $ Map.lookup htype typemap
case Monoid.getFirst $ Monoid.mconcat (map Monoid.First [builtin_ty, existing_ty]) of
-- Found a type, return it
- Just t -> return t
+ Just t -> return (Right t)
-- No type yet, try to construct it
Nothing -> do
- newty_maybe <- (construct_vhdl_ty msg ty)
+ newty_maybe <- (construct_vhdl_ty ty)
case newty_maybe of
- Just (ty_id, ty_def) -> do
+ Right (ty_id, ty_def) -> do
-- TODO: Check name uniqueness
- modA vsTypes (Map.insert (OrdType ty) (ty_id, ty_def))
+ modA vsTypes (Map.insert htype (ty_id, ty_def))
modA vsTypeDecls (\typedefs -> typedefs ++ [mktydecl (ty_id, ty_def)])
- return ty_id
- Nothing -> error $ msg ++ "\nVHDLTools.vhdl_ty: Unsupported Haskell type: " ++ pprString ty ++ "\n"
-
--- Construct a new VHDL type for the given Haskell type.
-construct_vhdl_ty :: String -> Type.Type -> VHDLSession (Maybe (AST.TypeMark, Either AST.TypeDef AST.SubtypeIn))
-construct_vhdl_ty msg ty = do
+ return (Right ty_id)
+ Left err -> return $ Left $
+ "VHDLTools.vhdl_ty: Unsupported Haskell type: " ++ pprString ty ++ "\n"
+ ++ err
+
+-- Construct a new VHDL type for the given Haskell type. Returns an error
+-- message or the resulting typemark and typedef.
+construct_vhdl_ty :: Type.Type -> TypeSession (Either String (AST.TypeMark, Either AST.TypeDef AST.SubtypeIn))
+construct_vhdl_ty ty = do
case Type.splitTyConApp_maybe ty of
Just (tycon, args) -> do
let name = Name.getOccString (TyCon.tyConName tycon)
case name of
- "TFVec" -> do
- res <- mk_vector_ty ty
- return $ Just $ (Arrow.second Right) res
+ "TFVec" -> mk_vector_ty ty
-- "SizedWord" -> do
-- res <- mk_vector_ty (sized_word_len ty) ty
-- return $ Just $ (Arrow.second Left) res
- "RangedWord" -> do
- res <- mk_natural_ty 0 (ranged_word_bound ty)
- return $ Just $ (Arrow.second Right) res
+ "RangedWord" -> mk_natural_ty 0 (ranged_word_bound ty)
-- Create a custom type from this tycon
- otherwise -> mk_tycon_ty msg tycon args
- Nothing -> return $ Nothing
+ otherwise -> mk_tycon_ty tycon args
+ Nothing -> return (Left $ "VHDLTools.construct_vhdl_ty: Cannot create type for non-tycon type: " ++ pprString ty ++ "\n")
-- | Create VHDL type for a custom tycon
-mk_tycon_ty :: String -> TyCon.TyCon -> [Type.Type] -> VHDLSession (Maybe (AST.TypeMark, Either AST.TypeDef AST.SubtypeIn))
-mk_tycon_ty msg tycon args =
+mk_tycon_ty :: TyCon.TyCon -> [Type.Type] -> TypeSession (Either String (AST.TypeMark, Either AST.TypeDef AST.SubtypeIn))
+mk_tycon_ty tycon args =
case TyCon.tyConDataCons tycon of
-- Not an algebraic type
- [] -> error $ "\nVHDLTools.mk_tycon_ty: Only custom algebraic types are supported: " ++ pprString tycon
+ [] -> return (Left $ "VHDLTools.mk_tycon_ty: Only custom algebraic types are supported: " ++ pprString tycon ++ "\n")
[dc] -> do
let arg_tys = DataCon.dataConRepArgTys dc
-- TODO: CoreSubst docs say each Subs can be applied only once. Is this a
-- violation? Or does it only mean not to apply it again to the same
-- subject?
let real_arg_tys = map (CoreSubst.substTy subst) arg_tys
- let error_msg = msg ++ "\nVHDLTools.mk_tycon_ty: Can not construct type for: " ++ pprString tycon ++ "\n because no type can be construced for one of the arguments."
- elem_tys <- mapM (vhdl_ty error_msg) real_arg_tys
- let elems = zipWith AST.ElementDec recordlabels elem_tys
- -- For a single construct datatype, build a record with one field for
- -- each argument.
- -- TODO: Add argument type ids to this, to ensure uniqueness
- -- TODO: Special handling for tuples?
- let elem_names = concat $ map prettyShow elem_tys
- let ty_id = mkVHDLExtId $ nameToString (TyCon.tyConName tycon) ++ elem_names
- let ty_def = AST.TDR $ AST.RecordTypeDef elems
- return $ Just (ty_id, Left ty_def)
- dcs -> error $ "\nVHDLTools.mk_tycon_ty: Only single constructor datatypes supported: " ++ pprString tycon
+ elem_tys_either <- mapM vhdl_ty_either real_arg_tys
+ case Either.partitionEithers elem_tys_either of
+ -- No errors in element types
+ ([], elem_tys) -> do
+ let elems = zipWith AST.ElementDec recordlabels elem_tys
+ -- For a single construct datatype, build a record with one field for
+ -- each argument.
+ -- TODO: Add argument type ids to this, to ensure uniqueness
+ -- TODO: Special handling for tuples?
+ let elem_names = concat $ map prettyShow elem_tys
+ let ty_id = mkVHDLExtId $ nameToString (TyCon.tyConName tycon) ++ elem_names
+ let ty_def = AST.TDR $ AST.RecordTypeDef elems
+ return $ Right (ty_id, Left ty_def)
+ -- There were errors in element types
+ (errors, _) -> return $ Left $
+ "VHDLTools.mk_tycon_ty: Can not construct type for: " ++ pprString tycon ++ "\n because no type can be construced for some of the arguments.\n"
+ ++ (concat errors)
+ dcs -> return $ Left $ "VHDLTools.mk_tycon_ty: Only single constructor datatypes supported: " ++ pprString tycon ++ "\n"
where
-- Create a subst that instantiates all types passed to the tycon
-- TODO: I'm not 100% sure that this is the right way to do this. It seems
-- | Create a VHDL vector type
mk_vector_ty ::
Type.Type -- ^ The Haskell type of the Vector
- -> VHDLSession (AST.TypeMark, AST.SubtypeIn) -- The typemark created.
+ -> TypeSession (Either String (AST.TypeMark, Either AST.TypeDef AST.SubtypeIn))
+ -- ^ An error message or The typemark created.
mk_vector_ty ty = do
types_map <- getA vsTypes
let vec_ty = Type.mkAppTy nvec nvec_el
let len = tfvec_len ty
let el_ty = tfvec_elem ty
- let error_msg = "\nVHDLTools.mk_vector_ty: Can not construct vectortype for elementtype: " ++ pprString el_ty
- el_ty_tm <- vhdl_ty error_msg el_ty
- let ty_id = mkVHDLExtId $ "vector-"++ (AST.fromVHDLId el_ty_tm) ++ "-0_to_" ++ (show len)
- let range = AST.ConstraintIndex $ AST.IndexConstraint [AST.ToRange (AST.PrimLit "0") (AST.PrimLit $ show (len - 1))]
- let existing_elem_ty = (fmap fst) $ Map.lookup (StdType $ OrdType vec_ty) types_map
- case existing_elem_ty of
- Just t -> do
- let ty_def = AST.SubtypeIn t (Just range)
- return (ty_id, ty_def)
- Nothing -> do
- let vec_id = mkVHDLExtId $ "vector_" ++ (AST.fromVHDLId el_ty_tm)
- let vec_def = AST.TDA $ AST.UnconsArrayDef [tfvec_indexTM] el_ty_tm
- modA vsTypes (Map.insert (StdType $ OrdType vec_ty) (vec_id, (Left vec_def)))
- modA vsTypeDecls (\typedefs -> typedefs ++ [mktydecl (vec_id, (Left vec_def))])
- let ty_def = AST.SubtypeIn vec_id (Just range)
- return (ty_id, ty_def)
+ el_ty_tm_either <- vhdl_ty_either el_ty
+ case el_ty_tm_either of
+ -- Could create element type
+ Right el_ty_tm -> do
+ let ty_id = mkVHDLExtId $ "vector-"++ (AST.fromVHDLId el_ty_tm) ++ "-0_to_" ++ (show len)
+ let range = AST.ConstraintIndex $ AST.IndexConstraint [AST.ToRange (AST.PrimLit "0") (AST.PrimLit $ show (len - 1))]
- let existing_elem_ty = (fmap fst) $ Map.lookup (OrdType vec_ty) types_map
++ let existing_elem_ty = (fmap fst) $ Map.lookup (StdType $ OrdType vec_ty) types_map
+ case existing_elem_ty of
+ Just t -> do
+ let ty_def = AST.SubtypeIn t (Just range)
+ return (Right (ty_id, Right ty_def))
+ Nothing -> do
+ let vec_id = mkVHDLExtId $ "vector_" ++ (AST.fromVHDLId el_ty_tm)
+ let vec_def = AST.TDA $ AST.UnconsArrayDef [tfvec_indexTM] el_ty_tm
- modA vsTypes (Map.insert (OrdType vec_ty) (vec_id, (Left vec_def)))
++ modA vsTypes (Map.insert (StdType $ OrdType vec_ty) (vec_id, (Left vec_def)))
+ modA vsTypeDecls (\typedefs -> typedefs ++ [mktydecl (vec_id, (Left vec_def))])
+ let ty_def = AST.SubtypeIn vec_id (Just range)
+ return (Right (ty_id, Right ty_def))
+ -- Could not create element type
+ Left err -> return $ Left $
+ "VHDLTools.mk_vector_ty: Can not construct vectortype for elementtype: " ++ pprString el_ty ++ "\n"
+ ++ err
mk_natural_ty ::
Int -- ^ The minimum bound (> 0)
-> Int -- ^ The maximum bound (> minimum bound)
- -> VHDLSession (AST.TypeMark, AST.SubtypeIn) -- The typemark created.
+ -> TypeSession (Either String (AST.TypeMark, Either AST.TypeDef AST.SubtypeIn))
+ -- ^ An error message or The typemark created.
mk_natural_ty min_bound max_bound = do
let ty_id = mkVHDLExtId $ "nat_" ++ (show min_bound) ++ "_to_" ++ (show max_bound)
let range = AST.ConstraintRange $ AST.SubTypeRange (AST.PrimLit $ (show min_bound)) (AST.PrimLit $ (show max_bound))
let ty_def = AST.SubtypeIn naturalTM (Just range)
- return (ty_id, ty_def)
+ return (Right (ty_id, Right ty_def))
-- Finds the field labels for VHDL type generated for the given Core type,
-- which must result in a record type.
-getFieldLabels :: Type.Type -> VHDLSession [AST.VHDLId]
+getFieldLabels :: Type.Type -> TypeSession [AST.VHDLId]
getFieldLabels ty = do
-- Ensure that the type is generated (but throw away it's VHDLId)
let error_msg = "\nVHDLTools.getFieldLabels: Can not get field labels, because: " ++ pprString ty ++ "can not be generated."
vhdl_ty error_msg ty
-- Get the types map, lookup and unpack the VHDL TypeDef
types <- getA vsTypes
- case Map.lookup (OrdType ty) types of
+ htype <- mkHType ty
+ case Map.lookup htype types of
Just (_, Left (AST.TDR (AST.RecordTypeDef elems))) -> return $ map (\(AST.ElementDec id _) -> id) elems
_ -> error $ "\nVHDL.getFieldLabels: Type not found or not a record type? This should not happen! Type: " ++ (show ty)
mktydecl :: (AST.VHDLId, Either AST.TypeDef AST.SubtypeIn) -> AST.PackageDecItem
mktydecl (ty_id, Left ty_def) = AST.PDITD $ AST.TypeDec ty_id ty_def
mktydecl (ty_id, Right ty_def) = AST.PDISD $ AST.SubtypeDec ty_id ty_def
-mkHType :: Type.Type -> VHDLSession HType
+
-mkTyConHType :: TyCon.TyCon -> [Type.Type] -> VHDLSession HType
++mkHType :: Type.Type -> TypeSession HType
+ mkHType ty = do
+ -- FIXME: Do we really need to do this here again?
+ let builtin_ty = do -- See if this is a tycon and lookup its name
+ (tycon, args) <- Type.splitTyConApp_maybe ty
+ let name = Name.getOccString (TyCon.tyConName tycon)
+ Map.lookup name builtin_types
+ case builtin_ty of
+ Just typ ->
+ return $ BuiltinType $ prettyShow typ
+ Nothing ->
+ case Type.splitTyConApp_maybe ty of
+ Just (tycon, args) -> do
+ let name = Name.getOccString (TyCon.tyConName tycon)
+ case name of
+ "TFVec" -> do
+ elem_htype <- mkHType (tfvec_elem ty)
+ return $ VecType (tfvec_len ty) elem_htype
+ otherwise -> do
+ mkTyConHType tycon args
+ Nothing -> return $ StdType $ OrdType ty
+
+ -- FIXME: Do we really need to do this here again?
- subst = CoreSubst.extendTvSubstList CoreSubst.emptySubst (zip tyvars args)
++mkTyConHType :: TyCon.TyCon -> [Type.Type] -> TypeSession HType
+ mkTyConHType tycon args =
+ case TyCon.tyConDataCons tycon of
+ -- Not an algebraic type
+ [] -> error $ "\nVHDLTools.mkHType: Only custom algebraic types are supported: " ++ pprString tycon
+ [dc] -> do
+ let arg_tys = DataCon.dataConRepArgTys dc
+ let real_arg_tys = map (CoreSubst.substTy subst) arg_tys
+ elem_htys <- mapM mkHType real_arg_tys
+ return $ ADTType (nameToString (TyCon.tyConName tycon)) elem_htys
+ dcs -> error $ "\nVHDLTools.mkHType: Only single constructor datatypes supported: " ++ pprString tycon
+ where
+ tyvars = TyCon.tyConTyVars tycon
++ subst = CoreSubst.extendTvSubstList CoreSubst.emptySubst (zip tyvars args)
instance Ord OrdType where
compare (OrdType a) (OrdType b) = Type.tcCmpType a b
+ data HType = StdType OrdType |
+ ADTType String [HType] |
+ VecType Int HType |
+ BuiltinType String
+ deriving (Eq, Ord)
+
-- A map of a Core type to the corresponding type name
- type TypeMap = Map.Map OrdType (AST.VHDLId, Either AST.TypeDef AST.SubtypeIn)
+ type TypeMap = Map.Map HType (AST.VHDLId, Either AST.TypeDef AST.SubtypeIn)
-- A map of a vector Core element type and function name to the coressponding
-- VHDLId of the function and the function body.
-- A map of a Haskell function to a hardware signature
type SignatureMap = Map.Map CoreSyn.CoreBndr Entity
-data VHDLState = VHDLState {
+data TypeState = TypeState {
-- | A map of Core type -> VHDL Type
vsTypes_ :: TypeMap,
-- | A list of type declarations
vsTypeDecls_ :: [AST.PackageDecItem],
-- | A map of vector Core type -> VHDL type function
- vsTypeFuns_ :: TypeFunMap,
+ vsTypeFuns_ :: TypeFunMap
+}
+-- Derive accessors
+$( Data.Accessor.Template.deriveAccessors ''TypeState )
+-- Define an empty TypeState
+emptyTypeState = TypeState Map.empty [] Map.empty
+-- Define a session
+type TypeSession = State.State TypeState
+
+data VHDLState = VHDLState {
+ -- | A subtype with typing info
+ vsType_ :: TypeState,
-- | A map of HsFunction -> hardware signature (entity name, port names,
-- etc.)
vsSignatures_ :: SignatureMap
-- | The state containing a VHDL Session
type VHDLSession = State.State VHDLState
--- | A substate containing just the types
-type TypeState = State.State TypeMap
-
-- A function that generates VHDL for a builtin function
type BuiltinBuilder =
(Either CoreSyn.CoreBndr AST.VHDLName) -- ^ The destination signal and it's original type