- Int -- ^ The length of the vector
- -> Type.Type -- ^ The Haskell element type of the Vector
- -> VHDLSession (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)
+ Type.Type -- ^ The Haskell type of the Vector
+ -> VHDLSession (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 (nvec_l, nvec_el) = Type.splitAppTy ty
+ let (nvec, leng) = Type.splitAppTy nvec_l
+ let vec_ty = Type.mkAppTy nvec nvec_el
+ let len = tfvec_len ty
+ let el_ty = tfvec_elem ty
+ 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
+ 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 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