From 1a10d214e6ffc7097c0f4bddf16f0dd87b5355a8 Mon Sep 17 00:00:00 2001 From: Christiaan Baaij Date: Thu, 2 Jul 2009 15:19:07 +0200 Subject: [PATCH] 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. --- Adders.hs | 4 ++-- VHDL.hs | 6 +++--- VHDLTools.hs | 19 +++++++++++-------- VHDLTypes.hs | 5 ----- 4 files changed, 16 insertions(+), 18 deletions(-) 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, -- 2.30.2