AST.CSSASm assign
mkAssocElems ::
- [CoreSyn.CoreExpr] -- | The argument that are applied to function
- -> CoreSyn.CoreBndr -- | The binder in which to store the result
+ [AST.Expr] -- | The argument that are applied to function
+ -> AST.VHDLName -- | The binder in which to store the result
-> Entity -- | The entity to map against.
-> [AST.AssocElem] -- | The resulting port maps
mkAssocElems args res entity =
-- Extract the id part from the (id, type) tuple
ports = map (Monad.liftM fst) (res_port : arg_ports)
-- Translate signal numbers into names
- sigs = (varToString res : map (varToString.exprToVar) args)
+ sigs = (vhdlNameToVHDLExpr res : args)
-- | Create an VHDL port -> signal association
-mkAssocElem :: Maybe AST.VHDLId -> String -> Maybe AST.AssocElem
-mkAssocElem (Just port) signal = Just $ Just port AST.:=>: (AST.ADName (AST.NSimple (mkVHDLExtId signal)))
+mkAssocElem :: Maybe AST.VHDLId -> AST.Expr -> Maybe AST.AssocElem
+mkAssocElem (Just port) signal = Just $ Just port AST.:=>: (AST.ADExpr signal)
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 ::
-> 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") (idToVHDLExpr $ mkVHDLExtId "clk")
+ compins = AST.CompInsSm (mkVHDLExtId label) (AST.IUEntity (AST.NSimple entity_id)) (AST.PMapAspect (portassigns ++ [clk_port]))
-----------------------------------------------------------------------------
-- Functions to generate VHDL Exprs
-- local/global here as well?
Nothing -> AST.PrimName $ AST.NSimple $ varToVHDLId var
+-- Turn a VHDLName into an AST expression
+vhdlNameToVHDLExpr = AST.PrimName
+
+-- Turn a VHDL Id into an AST expression
+idToVHDLExpr = vhdlNameToVHDLExpr . AST.NSimple
+
+-- Turn a Core expression into an AST expression
+exprToVHDLExpr = varToVHDLExpr . exprToVar
+
-- Turn a alternative constructor into an AST expression. For
-- dataconstructors, this is only the constructor itself, not any arguments it
-- has. Should not be called with a DEFAULT constructor.
varToVHDLId ::
CoreSyn.CoreBndr
-> AST.VHDLId
-varToVHDLId = mkVHDLExtId . OccName.occNameString . Name.nameOccName . Var.varName
+varToVHDLId = mkVHDLExtId . varToString
+
+-- Creates a VHDL Name from a binder
+varToVHDLName ::
+ CoreSyn.CoreBndr
+ -> AST.VHDLName
+varToVHDLName = AST.NSimple . varToVHDLId
-- Extracts the binder name as a String
varToString ::
-- Create a record field selector that selects the given label from the record
-- stored in the given binder.
-mkSelectedName :: CoreBndr -> AST.VHDLId -> AST.VHDLName
-mkSelectedName bndr label =
- let
- sel_prefix = AST.NSimple $ varToVHDLId bndr
- sel_suffix = AST.SSimple $ label
- in
- AST.NSelected $ sel_prefix AST.:.: sel_suffix
+mkSelectedName :: AST.VHDLName -> AST.VHDLId -> AST.VHDLName
+mkSelectedName name label =
+ AST.NSelected $ name AST.:.: (AST.SSimple label)
+
+-- Create an indexed name that selects a given element from a vector.
+mkIndexedName :: AST.VHDLName -> AST.Expr -> AST.VHDLName
+-- Special case for already indexed names. Just add an index
+mkIndexedName (AST.NIndexed (AST.IndexedName name indexes)) index =
+ AST.NIndexed (AST.IndexedName name (indexes++[index]))
+-- General case for other names
+mkIndexedName name index = AST.NIndexed (AST.IndexedName name [index])
-----------------------------------------------------------------------------
-- Functions dealing with VHDL 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
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
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
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
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))
-- 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