From: Christiaan Baaij <christiaan.baaij@gmail.com>
Date: Thu, 2 Jul 2009 13:19:07 +0000 (+0200)
Subject: Removed the need for a special vector-type map.
X-Git-Url: https://git.stderr.nl/gitweb?a=commitdiff_plain;h=1a10d214e6ffc7097c0f4bddf16f0dd87b5355a8;p=matthijs%2Fmaster-project%2Fc%CE%BBash.git

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 2f3af38..672c83c 100644
--- 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 289ecf5..e2eb962 100644
--- 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 06aec7f..5f467b0 100644
--- 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 e8a7737..c1d9332 100644
--- 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,