Removed the need for a special vector-type map.

Vector types are stripped of their length and then used as key.
Note that is of course an invalid haskell type, and is only meant
for internal use.

diff --git a/Adders.hs b/Adders.hs
index 2f3af384a5f186886c0c15f607f0fa13ba52a9fb..672c83c964fe630f154a802bf2feb8160865ac0d 100644 (file)
--- a/Adders.hs
+++ b/Adders.hs
@@ -174,8 +174,8 @@ highordtest = \x ->
 
 xand a b = hwand a b
 
-functiontest :: Bit -> TFVec D3 Bit
-functiontest = \a -> let r = generaten d3 hwnot a in r
+functiontest :: TFVec D4 (TFVec D3 Bit) -> TFVec D12 Bit
+functiontest = \v -> let r = concat v in r
 
 xhwnot x = hwnot x
 

diff --git a/VHDL.hs b/VHDL.hs
index 289ecf50f413af09258160065b6e2c3682a46c60..e2eb962742ce4616a9cd1eae3a44fcd299fd7671 100644 (file)
--- a/VHDL.hs
+++ b/VHDL.hs
@@ -47,12 +47,12 @@ createDesignFiles binds =
   map (Arrow.second $ AST.DesignFile full_context) units
   
   where
-    init_session = VHDLState Map.empty Map.empty Map.empty Map.empty
+    init_session = VHDLState Map.empty Map.empty Map.empty
     (units, final_session) = 
       State.runState (createLibraryUnits binds) init_session
     tyfun_decls = map snd $ Map.elems (final_session ^.vsTypeFuns)
     ty_decls = map mktydecl $ Map.elems (final_session ^. vsTypes)
-    vec_decls = map (\(v_id, v_def) -> AST.PDITD $ AST.TypeDec v_id v_def) (Map.elems (final_session ^. vsElemTypes))
+    --vec_decls = map (\(v_id, v_def) -> AST.PDITD $ AST.TypeDec v_id v_def) (Map.elems (final_session ^. vsElemTypes))
     tfvec_index_decl = AST.PDISD $ AST.SubtypeDec tfvec_indexTM tfvec_index_def
     tfvec_range = AST.ConstraintRange $ AST.SubTypeRange (AST.PrimLit "-1") (AST.PrimName $ AST.NAttribute $ AST.AttribName (AST.NSimple integerTM) highId Nothing)
     tfvec_index_def = AST.SubtypeIn integerTM (Just tfvec_range)
@@ -65,7 +65,7 @@ createDesignFiles binds =
       mkUseAll ["work", "types"]
       : (mkUseAll ["work"]
       : ieee_context)
-    type_package_dec = AST.LUPackageDec $ AST.PackageDec (mkVHDLBasicId "types") ([tfvec_index_decl] ++ vec_decls ++ ty_decls ++ subProgSpecs)
+    type_package_dec = AST.LUPackageDec $ AST.PackageDec (mkVHDLBasicId "types") ([tfvec_index_decl] ++ ty_decls ++ subProgSpecs)
     type_package_body = AST.LUPackageBody $ AST.PackageBody typesId tyfun_decls
     subProgSpecs = map subProgSpec tyfun_decls
     subProgSpec = \(AST.SubProgBody spec _ _) -> AST.PDISS spec

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)
 

diff --git a/VHDLTypes.hs b/VHDLTypes.hs
index e8a77377f87d4833963b817c6812a9e4b0699fd9..c1d9332f993d340772e2d7d9cfbb19a60187ab52 100644 (file)
--- a/VHDLTypes.hs
+++ b/VHDLTypes.hs
@@ -41,9 +41,6 @@ instance Ord OrdType where
 -- A map of a Core type to the corresponding type name
 type TypeMap = Map.Map OrdType (AST.VHDLId, Either AST.TypeDef AST.SubtypeIn)
 
--- A map of Elem types to the corresponding VHDL Id for the Vector
-type ElemTypeMap = Map.Map OrdType (AST.VHDLId, AST.TypeDef)
-
 -- A map of a vector Core element type and function name to the coressponding
 -- VHDLId of the function and the function body.
 type TypeFunMap = Map.Map (OrdType, String) (AST.VHDLId, AST.SubProgBody)
@@ -54,8 +51,6 @@ type SignatureMap = Map.Map CoreSyn.CoreBndr Entity
 data VHDLState = VHDLState {
   -- | A map of Core type -> VHDL Type
   vsTypes_      :: TypeMap,
-  -- | A map of Elem types -> VHDL Vector Id
-  vsElemTypes_   :: ElemTypeMap,
   -- | A map of vector Core type -> VHDL type function
   vsTypeFuns_   :: TypeFunMap,
   -- | A map of HsFunction -> hardware signature (entity name, port names,