4 import qualified Control.Monad as Monad
8 import qualified ForSyDe.Backend.VHDL.AST as AST
20 -- | Generate a binary operator application. The first argument should be a
21 -- constructor from the AST.Expr type, e.g. AST.And.
22 genExprOp2 :: (AST.Expr -> AST.Expr -> AST.Expr) -> [AST.Expr] -> VHDLSession AST.Expr
23 genExprOp2 op [arg1, arg2] = return $ op arg1 arg2
25 -- | Generate a unary operator application
26 genExprOp1 :: (AST.Expr -> AST.Expr) -> [AST.Expr] -> VHDLSession AST.Expr
27 genExprOp1 op [arg] = return $ op arg
29 -- | Generate a function call from the Function Name and a list of expressions
31 genExprFCall :: AST.VHDLId -> [AST.Expr] -> VHDLSession AST.Expr
32 genExprFCall fName args =
33 return $ AST.PrimFCall $ AST.FCall (AST.NSimple fName) $
34 map (\exp -> Nothing AST.:=>: AST.ADExpr exp) args
36 -- | Generate a generate statement for the builtin function "map"
38 Entity -- | The entity to map
39 -> [CoreSyn.CoreBndr] -- | The vectors
40 -> VHDLSession AST.GenerateSm -- | The resulting generate statement
41 genMapCall entity [arg, res] = return $ genSm
43 -- Setup the generate scheme
44 len = (tfvec_len . Var.varType) res
45 label = mkVHDLExtId ("mapVector" ++ (varToString res))
46 nPar = AST.unsafeVHDLBasicId "n"
47 range = AST.ToRange (AST.PrimLit "0") (AST.PrimLit $ show (len-1))
48 genScheme = AST.ForGn nPar range
49 -- Get the entity name and port names
50 entity_id = ent_id entity
51 argports = map (Monad.liftM fst) (ent_args entity)
52 resport = (Monad.liftM fst) (ent_res entity)
54 inport = mkAssocElemIndexed (argports!!0) (varToString arg) nPar
55 outport = mkAssocElemIndexed resport (varToString res) nPar
56 clk_port = mkAssocElem (Just $ mkVHDLExtId "clk") "clk"
57 portassigns = Maybe.catMaybes [inport,outport,clk_port]
58 -- Generate the portmap
59 mapLabel = "map" ++ (AST.fromVHDLId entity_id)
60 compins = mkComponentInst mapLabel entity_id portassigns
61 -- Return the generate functions
62 genSm = AST.GenerateSm label genScheme [] [compins]
68 genZipWithCall entity [arg1, arg2, res] = genSm
70 -- Setup the generate scheme
71 len = (tfvec_len . Var.varType) res
72 label = mkVHDLExtId ("zipWithVector" ++ (varToString res))
73 nPar = AST.unsafeVHDLBasicId "n"
74 range = AST.ToRange (AST.PrimLit "0") (AST.PrimLit $ show (len-1))
75 genScheme = AST.ForGn nPar range
76 -- Get the entity name and port names
77 entity_id = ent_id entity
78 argports = map (Monad.liftM fst) (ent_args entity)
79 resport = (Monad.liftM fst) (ent_res entity)
81 inport1 = mkAssocElemIndexed (argports!!0) (varToString arg1) nPar
82 inport2 = mkAssocElemIndexed (argports!!1) (varToString arg2) nPar
83 outport = mkAssocElemIndexed resport (varToString res) nPar
84 clk_port = mkAssocElem (Just $ mkVHDLExtId "clk") "clk"
85 portassigns = Maybe.catMaybes [inport1,inport2,outport,clk_port]
86 -- Generate the portmap
87 mapLabel = "zipWith" ++ (AST.fromVHDLId entity_id)
88 compins = mkComponentInst mapLabel entity_id portassigns
89 -- Return the generate functions
90 genSm = AST.GenerateSm label genScheme [] [compins]
92 genUnconsVectorFuns :: AST.TypeMark -- ^ type of the vector elements
93 -> AST.TypeMark -- ^ type of the vector
95 genUnconsVectorFuns elemTM vectorTM =
96 [ AST.SubProgBody exSpec [] [exExpr]
97 , AST.SubProgBody replaceSpec [AST.SPVD replaceVar] [replaceExpr,replaceRet]
98 , AST.SubProgBody headSpec [] [headExpr]
99 , AST.SubProgBody lastSpec [] [lastExpr]
100 , AST.SubProgBody initSpec [AST.SPVD initVar] [initExpr, initRet]
101 , AST.SubProgBody tailSpec [AST.SPVD tailVar] [tailExpr, tailRet]
102 , AST.SubProgBody takeSpec [AST.SPVD takeVar] [takeExpr, takeRet]
103 , AST.SubProgBody dropSpec [AST.SPVD dropVar] [dropExpr, dropRet]
104 , AST.SubProgBody plusgtSpec [AST.SPVD plusgtVar] [plusgtExpr, plusgtRet]
105 , AST.SubProgBody emptySpec [AST.SPCD emptyVar] [emptyExpr]
106 , AST.SubProgBody singletonSpec [AST.SPVD singletonVar] [singletonRet]
107 , AST.SubProgBody copySpec [AST.SPVD copyVar] [copyExpr]
110 ixPar = AST.unsafeVHDLBasicId "ix"
111 vecPar = AST.unsafeVHDLBasicId "vec"
112 nPar = AST.unsafeVHDLBasicId "n"
113 iId = AST.unsafeVHDLBasicId "i"
115 aPar = AST.unsafeVHDLBasicId "a"
116 resId = AST.unsafeVHDLBasicId "res"
117 exSpec = AST.Function exId [AST.IfaceVarDec vecPar vectorTM,
118 AST.IfaceVarDec ixPar naturalTM] elemTM
119 exExpr = AST.ReturnSm (Just $ AST.PrimName $ AST.NIndexed
120 (AST.IndexedName (AST.NSimple vecPar) [AST.PrimName $
122 replaceSpec = AST.Function replaceId [ AST.IfaceVarDec vecPar vectorTM
123 , AST.IfaceVarDec iPar naturalTM
124 , AST.IfaceVarDec aPar elemTM
126 -- variable res : fsvec_x (0 to vec'length-1);
129 (AST.SubtypeIn vectorTM
130 (Just $ AST.ConstraintIndex $ AST.IndexConstraint
131 [AST.ToRange (AST.PrimLit "0")
132 (AST.PrimName (AST.NAttribute $
133 AST.AttribName (AST.NSimple vecPar) lengthId Nothing) AST.:-:
134 (AST.PrimLit "1")) ]))
136 -- res AST.:= vec(0 to i-1) & a & vec(i+1 to length'vec-1)
137 replaceExpr = AST.NSimple resId AST.:=
138 (vecSlice (AST.PrimLit "0") (AST.PrimName (AST.NSimple iPar) AST.:-: AST.PrimLit "1") AST.:&:
139 AST.PrimName (AST.NSimple aPar) AST.:&:
140 vecSlice (AST.PrimName (AST.NSimple iPar) AST.:+: AST.PrimLit "1")
141 ((AST.PrimName (AST.NAttribute $
142 AST.AttribName (AST.NSimple vecPar) lengthId Nothing))
143 AST.:-: AST.PrimLit "1"))
144 replaceRet = AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple resId)
145 vecSlice init last = AST.PrimName (AST.NSlice
148 (AST.ToRange init last)))
149 headSpec = AST.Function headId [AST.IfaceVarDec vecPar vectorTM] elemTM
151 headExpr = AST.ReturnSm (Just $ (AST.PrimName $ AST.NIndexed (AST.IndexedName
152 (AST.NSimple vecPar) [AST.PrimLit "0"])))
153 lastSpec = AST.Function lastId [AST.IfaceVarDec vecPar vectorTM] elemTM
154 -- return vec(vec'length-1);
155 lastExpr = AST.ReturnSm (Just $ (AST.PrimName $ AST.NIndexed (AST.IndexedName
157 [AST.PrimName (AST.NAttribute $
158 AST.AttribName (AST.NSimple vecPar) lengthId Nothing)
159 AST.:-: AST.PrimLit "1"])))
160 initSpec = AST.Function initId [AST.IfaceVarDec vecPar vectorTM] vectorTM
161 -- variable res : fsvec_x (0 to vec'length-2);
164 (AST.SubtypeIn vectorTM
165 (Just $ AST.ConstraintIndex $ AST.IndexConstraint
166 [AST.ToRange (AST.PrimLit "0")
167 (AST.PrimName (AST.NAttribute $
168 AST.AttribName (AST.NSimple vecPar) lengthId Nothing) AST.:-:
169 (AST.PrimLit "2")) ]))
171 -- resAST.:= vec(0 to vec'length-2)
172 initExpr = AST.NSimple resId AST.:= (vecSlice
174 (AST.PrimName (AST.NAttribute $
175 AST.AttribName (AST.NSimple vecPar) lengthId Nothing)
176 AST.:-: AST.PrimLit "2"))
177 initRet = AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple resId)
178 tailSpec = AST.Function tailId [AST.IfaceVarDec vecPar vectorTM] vectorTM
179 -- variable res : fsvec_x (0 to vec'length-2);
182 (AST.SubtypeIn vectorTM
183 (Just $ AST.ConstraintIndex $ AST.IndexConstraint
184 [AST.ToRange (AST.PrimLit "0")
185 (AST.PrimName (AST.NAttribute $
186 AST.AttribName (AST.NSimple vecPar) lengthId Nothing) AST.:-:
187 (AST.PrimLit "2")) ]))
189 -- res AST.:= vec(1 to vec'length-1)
190 tailExpr = AST.NSimple resId AST.:= (vecSlice
192 (AST.PrimName (AST.NAttribute $
193 AST.AttribName (AST.NSimple vecPar) lengthId Nothing)
194 AST.:-: AST.PrimLit "1"))
195 tailRet = AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple resId)
196 takeSpec = AST.Function takeId [AST.IfaceVarDec nPar naturalTM,
197 AST.IfaceVarDec vecPar vectorTM ] vectorTM
198 -- variable res : fsvec_x (0 to n-1);
201 (AST.SubtypeIn vectorTM
202 (Just $ AST.ConstraintIndex $ AST.IndexConstraint
203 [AST.ToRange (AST.PrimLit "0")
204 ((AST.PrimName (AST.NSimple nPar)) AST.:-:
205 (AST.PrimLit "1")) ]))
207 -- res AST.:= vec(0 to n-1)
208 takeExpr = AST.NSimple resId AST.:=
209 (vecSlice (AST.PrimLit "1")
210 (AST.PrimName (AST.NSimple $ nPar) AST.:-: AST.PrimLit "1"))
211 takeRet = AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple resId)
212 dropSpec = AST.Function dropId [AST.IfaceVarDec nPar naturalTM,
213 AST.IfaceVarDec vecPar vectorTM ] vectorTM
214 -- variable res : fsvec_x (0 to vec'length-n-1);
217 (AST.SubtypeIn vectorTM
218 (Just $ AST.ConstraintIndex $ AST.IndexConstraint
219 [AST.ToRange (AST.PrimLit "0")
220 (AST.PrimName (AST.NAttribute $
221 AST.AttribName (AST.NSimple vecPar) lengthId Nothing) AST.:-:
222 (AST.PrimName $ AST.NSimple nPar)AST.:-: (AST.PrimLit "1")) ]))
224 -- res AST.:= vec(n to vec'length-1)
225 dropExpr = AST.NSimple resId AST.:= (vecSlice
226 (AST.PrimName $ AST.NSimple nPar)
227 (AST.PrimName (AST.NAttribute $
228 AST.AttribName (AST.NSimple vecPar) lengthId Nothing)
229 AST.:-: AST.PrimLit "1"))
230 dropRet = AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple resId)
231 plusgtSpec = AST.Function plusgtId [AST.IfaceVarDec aPar elemTM,
232 AST.IfaceVarDec vecPar vectorTM] vectorTM
233 -- variable res : fsvec_x (0 to vec'length);
236 (AST.SubtypeIn vectorTM
237 (Just $ AST.ConstraintIndex $ AST.IndexConstraint
238 [AST.ToRange (AST.PrimLit "0")
239 (AST.PrimName (AST.NAttribute $
240 AST.AttribName (AST.NSimple vecPar) lengthId Nothing))]))
242 plusgtExpr = AST.NSimple resId AST.:=
243 ((AST.PrimName $ AST.NSimple aPar) AST.:&:
244 (AST.PrimName $ AST.NSimple vecPar))
245 plusgtRet = AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple resId)
246 emptySpec = AST.Function emptyId [] vectorTM
249 (AST.SubtypeIn vectorTM Nothing)
250 (Just $ AST.PrimLit "\"\"")
251 emptyExpr = AST.ReturnSm (Just $ AST.PrimName (AST.NSimple resId))
252 singletonSpec = AST.Function singletonId [AST.IfaceVarDec aPar elemTM ]
254 -- variable res : fsvec_x (0 to 0) := (others => a);
257 (AST.SubtypeIn vectorTM
258 (Just $ AST.ConstraintIndex $ AST.IndexConstraint
259 [AST.ToRange (AST.PrimLit "0") (AST.PrimLit "0")]))
260 (Just $ AST.Aggregate [AST.ElemAssoc (Just AST.Others)
261 (AST.PrimName $ AST.NSimple aPar)])
262 singletonRet = AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple resId)
263 copySpec = AST.Function copyId [AST.IfaceVarDec nPar naturalTM,
264 AST.IfaceVarDec aPar elemTM ] vectorTM
265 -- variable res : fsvec_x (0 to n-1) := (others => a);
268 (AST.SubtypeIn vectorTM
269 (Just $ AST.ConstraintIndex $ AST.IndexConstraint
270 [AST.ToRange (AST.PrimLit "0")
271 ((AST.PrimName (AST.NSimple nPar)) AST.:-:
272 (AST.PrimLit "1")) ]))
273 (Just $ AST.Aggregate [AST.ElemAssoc (Just AST.Others)
274 (AST.PrimName $ AST.NSimple aPar)])
276 copyExpr = AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple resId)