3 import qualified Control.Monad as Monad
6 import qualified ForSyDe.Backend.VHDL.AST as AST
10 -- | Generate a binary operator application. The first argument should be a
11 -- constructor from the AST.Expr type, e.g. AST.And.
12 genExprOp2 :: (AST.Expr -> AST.Expr -> AST.Expr) -> [AST.Expr] -> AST.Expr
13 genExprOp2 op [arg1, arg2] = op arg1 arg2
15 -- | Generate a unary operator application
16 genExprOp1 :: (AST.Expr -> AST.Expr) -> [AST.Expr] -> AST.Expr
17 genExprOp1 op [arg] = op arg
19 -- | Generate a function call from the Function Name and a list of expressions
21 genExprFCall :: AST.VHDLId -> [AST.Expr] -> AST.Expr
22 genExprFCall fName args =
23 AST.PrimFCall $ AST.FCall (AST.NSimple fName) $
24 map (\exp -> Nothing AST.:=>: AST.ADExpr exp) args
26 -- | Generate a generate statement for the builtin function "map"
28 Int -- | The length of the vector
29 -> Entity -- | The entity to map
30 -> AST.VHDLId -- | The input vector
31 -> AST.VHDLId -- | The output vector
32 -> AST.GenerateSm -- | The resulting generate statement
33 genMapCall len entity arg res = genSm
35 label = AST.unsafeVHDLBasicId "mapVector"
36 nPar = AST.unsafeVHDLBasicId "n"
37 range = AST.ToRange (AST.PrimLit "0") (AST.PrimLit $ show (len-1))
38 genScheme = AST.ForGn nPar range
39 entity_id = ent_id entity
40 argport = map (Monad.liftM fst) (ent_args entity)
41 resport = (Monad.liftM fst) (ent_res entity)
42 inport = mkAssocElem (head argport) arg
43 outport = mkAssocElem resport res
44 portmaps = Maybe.catMaybes [inport,outport]
45 portmap = AST.CSISm $ AST.CompInsSm (AST.unsafeVHDLBasicId "map12") (AST.IUEntity (AST.NSimple entity_id)) (AST.PMapAspect portmaps)
46 genSm = AST.GenerateSm label genScheme [] [portmap]
47 -- | Create an VHDL port -> signal association
48 mkAssocElem :: Maybe AST.VHDLId -> AST.VHDLId -> Maybe AST.AssocElem
49 mkAssocElem (Just port) signal = Just $ Just port AST.:=>: (AST.ADName (AST.NIndexed (AST.IndexedName
50 (AST.NSimple signal) [AST.PrimName $ AST.NSimple nPar])))
51 mkAssocElem Nothing _ = Nothing
53 genUnconsVectorFuns :: AST.TypeMark -- ^ type of the vector elements
54 -> AST.TypeMark -- ^ type of the vector
56 genUnconsVectorFuns elemTM vectorTM =
57 [ AST.SubProgBody exSpec [] [exExpr]
58 , AST.SubProgBody replaceSpec [AST.SPVD replaceVar] [replaceExpr,replaceRet]
59 , AST.SubProgBody headSpec [] [headExpr]
60 , AST.SubProgBody lastSpec [] [lastExpr]
61 , AST.SubProgBody initSpec [AST.SPVD initVar] [initExpr, initRet]
62 , AST.SubProgBody tailSpec [AST.SPVD tailVar] [tailExpr, tailRet]
63 , AST.SubProgBody takeSpec [AST.SPVD takeVar] [takeExpr, takeRet]
64 , AST.SubProgBody dropSpec [AST.SPVD dropVar] [dropExpr, dropRet]
65 , AST.SubProgBody plusgtSpec [AST.SPVD plusgtVar] [plusgtExpr, plusgtRet]
68 ixPar = AST.unsafeVHDLBasicId "ix"
69 vecPar = AST.unsafeVHDLBasicId "vec"
70 nPar = AST.unsafeVHDLBasicId "n"
71 iId = AST.unsafeVHDLBasicId "i"
73 aPar = AST.unsafeVHDLBasicId "a"
74 resId = AST.unsafeVHDLBasicId "res"
75 exSpec = AST.Function exId [AST.IfaceVarDec vecPar vectorTM,
76 AST.IfaceVarDec ixPar naturalTM] elemTM
77 exExpr = AST.ReturnSm (Just $ AST.PrimName $ AST.NIndexed
78 (AST.IndexedName (AST.NSimple vecPar) [AST.PrimName $
80 replaceSpec = AST.Function replaceId [ AST.IfaceVarDec vecPar vectorTM
81 , AST.IfaceVarDec iPar naturalTM
82 , AST.IfaceVarDec aPar elemTM
84 -- variable res : fsvec_x (0 to vec'length-1);
87 (AST.SubtypeIn vectorTM
88 (Just $ AST.ConstraintIndex $ AST.IndexConstraint
89 [AST.ToRange (AST.PrimLit "0")
90 (AST.PrimName (AST.NAttribute $
91 AST.AttribName (AST.NSimple vecPar) lengthId Nothing) AST.:-:
92 (AST.PrimLit "1")) ]))
94 -- res AST.:= vec(0 to i-1) & a & vec(i+1 to length'vec-1)
95 replaceExpr = AST.NSimple resId AST.:=
96 (vecSlice (AST.PrimLit "0") (AST.PrimName (AST.NSimple iPar) AST.:-: AST.PrimLit "1") AST.:&:
97 AST.PrimName (AST.NSimple aPar) AST.:&:
98 vecSlice (AST.PrimName (AST.NSimple iPar) AST.:+: AST.PrimLit "1")
99 ((AST.PrimName (AST.NAttribute $
100 AST.AttribName (AST.NSimple vecPar) lengthId Nothing))
101 AST.:-: AST.PrimLit "1"))
102 replaceRet = AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple resId)
103 vecSlice init last = AST.PrimName (AST.NSlice
106 (AST.ToRange init last)))
107 headSpec = AST.Function headId [AST.IfaceVarDec vecPar vectorTM] elemTM
109 headExpr = AST.ReturnSm (Just $ (AST.PrimName $ AST.NIndexed (AST.IndexedName
110 (AST.NSimple vecPar) [AST.PrimLit "0"])))
111 lastSpec = AST.Function lastId [AST.IfaceVarDec vecPar vectorTM] elemTM
112 -- return vec(vec'length-1);
113 lastExpr = AST.ReturnSm (Just $ (AST.PrimName $ AST.NIndexed (AST.IndexedName
115 [AST.PrimName (AST.NAttribute $
116 AST.AttribName (AST.NSimple vecPar) lengthId Nothing)
117 AST.:-: AST.PrimLit "1"])))
118 initSpec = AST.Function initId [AST.IfaceVarDec vecPar vectorTM] vectorTM
119 -- variable res : fsvec_x (0 to vec'length-2);
122 (AST.SubtypeIn vectorTM
123 (Just $ AST.ConstraintIndex $ AST.IndexConstraint
124 [AST.ToRange (AST.PrimLit "0")
125 (AST.PrimName (AST.NAttribute $
126 AST.AttribName (AST.NSimple vecPar) lengthId Nothing) AST.:-:
127 (AST.PrimLit "2")) ]))
129 -- resAST.:= vec(0 to vec'length-2)
130 initExpr = AST.NSimple resId AST.:= (vecSlice
132 (AST.PrimName (AST.NAttribute $
133 AST.AttribName (AST.NSimple vecPar) lengthId Nothing)
134 AST.:-: AST.PrimLit "2"))
135 initRet = AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple resId)
136 tailSpec = AST.Function tailId [AST.IfaceVarDec vecPar vectorTM] vectorTM
137 -- variable res : fsvec_x (0 to vec'length-2);
140 (AST.SubtypeIn vectorTM
141 (Just $ AST.ConstraintIndex $ AST.IndexConstraint
142 [AST.ToRange (AST.PrimLit "0")
143 (AST.PrimName (AST.NAttribute $
144 AST.AttribName (AST.NSimple vecPar) lengthId Nothing) AST.:-:
145 (AST.PrimLit "2")) ]))
147 -- res AST.:= vec(1 to vec'length-1)
148 tailExpr = AST.NSimple resId AST.:= (vecSlice
150 (AST.PrimName (AST.NAttribute $
151 AST.AttribName (AST.NSimple vecPar) lengthId Nothing)
152 AST.:-: AST.PrimLit "1"))
153 tailRet = AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple resId)
154 takeSpec = AST.Function takeId [AST.IfaceVarDec nPar naturalTM,
155 AST.IfaceVarDec vecPar vectorTM ] vectorTM
156 -- variable res : fsvec_x (0 to n-1);
159 (AST.SubtypeIn vectorTM
160 (Just $ AST.ConstraintIndex $ AST.IndexConstraint
161 [AST.ToRange (AST.PrimLit "0")
162 ((AST.PrimName (AST.NSimple nPar)) AST.:-:
163 (AST.PrimLit "1")) ]))
165 -- res AST.:= vec(0 to n-1)
166 takeExpr = AST.NSimple resId AST.:=
167 (vecSlice (AST.PrimLit "1")
168 (AST.PrimName (AST.NSimple $ nPar) AST.:-: AST.PrimLit "1"))
169 takeRet = AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple resId)
170 dropSpec = AST.Function dropId [AST.IfaceVarDec nPar naturalTM,
171 AST.IfaceVarDec vecPar vectorTM ] vectorTM
172 -- variable res : fsvec_x (0 to vec'length-n-1);
175 (AST.SubtypeIn vectorTM
176 (Just $ AST.ConstraintIndex $ AST.IndexConstraint
177 [AST.ToRange (AST.PrimLit "0")
178 (AST.PrimName (AST.NAttribute $
179 AST.AttribName (AST.NSimple vecPar) lengthId Nothing) AST.:-:
180 (AST.PrimName $ AST.NSimple nPar)AST.:-: (AST.PrimLit "1")) ]))
182 -- res AST.:= vec(n to vec'length-1)
183 dropExpr = AST.NSimple resId AST.:= (vecSlice
184 (AST.PrimName $ AST.NSimple nPar)
185 (AST.PrimName (AST.NAttribute $
186 AST.AttribName (AST.NSimple vecPar) lengthId Nothing)
187 AST.:-: AST.PrimLit "1"))
188 dropRet = AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple resId)
189 plusgtSpec = AST.Function plusgtId [AST.IfaceVarDec aPar elemTM,
190 AST.IfaceVarDec vecPar vectorTM] vectorTM
191 -- variable res : fsvec_x (0 to vec'length);
194 (AST.SubtypeIn vectorTM
195 (Just $ AST.ConstraintIndex $ AST.IndexConstraint
196 [AST.ToRange (AST.PrimLit "0")
197 (AST.PrimName (AST.NAttribute $
198 AST.AttribName (AST.NSimple vecPar) lengthId Nothing))]))
200 plusgtExpr = AST.NSimple resId AST.:=
201 ((AST.PrimName $ AST.NSimple aPar) AST.:&:
202 (AST.PrimName $ AST.NSimple vecPar))
203 plusgtRet = AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple resId)