module Generate where
-
+
+import qualified Control.Monad as Monad
+import qualified Maybe
+
import qualified ForSyDe.Backend.VHDL.AST as AST
import Constants
+import VHDLTypes
+
+-- | Generate a binary operator application. The first argument should be a
+-- constructor from the AST.Expr type, e.g. AST.And.
+genExprOp2 :: (AST.Expr -> AST.Expr -> AST.Expr) -> [AST.Expr] -> AST.Expr
+genExprOp2 op [arg1, arg2] = op arg1 arg2
+
+-- | Generate a unary operator application
+genExprOp1 :: (AST.Expr -> AST.Expr) -> [AST.Expr] -> AST.Expr
+genExprOp1 op [arg] = op arg
-- | Generate a function call from the Function Name and a list of expressions
-- (its arguments)
AST.PrimFCall $ AST.FCall (AST.NSimple fName) $
map (\exp -> Nothing AST.:=>: AST.ADExpr exp) args
--- | List version of genExprFCall1
-genExprFCall1L :: AST.VHDLId -> [AST.Expr] -> AST.Expr
-genExprFCall1L fName [arg] = genExprFCall fName [arg]
-genExprFCall1L _ _ = error "Generate.genExprFCall1L incorrect length"
-
--- | List version of genExprFCall2
-genExprFCall2L :: AST.VHDLId -> [AST.Expr] -> AST.Expr
-genExprFCall2L fName [arg1, arg2] = genExprFCall fName [arg1,arg2]
-genExprFCall2L _ _ = error "Generate.genExprFCall2L incorrect length"
+-- | Generate a generate statement for the builtin function "map"
+genMapCall ::
+ Int -- | The length of the vector
+ -> Entity -- | The entity to map
+ -> AST.VHDLId -- | The input vector
+ -> AST.VHDLId -- | The output vector
+ -> AST.GenerateSm -- | The resulting generate statement
+genMapCall len entity arg res = genSm
+ where
+ label = AST.unsafeVHDLBasicId "mapVector"
+ nPar = AST.unsafeVHDLBasicId "n"
+ range = AST.ToRange (AST.PrimLit "0") (AST.PrimLit $ show (len-1))
+ genScheme = AST.ForGn nPar range
+ entity_id = ent_id entity
+ argport = map (Monad.liftM fst) (ent_args entity)
+ resport = (Monad.liftM fst) (ent_res entity)
+ inport = mkAssocElem (head argport) arg
+ outport = mkAssocElem resport res
+ portmaps = Maybe.catMaybes [inport,outport]
+ portmap = AST.CSISm $ AST.CompInsSm (AST.unsafeVHDLBasicId "map12") (AST.IUEntity (AST.NSimple entity_id)) (AST.PMapAspect portmaps)
+ genSm = AST.GenerateSm label genScheme [] [portmap]
+ -- | Create an VHDL port -> signal association
+ mkAssocElem :: Maybe AST.VHDLId -> AST.VHDLId -> Maybe AST.AssocElem
+ mkAssocElem (Just port) signal = Just $ Just port AST.:=>: (AST.ADName (AST.NIndexed (AST.IndexedName
+ (AST.NSimple signal) [AST.PrimName $ AST.NSimple nPar])))
+ mkAssocElem Nothing _ = Nothing
genUnconsVectorFuns :: AST.TypeMark -- ^ type of the vector elements
-> AST.TypeMark -- ^ type of the vector
genUnconsVectorFuns elemTM vectorTM =
[ AST.SubProgBody exSpec [] [exExpr]
, AST.SubProgBody replaceSpec [AST.SPVD replaceVar] [replaceExpr,replaceRet]
- , AST.SubProgBody headSpec [] [headExpr]
- , AST.SubProgBody lastSpec [] [lastExpr]
- , AST.SubProgBody initSpec [AST.SPVD initVar] [initExpr, initRet]
- , AST.SubProgBody tailSpec [AST.SPVD tailVar] [tailExpr, tailRet]
- , AST.SubProgBody takeSpec [AST.SPVD takeVar] [takeExpr, takeRet]
- , AST.SubProgBody dropSpec [AST.SPVD dropVar] [dropExpr, dropRet]
+ , AST.SubProgBody headSpec [] [headExpr]
+ , AST.SubProgBody lastSpec [] [lastExpr]
+ , AST.SubProgBody initSpec [AST.SPVD initVar] [initExpr, initRet]
+ , AST.SubProgBody tailSpec [AST.SPVD tailVar] [tailExpr, tailRet]
+ , AST.SubProgBody takeSpec [AST.SPVD takeVar] [takeExpr, takeRet]
+ , AST.SubProgBody dropSpec [AST.SPVD dropVar] [dropExpr, dropRet]
+ , AST.SubProgBody plusgtSpec [AST.SPVD plusgtVar] [plusgtExpr, plusgtRet]
]
where
ixPar = AST.unsafeVHDLBasicId "ix"
replaceVar =
AST.VarDec resId
(AST.SubtypeIn vectorTM
- (Just $ AST.IndexConstraint
+ (Just $ AST.ConstraintIndex $ AST.IndexConstraint
[AST.ToRange (AST.PrimLit "0")
(AST.PrimName (AST.NAttribute $
AST.AttribName (AST.NSimple vecPar) lengthId Nothing) AST.:-:
initVar =
AST.VarDec resId
(AST.SubtypeIn vectorTM
- (Just $ AST.IndexConstraint
+ (Just $ AST.ConstraintIndex $ AST.IndexConstraint
[AST.ToRange (AST.PrimLit "0")
(AST.PrimName (AST.NAttribute $
AST.AttribName (AST.NSimple vecPar) lengthId Nothing) AST.:-:
tailVar =
AST.VarDec resId
(AST.SubtypeIn vectorTM
- (Just $ AST.IndexConstraint
+ (Just $ AST.ConstraintIndex $ AST.IndexConstraint
[AST.ToRange (AST.PrimLit "0")
(AST.PrimName (AST.NAttribute $
AST.AttribName (AST.NSimple vecPar) lengthId Nothing) AST.:-:
takeVar =
AST.VarDec resId
(AST.SubtypeIn vectorTM
- (Just $ AST.IndexConstraint
+ (Just $ AST.ConstraintIndex $ AST.IndexConstraint
[AST.ToRange (AST.PrimLit "0")
((AST.PrimName (AST.NSimple nPar)) AST.:-:
(AST.PrimLit "1")) ]))
dropVar =
AST.VarDec resId
(AST.SubtypeIn vectorTM
- (Just $ AST.IndexConstraint
+ (Just $ AST.ConstraintIndex $ AST.IndexConstraint
[AST.ToRange (AST.PrimLit "0")
(AST.PrimName (AST.NAttribute $
AST.AttribName (AST.NSimple vecPar) lengthId Nothing) AST.:-:
(AST.PrimName (AST.NAttribute $
AST.AttribName (AST.NSimple vecPar) lengthId Nothing)
AST.:-: AST.PrimLit "1"))
- dropRet = AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple resId)
\ No newline at end of file
+ dropRet = AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple resId)
+ plusgtSpec = AST.Function plusgtId [AST.IfaceVarDec aPar elemTM,
+ AST.IfaceVarDec vecPar vectorTM] vectorTM
+ -- variable res : fsvec_x (0 to vec'length);
+ plusgtVar =
+ AST.VarDec resId
+ (AST.SubtypeIn vectorTM
+ (Just $ AST.ConstraintIndex $ AST.IndexConstraint
+ [AST.ToRange (AST.PrimLit "0")
+ (AST.PrimName (AST.NAttribute $
+ AST.AttribName (AST.NSimple vecPar) lengthId Nothing))]))
+ Nothing
+ plusgtExpr = AST.NSimple resId AST.:=
+ ((AST.PrimName $ AST.NSimple aPar) AST.:&:
+ (AST.PrimName $ AST.NSimple vecPar))
+ plusgtRet = AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple resId)