Removed the need for a special vector-type map.

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

diff --git a/VHDLTools.hs b/VHDLTools.hs
index 06aec7feab602c70478bdeafd9a701e5f4844556..5f467b01391d230f66b82a1c016aceb6e577a25a 100644 (file)
--- a/VHDLTools.hs
+++ b/VHDLTools.hs
@@ -292,7 +292,7 @@ construct_vhdl_ty msg ty = do
       let name = Name.getOccString (TyCon.tyConName tycon)
       case name of
         "TFVec" -> do
-          res <- mk_vector_ty (tfvec_len ty) (tfvec_elem ty)
+          res <- mk_vector_ty ty
           return $ Just $ (Arrow.second Right) res
         -- "SizedWord" -> do
         --   res <- mk_vector_ty (sized_word_len ty) ty
@@ -339,17 +339,21 @@ mk_tycon_ty msg tycon args =
 
 -- | Create a VHDL vector type
 mk_vector_ty ::
-  Int -- ^ The length of the vector
-  -> Type.Type -- ^ The Haskell element type of the Vector
+  Type.Type -- ^ The Haskell type of the Vector
   -> VHDLSession (AST.TypeMark, AST.SubtypeIn) -- The typemark created.
 
-mk_vector_ty len el_ty = do
-  elem_types_map <- getA vsElemTypes
+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
   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 (OrdType el_ty) elem_types_map
+  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)
@@ -357,8 +361,7 @@ mk_vector_ty len el_ty = do
     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)) 
+      modA vsTypes (Map.insert (OrdType vec_ty) (vec_id, (Left vec_def)))
       let ty_def = AST.SubtypeIn vec_id (Just range)
       return (ty_id, ty_def)