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] -> AST.Expr
23 genExprOp2 op [arg1, arg2] = op arg1 arg2
25 -- | Generate a unary operator application
26 genExprOp1 :: (AST.Expr -> AST.Expr) -> [AST.Expr] -> AST.Expr
27 genExprOp1 op [arg] = op arg
29 -- | Generate a function call from the Function Name and a list of expressions
31 genExprFCall :: AST.VHDLId -> [AST.Expr] -> AST.Expr
32 genExprFCall fName args =
33 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 -> AST.GenerateSm -- | The resulting generate statement
41 genMapCall entity [arg, res] = genSm
43 -- Setup the generate scheme
44 len = getVectorLen res
45 label = mkVHDLExtId ("mapVector" ++ (bndrToString 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 argport = map (Monad.liftM fst) (ent_args entity)
52 resport = (Monad.liftM fst) (ent_res entity)
54 inport = mkAssocElemIndexed (head argport) (bndrToString arg) nPar
55 outport = mkAssocElemIndexed resport (bndrToString 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 = genComponentInst mapLabel entity_id portassigns
61 -- Return the generate functions
62 genSm = AST.GenerateSm label genScheme [] [compins]
64 genUnconsVectorFuns :: AST.TypeMark -- ^ type of the vector elements
65 -> AST.TypeMark -- ^ type of the vector
67 genUnconsVectorFuns elemTM vectorTM =
68 [ AST.SubProgBody exSpec [] [exExpr]
69 , AST.SubProgBody replaceSpec [AST.SPVD replaceVar] [replaceExpr,replaceRet]
70 , AST.SubProgBody headSpec [] [headExpr]
71 , AST.SubProgBody lastSpec [] [lastExpr]
72 , AST.SubProgBody initSpec [AST.SPVD initVar] [initExpr, initRet]
73 , AST.SubProgBody tailSpec [AST.SPVD tailVar] [tailExpr, tailRet]
74 , AST.SubProgBody takeSpec [AST.SPVD takeVar] [takeExpr, takeRet]
75 , AST.SubProgBody dropSpec [AST.SPVD dropVar] [dropExpr, dropRet]
76 , AST.SubProgBody plusgtSpec [AST.SPVD plusgtVar] [plusgtExpr, plusgtRet]
77 , AST.SubProgBody emptySpec [AST.SPVD emptyVar] [emptyExpr]
78 , AST.SubProgBody singletonSpec [AST.SPVD singletonVar] [singletonRet]
79 , AST.SubProgBody copySpec [AST.SPVD copyVar] [copyExpr]
82 ixPar = AST.unsafeVHDLBasicId "ix"
83 vecPar = AST.unsafeVHDLBasicId "vec"
84 nPar = AST.unsafeVHDLBasicId "n"
85 iId = AST.unsafeVHDLBasicId "i"
87 aPar = AST.unsafeVHDLBasicId "a"
88 resId = AST.unsafeVHDLBasicId "res"
89 exSpec = AST.Function exId [AST.IfaceVarDec vecPar vectorTM,
90 AST.IfaceVarDec ixPar naturalTM] elemTM
91 exExpr = AST.ReturnSm (Just $ AST.PrimName $ AST.NIndexed
92 (AST.IndexedName (AST.NSimple vecPar) [AST.PrimName $
94 replaceSpec = AST.Function replaceId [ AST.IfaceVarDec vecPar vectorTM
95 , AST.IfaceVarDec iPar naturalTM
96 , AST.IfaceVarDec aPar elemTM
98 -- variable res : fsvec_x (0 to vec'length-1);
101 (AST.SubtypeIn vectorTM
102 (Just $ AST.ConstraintIndex $ AST.IndexConstraint
103 [AST.ToRange (AST.PrimLit "0")
104 (AST.PrimName (AST.NAttribute $
105 AST.AttribName (AST.NSimple vecPar) lengthId Nothing) AST.:-:
106 (AST.PrimLit "1")) ]))
108 -- res AST.:= vec(0 to i-1) & a & vec(i+1 to length'vec-1)
109 replaceExpr = AST.NSimple resId AST.:=
110 (vecSlice (AST.PrimLit "0") (AST.PrimName (AST.NSimple iPar) AST.:-: AST.PrimLit "1") AST.:&:
111 AST.PrimName (AST.NSimple aPar) AST.:&:
112 vecSlice (AST.PrimName (AST.NSimple iPar) AST.:+: AST.PrimLit "1")
113 ((AST.PrimName (AST.NAttribute $
114 AST.AttribName (AST.NSimple vecPar) lengthId Nothing))
115 AST.:-: AST.PrimLit "1"))
116 replaceRet = AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple resId)
117 vecSlice init last = AST.PrimName (AST.NSlice
120 (AST.ToRange init last)))
121 headSpec = AST.Function headId [AST.IfaceVarDec vecPar vectorTM] elemTM
123 headExpr = AST.ReturnSm (Just $ (AST.PrimName $ AST.NIndexed (AST.IndexedName
124 (AST.NSimple vecPar) [AST.PrimLit "0"])))
125 lastSpec = AST.Function lastId [AST.IfaceVarDec vecPar vectorTM] elemTM
126 -- return vec(vec'length-1);
127 lastExpr = AST.ReturnSm (Just $ (AST.PrimName $ AST.NIndexed (AST.IndexedName
129 [AST.PrimName (AST.NAttribute $
130 AST.AttribName (AST.NSimple vecPar) lengthId Nothing)
131 AST.:-: AST.PrimLit "1"])))
132 initSpec = AST.Function initId [AST.IfaceVarDec vecPar vectorTM] vectorTM
133 -- variable res : fsvec_x (0 to vec'length-2);
136 (AST.SubtypeIn vectorTM
137 (Just $ AST.ConstraintIndex $ AST.IndexConstraint
138 [AST.ToRange (AST.PrimLit "0")
139 (AST.PrimName (AST.NAttribute $
140 AST.AttribName (AST.NSimple vecPar) lengthId Nothing) AST.:-:
141 (AST.PrimLit "2")) ]))
143 -- resAST.:= vec(0 to vec'length-2)
144 initExpr = AST.NSimple resId AST.:= (vecSlice
146 (AST.PrimName (AST.NAttribute $
147 AST.AttribName (AST.NSimple vecPar) lengthId Nothing)
148 AST.:-: AST.PrimLit "2"))
149 initRet = AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple resId)
150 tailSpec = AST.Function tailId [AST.IfaceVarDec vecPar vectorTM] vectorTM
151 -- variable res : fsvec_x (0 to vec'length-2);
154 (AST.SubtypeIn vectorTM
155 (Just $ AST.ConstraintIndex $ AST.IndexConstraint
156 [AST.ToRange (AST.PrimLit "0")
157 (AST.PrimName (AST.NAttribute $
158 AST.AttribName (AST.NSimple vecPar) lengthId Nothing) AST.:-:
159 (AST.PrimLit "2")) ]))
161 -- res AST.:= vec(1 to vec'length-1)
162 tailExpr = AST.NSimple resId AST.:= (vecSlice
164 (AST.PrimName (AST.NAttribute $
165 AST.AttribName (AST.NSimple vecPar) lengthId Nothing)
166 AST.:-: AST.PrimLit "1"))
167 tailRet = AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple resId)
168 takeSpec = AST.Function takeId [AST.IfaceVarDec nPar naturalTM,
169 AST.IfaceVarDec vecPar vectorTM ] vectorTM
170 -- variable res : fsvec_x (0 to n-1);
173 (AST.SubtypeIn vectorTM
174 (Just $ AST.ConstraintIndex $ AST.IndexConstraint
175 [AST.ToRange (AST.PrimLit "0")
176 ((AST.PrimName (AST.NSimple nPar)) AST.:-:
177 (AST.PrimLit "1")) ]))
179 -- res AST.:= vec(0 to n-1)
180 takeExpr = AST.NSimple resId AST.:=
181 (vecSlice (AST.PrimLit "1")
182 (AST.PrimName (AST.NSimple $ nPar) AST.:-: AST.PrimLit "1"))
183 takeRet = AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple resId)
184 dropSpec = AST.Function dropId [AST.IfaceVarDec nPar naturalTM,
185 AST.IfaceVarDec vecPar vectorTM ] vectorTM
186 -- variable res : fsvec_x (0 to vec'length-n-1);
189 (AST.SubtypeIn vectorTM
190 (Just $ AST.ConstraintIndex $ AST.IndexConstraint
191 [AST.ToRange (AST.PrimLit "0")
192 (AST.PrimName (AST.NAttribute $
193 AST.AttribName (AST.NSimple vecPar) lengthId Nothing) AST.:-:
194 (AST.PrimName $ AST.NSimple nPar)AST.:-: (AST.PrimLit "1")) ]))
196 -- res AST.:= vec(n to vec'length-1)
197 dropExpr = AST.NSimple resId AST.:= (vecSlice
198 (AST.PrimName $ AST.NSimple nPar)
199 (AST.PrimName (AST.NAttribute $
200 AST.AttribName (AST.NSimple vecPar) lengthId Nothing)
201 AST.:-: AST.PrimLit "1"))
202 dropRet = AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple resId)
203 plusgtSpec = AST.Function plusgtId [AST.IfaceVarDec aPar elemTM,
204 AST.IfaceVarDec vecPar vectorTM] vectorTM
205 -- variable res : fsvec_x (0 to vec'length);
208 (AST.SubtypeIn vectorTM
209 (Just $ AST.ConstraintIndex $ AST.IndexConstraint
210 [AST.ToRange (AST.PrimLit "0")
211 (AST.PrimName (AST.NAttribute $
212 AST.AttribName (AST.NSimple vecPar) lengthId Nothing))]))
214 plusgtExpr = AST.NSimple resId AST.:=
215 ((AST.PrimName $ AST.NSimple aPar) AST.:&:
216 (AST.PrimName $ AST.NSimple vecPar))
217 plusgtRet = AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple resId)
218 emptySpec = AST.Function emptyId [] vectorTM
221 (AST.SubtypeIn vectorTM
222 (Just $ AST.ConstraintIndex $ AST.IndexConstraint
223 [AST.ToRange (AST.PrimLit "0")
224 (AST.PrimLit "-1")]))
226 emptyExpr = AST.ReturnSm (Just $ AST.PrimName (AST.NSimple resId))
227 singletonSpec = AST.Function singletonId [AST.IfaceVarDec aPar elemTM ]
229 -- variable res : fsvec_x (0 to 0) := (others => a);
232 (AST.SubtypeIn vectorTM
233 (Just $ AST.ConstraintIndex $ AST.IndexConstraint
234 [AST.ToRange (AST.PrimLit "0") (AST.PrimLit "0")]))
235 (Just $ AST.Aggregate [AST.ElemAssoc (Just AST.Others)
236 (AST.PrimName $ AST.NSimple aPar)])
237 singletonRet = AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple resId)
238 copySpec = AST.Function copyId [AST.IfaceVarDec nPar naturalTM,
239 AST.IfaceVarDec aPar elemTM ] vectorTM
240 -- variable res : fsvec_x (0 to n-1) := (others => a);
243 (AST.SubtypeIn vectorTM
244 (Just $ AST.ConstraintIndex $ AST.IndexConstraint
245 [AST.ToRange (AST.PrimLit "0")
246 ((AST.PrimName (AST.NSimple nPar)) AST.:-:
247 (AST.PrimLit "1")) ]))
248 (Just $ AST.Aggregate [AST.ElemAssoc (Just AST.Others)
249 (AST.PrimName $ AST.NSimple aPar)])
251 copyExpr = AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple resId)