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]
66 , AST.SubProgBody emptySpec [AST.SPVD emptyVar] [emptyExpr]
69 ixPar = AST.unsafeVHDLBasicId "ix"
70 vecPar = AST.unsafeVHDLBasicId "vec"
71 nPar = AST.unsafeVHDLBasicId "n"
72 iId = AST.unsafeVHDLBasicId "i"
74 aPar = AST.unsafeVHDLBasicId "a"
75 resId = AST.unsafeVHDLBasicId "res"
76 exSpec = AST.Function exId [AST.IfaceVarDec vecPar vectorTM,
77 AST.IfaceVarDec ixPar naturalTM] elemTM
78 exExpr = AST.ReturnSm (Just $ AST.PrimName $ AST.NIndexed
79 (AST.IndexedName (AST.NSimple vecPar) [AST.PrimName $
81 replaceSpec = AST.Function replaceId [ AST.IfaceVarDec vecPar vectorTM
82 , AST.IfaceVarDec iPar naturalTM
83 , AST.IfaceVarDec aPar elemTM
85 -- variable res : fsvec_x (0 to vec'length-1);
88 (AST.SubtypeIn vectorTM
89 (Just $ AST.ConstraintIndex $ AST.IndexConstraint
90 [AST.ToRange (AST.PrimLit "0")
91 (AST.PrimName (AST.NAttribute $
92 AST.AttribName (AST.NSimple vecPar) lengthId Nothing) AST.:-:
93 (AST.PrimLit "1")) ]))
95 -- res AST.:= vec(0 to i-1) & a & vec(i+1 to length'vec-1)
96 replaceExpr = AST.NSimple resId AST.:=
97 (vecSlice (AST.PrimLit "0") (AST.PrimName (AST.NSimple iPar) AST.:-: AST.PrimLit "1") AST.:&:
98 AST.PrimName (AST.NSimple aPar) AST.:&:
99 vecSlice (AST.PrimName (AST.NSimple iPar) AST.:+: AST.PrimLit "1")
100 ((AST.PrimName (AST.NAttribute $
101 AST.AttribName (AST.NSimple vecPar) lengthId Nothing))
102 AST.:-: AST.PrimLit "1"))
103 replaceRet = AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple resId)
104 vecSlice init last = AST.PrimName (AST.NSlice
107 (AST.ToRange init last)))
108 headSpec = AST.Function headId [AST.IfaceVarDec vecPar vectorTM] elemTM
110 headExpr = AST.ReturnSm (Just $ (AST.PrimName $ AST.NIndexed (AST.IndexedName
111 (AST.NSimple vecPar) [AST.PrimLit "0"])))
112 lastSpec = AST.Function lastId [AST.IfaceVarDec vecPar vectorTM] elemTM
113 -- return vec(vec'length-1);
114 lastExpr = AST.ReturnSm (Just $ (AST.PrimName $ AST.NIndexed (AST.IndexedName
116 [AST.PrimName (AST.NAttribute $
117 AST.AttribName (AST.NSimple vecPar) lengthId Nothing)
118 AST.:-: AST.PrimLit "1"])))
119 initSpec = AST.Function initId [AST.IfaceVarDec vecPar vectorTM] vectorTM
120 -- variable res : fsvec_x (0 to vec'length-2);
123 (AST.SubtypeIn vectorTM
124 (Just $ AST.ConstraintIndex $ AST.IndexConstraint
125 [AST.ToRange (AST.PrimLit "0")
126 (AST.PrimName (AST.NAttribute $
127 AST.AttribName (AST.NSimple vecPar) lengthId Nothing) AST.:-:
128 (AST.PrimLit "2")) ]))
130 -- resAST.:= vec(0 to vec'length-2)
131 initExpr = AST.NSimple resId AST.:= (vecSlice
133 (AST.PrimName (AST.NAttribute $
134 AST.AttribName (AST.NSimple vecPar) lengthId Nothing)
135 AST.:-: AST.PrimLit "2"))
136 initRet = AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple resId)
137 tailSpec = AST.Function tailId [AST.IfaceVarDec vecPar vectorTM] vectorTM
138 -- variable res : fsvec_x (0 to vec'length-2);
141 (AST.SubtypeIn vectorTM
142 (Just $ AST.ConstraintIndex $ AST.IndexConstraint
143 [AST.ToRange (AST.PrimLit "0")
144 (AST.PrimName (AST.NAttribute $
145 AST.AttribName (AST.NSimple vecPar) lengthId Nothing) AST.:-:
146 (AST.PrimLit "2")) ]))
148 -- res AST.:= vec(1 to vec'length-1)
149 tailExpr = AST.NSimple resId AST.:= (vecSlice
151 (AST.PrimName (AST.NAttribute $
152 AST.AttribName (AST.NSimple vecPar) lengthId Nothing)
153 AST.:-: AST.PrimLit "1"))
154 tailRet = AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple resId)
155 takeSpec = AST.Function takeId [AST.IfaceVarDec nPar naturalTM,
156 AST.IfaceVarDec vecPar vectorTM ] vectorTM
157 -- variable res : fsvec_x (0 to n-1);
160 (AST.SubtypeIn vectorTM
161 (Just $ AST.ConstraintIndex $ AST.IndexConstraint
162 [AST.ToRange (AST.PrimLit "0")
163 ((AST.PrimName (AST.NSimple nPar)) AST.:-:
164 (AST.PrimLit "1")) ]))
166 -- res AST.:= vec(0 to n-1)
167 takeExpr = AST.NSimple resId AST.:=
168 (vecSlice (AST.PrimLit "1")
169 (AST.PrimName (AST.NSimple $ nPar) AST.:-: AST.PrimLit "1"))
170 takeRet = AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple resId)
171 dropSpec = AST.Function dropId [AST.IfaceVarDec nPar naturalTM,
172 AST.IfaceVarDec vecPar vectorTM ] vectorTM
173 -- variable res : fsvec_x (0 to vec'length-n-1);
176 (AST.SubtypeIn vectorTM
177 (Just $ AST.ConstraintIndex $ AST.IndexConstraint
178 [AST.ToRange (AST.PrimLit "0")
179 (AST.PrimName (AST.NAttribute $
180 AST.AttribName (AST.NSimple vecPar) lengthId Nothing) AST.:-:
181 (AST.PrimName $ AST.NSimple nPar)AST.:-: (AST.PrimLit "1")) ]))
183 -- res AST.:= vec(n to vec'length-1)
184 dropExpr = AST.NSimple resId AST.:= (vecSlice
185 (AST.PrimName $ AST.NSimple nPar)
186 (AST.PrimName (AST.NAttribute $
187 AST.AttribName (AST.NSimple vecPar) lengthId Nothing)
188 AST.:-: AST.PrimLit "1"))
189 dropRet = AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple resId)
190 plusgtSpec = AST.Function plusgtId [AST.IfaceVarDec aPar elemTM,
191 AST.IfaceVarDec vecPar vectorTM] vectorTM
192 -- variable res : fsvec_x (0 to vec'length);
195 (AST.SubtypeIn vectorTM
196 (Just $ AST.ConstraintIndex $ AST.IndexConstraint
197 [AST.ToRange (AST.PrimLit "0")
198 (AST.PrimName (AST.NAttribute $
199 AST.AttribName (AST.NSimple vecPar) lengthId Nothing))]))
201 plusgtExpr = AST.NSimple resId AST.:=
202 ((AST.PrimName $ AST.NSimple aPar) AST.:&:
203 (AST.PrimName $ AST.NSimple vecPar))
204 plusgtRet = AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple resId)
205 emptySpec = AST.Function emptyId [] vectorTM
208 (AST.SubtypeIn vectorTM
209 (Just $ AST.ConstraintIndex $ AST.IndexConstraint
210 [AST.ToRange (AST.PrimLit "0")
211 (AST.PrimLit "-1")]))
213 emptyExpr = AST.ReturnSm (Just $ AST.PrimName (AST.NSimple resId))