X-Git-Url: https://git.stderr.nl/gitweb?a=blobdiff_plain;f=VHDLTools.hs;h=178c743b6f6b439f0bece10519671b3d45d9d075;hb=a44db062ae75b4fe3ce28368e07323130a14fe58;hp=232df43a7b86c30d05cab1d6409808aeef7e5c38;hpb=597f1b6823417f2c4cc54549f2a9d1b9f131893c;p=matthijs%2Fmaster-project%2Fc%CE%BBash.git diff --git a/VHDLTools.hs b/VHDLTools.hs index 232df43..178c743 100644 --- a/VHDLTools.hs +++ b/VHDLTools.hs @@ -100,9 +100,9 @@ mkAssocElem (Just port) signal = Just $ Just port AST.:=>: (AST.ADName (AST.NSim mkAssocElem Nothing _ = Nothing -- | Create an VHDL port -> signal association -mkAssocElemIndexed :: Maybe AST.VHDLId -> String -> AST.VHDLId -> Maybe AST.AssocElem +mkAssocElemIndexed :: Maybe AST.VHDLId -> AST.VHDLId -> AST.VHDLId -> Maybe AST.AssocElem mkAssocElemIndexed (Just port) signal index = Just $ Just port AST.:=>: (AST.ADName (AST.NIndexed (AST.IndexedName - (AST.NSimple (mkVHDLExtId signal)) [AST.PrimName $ AST.NSimple index]))) + (AST.NSimple signal) [AST.PrimName $ AST.NSimple index]))) mkAssocElemIndexed Nothing _ _ = Nothing mkComponentInst :: @@ -112,7 +112,9 @@ mkComponentInst :: -> AST.ConcSm mkComponentInst label entity_id portassigns = AST.CSISm compins where - compins = AST.CompInsSm (mkVHDLExtId label) (AST.IUEntity (AST.NSimple entity_id)) (AST.PMapAspect portassigns) + -- We always have a clock port, so no need to map it anywhere but here + clk_port = Maybe.fromJust $ mkAssocElem (Just $ mkVHDLExtId "clk") "clk" + compins = AST.CompInsSm (mkVHDLExtId label) (AST.IUEntity (AST.NSimple entity_id)) (AST.PMapAspect (portassigns ++ [clk_port])) ----------------------------------------------------------------------------- -- Functions to generate VHDL Exprs @@ -228,7 +230,7 @@ builtin_types = ] -- Translate a Haskell type to a VHDL type, generating a new type if needed. -vhdl_ty :: Type.Type -> VHDLState AST.TypeMark +vhdl_ty :: Type.Type -> VHDLSession AST.TypeMark vhdl_ty ty = do typemap <- getA vsTypes let builtin_ty = do -- See if this is a tycon and lookup its name @@ -251,7 +253,7 @@ vhdl_ty ty = do Nothing -> error $ "Unsupported Haskell type: " ++ pprString ty -- Construct a new VHDL type for the given Haskell type. -construct_vhdl_ty :: Type.Type -> VHDLState (Maybe (AST.TypeMark, Either AST.TypeDef AST.SubtypeIn)) +construct_vhdl_ty :: Type.Type -> VHDLSession (Maybe (AST.TypeMark, Either AST.TypeDef AST.SubtypeIn)) construct_vhdl_ty ty = do case Type.splitTyConApp_maybe ty of Just (tycon, args) -> do @@ -271,7 +273,7 @@ construct_vhdl_ty ty = do Nothing -> return $ Nothing -- | Create VHDL type for a custom tycon -mk_tycon_ty :: TyCon.TyCon -> [Type.Type] -> VHDLState (Maybe (AST.TypeMark, Either AST.TypeDef AST.SubtypeIn)) +mk_tycon_ty :: TyCon.TyCon -> [Type.Type] -> VHDLSession (Maybe (AST.TypeMark, Either AST.TypeDef AST.SubtypeIn)) mk_tycon_ty tycon args = case TyCon.tyConDataCons tycon of -- Not an algebraic type @@ -305,7 +307,7 @@ mk_tycon_ty tycon args = mk_vector_ty :: Int -- ^ The length of the vector -> Type.Type -- ^ The Haskell element type of the Vector - -> VHDLState (AST.TypeMark, AST.SubtypeIn) -- The typemark created. + -> VHDLSession (AST.TypeMark, AST.SubtypeIn) -- The typemark created. mk_vector_ty len el_ty = do elem_types_map <- getA vsElemTypes @@ -328,7 +330,7 @@ mk_vector_ty len el_ty = do mk_natural_ty :: Int -- ^ The minimum bound (> 0) -> Int -- ^ The maximum bound (> minimum bound) - -> VHDLState (AST.TypeMark, AST.SubtypeIn) -- The typemark created. + -> VHDLSession (AST.TypeMark, AST.SubtypeIn) -- The typemark created. mk_natural_ty min_bound max_bound = do let ty_id = mkVHDLExtId $ "nat_" ++ (show min_bound) ++ "_to_" ++ (show max_bound) let range = AST.ConstraintRange $ AST.SubTypeRange (AST.PrimLit $ (show min_bound)) (AST.PrimLit $ (show max_bound)) @@ -337,7 +339,7 @@ mk_natural_ty min_bound max_bound = do -- Finds the field labels for VHDL type generated for the given Core type, -- which must result in a record type. -getFieldLabels :: Type.Type -> VHDLState [AST.VHDLId] +getFieldLabels :: Type.Type -> VHDLSession [AST.VHDLId] getFieldLabels ty = do -- Ensure that the type is generated (but throw away it's VHDLId) vhdl_ty ty