- -> Type.Type -- ^ The Haskell type to create a VHDL type for
- -> VHDLState (AST.TypeMark, AST.TypeDef) -- The typemark created.
-
-mk_vector_ty len ty = do
- -- Assume there is a single type argument
- let ty_id = mkVHDLExtId $ "vector_" ++ (show len)
- -- TODO: Use el_ty
- let range = AST.IndexConstraint [AST.ToRange (AST.PrimLit "0") (AST.PrimLit $ show (len - 1))]
- let ty_def = AST.TDA $ AST.ConsArrayDef range std_logic_ty
- modA vsTypeFuns (Map.insert (OrdType ty) (genUnconsVectorFuns std_logic_ty ty_id))
+ -> Type.Type -- ^ The Haskell element type of the Vector
+ -> VHDLState (AST.TypeMark, AST.SubtypeIn) -- The typemark created.
+
+mk_vector_ty len el_ty = do
+ elem_types_map <- getA vsElemTypes
+ el_ty_tm <- vhdl_ty 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 (OrdType el_ty) elem_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 vsElemTypes (Map.insert (OrdType el_ty) (vec_id, vec_def))
+ modA vsTypeFuns (Map.insert (OrdType el_ty) (genUnconsVectorFuns el_ty_tm vec_id))
+ let ty_def = AST.SubtypeIn vec_id (Just range)
+ return (ty_id, ty_def)
+
+mk_natural_ty ::
+ Int -- ^ The minimum bound (> 0)
+ -> Int -- ^ The maximum bound (> minimum bound)
+ -> VHDLState (AST.TypeMark, AST.SubtypeIn) -- 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)