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 vectors
31 -> AST.GenerateSm -- | The resulting generate statement
32 genMapCall len entity [arg, res] = genSm
34 label = mkVHDLExtId ("mapVector" ++ (AST.fromVHDLId res))
35 nPar = AST.unsafeVHDLBasicId "n"
36 range = AST.ToRange (AST.PrimLit "0") (AST.PrimLit $ show (len-1))
37 genScheme = AST.ForGn nPar range
38 entity_id = ent_id entity
39 argport = map (Monad.liftM fst) (ent_args entity)
40 resport = (Monad.liftM fst) (ent_res entity)
41 inport = mkAssocElemI (head argport) arg
42 outport = mkAssocElemI resport res
43 clk_port = mkAssocElem (Just $ mkVHDLExtId "clk") "clk"
44 portmaps = Maybe.catMaybes [inport,outport,clk_port]
45 portname = mkVHDLExtId ("map" ++ (AST.fromVHDLId entity_id))
46 portmap = AST.CSISm $ AST.CompInsSm (AST.unsafeVHDLBasicId "map12") (AST.IUEntity (AST.NSimple entity_id)) (AST.PMapAspect portmaps)
47 genSm = AST.GenerateSm label genScheme [] [portmap]
48 -- | Create an VHDL port -> signal association
49 mkAssocElemI :: Maybe AST.VHDLId -> AST.VHDLId -> Maybe AST.AssocElem
50 mkAssocElemI (Just port) signal = Just $ Just port AST.:=>: (AST.ADName (AST.NIndexed (AST.IndexedName
51 (AST.NSimple signal) [AST.PrimName $ AST.NSimple nPar])))
52 mkAssocElemI Nothing _ = Nothing
53 mkAssocElem :: Maybe AST.VHDLId -> String -> Maybe AST.AssocElem
54 mkAssocElem (Just port) signal = Just $ Just port AST.:=>: (AST.ADName (AST.NSimple (mkVHDLExtId signal)))
55 mkAssocElem Nothing _ = Nothing
56 mkVHDLExtId :: String -> AST.VHDLId
58 AST.unsafeVHDLExtId $ strip_invalid s
60 -- Allowed characters, taken from ForSyde's mkVHDLExtId
61 allowed = ['A'..'Z'] ++ ['a'..'z'] ++ ['0'..'9'] ++ " \"#&\\'()*+,./:;<=>_|!$%@?[]^`{}~-"
62 strip_invalid = filter (`elem` allowed)
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]
81 ixPar = AST.unsafeVHDLBasicId "ix"
82 vecPar = AST.unsafeVHDLBasicId "vec"
83 nPar = AST.unsafeVHDLBasicId "n"
84 iId = AST.unsafeVHDLBasicId "i"
86 aPar = AST.unsafeVHDLBasicId "a"
87 resId = AST.unsafeVHDLBasicId "res"
88 exSpec = AST.Function exId [AST.IfaceVarDec vecPar vectorTM,
89 AST.IfaceVarDec ixPar naturalTM] elemTM
90 exExpr = AST.ReturnSm (Just $ AST.PrimName $ AST.NIndexed
91 (AST.IndexedName (AST.NSimple vecPar) [AST.PrimName $
93 replaceSpec = AST.Function replaceId [ AST.IfaceVarDec vecPar vectorTM
94 , AST.IfaceVarDec iPar naturalTM
95 , AST.IfaceVarDec aPar elemTM
97 -- variable res : fsvec_x (0 to vec'length-1);
100 (AST.SubtypeIn vectorTM
101 (Just $ AST.ConstraintIndex $ AST.IndexConstraint
102 [AST.ToRange (AST.PrimLit "0")
103 (AST.PrimName (AST.NAttribute $
104 AST.AttribName (AST.NSimple vecPar) lengthId Nothing) AST.:-:
105 (AST.PrimLit "1")) ]))
107 -- res AST.:= vec(0 to i-1) & a & vec(i+1 to length'vec-1)
108 replaceExpr = AST.NSimple resId AST.:=
109 (vecSlice (AST.PrimLit "0") (AST.PrimName (AST.NSimple iPar) AST.:-: AST.PrimLit "1") AST.:&:
110 AST.PrimName (AST.NSimple aPar) AST.:&:
111 vecSlice (AST.PrimName (AST.NSimple iPar) AST.:+: AST.PrimLit "1")
112 ((AST.PrimName (AST.NAttribute $
113 AST.AttribName (AST.NSimple vecPar) lengthId Nothing))
114 AST.:-: AST.PrimLit "1"))
115 replaceRet = AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple resId)
116 vecSlice init last = AST.PrimName (AST.NSlice
119 (AST.ToRange init last)))
120 headSpec = AST.Function headId [AST.IfaceVarDec vecPar vectorTM] elemTM
122 headExpr = AST.ReturnSm (Just $ (AST.PrimName $ AST.NIndexed (AST.IndexedName
123 (AST.NSimple vecPar) [AST.PrimLit "0"])))
124 lastSpec = AST.Function lastId [AST.IfaceVarDec vecPar vectorTM] elemTM
125 -- return vec(vec'length-1);
126 lastExpr = AST.ReturnSm (Just $ (AST.PrimName $ AST.NIndexed (AST.IndexedName
128 [AST.PrimName (AST.NAttribute $
129 AST.AttribName (AST.NSimple vecPar) lengthId Nothing)
130 AST.:-: AST.PrimLit "1"])))
131 initSpec = AST.Function initId [AST.IfaceVarDec vecPar vectorTM] vectorTM
132 -- variable res : fsvec_x (0 to vec'length-2);
135 (AST.SubtypeIn vectorTM
136 (Just $ AST.ConstraintIndex $ AST.IndexConstraint
137 [AST.ToRange (AST.PrimLit "0")
138 (AST.PrimName (AST.NAttribute $
139 AST.AttribName (AST.NSimple vecPar) lengthId Nothing) AST.:-:
140 (AST.PrimLit "2")) ]))
142 -- resAST.:= vec(0 to vec'length-2)
143 initExpr = AST.NSimple resId AST.:= (vecSlice
145 (AST.PrimName (AST.NAttribute $
146 AST.AttribName (AST.NSimple vecPar) lengthId Nothing)
147 AST.:-: AST.PrimLit "2"))
148 initRet = AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple resId)
149 tailSpec = AST.Function tailId [AST.IfaceVarDec vecPar vectorTM] vectorTM
150 -- variable res : fsvec_x (0 to vec'length-2);
153 (AST.SubtypeIn vectorTM
154 (Just $ AST.ConstraintIndex $ AST.IndexConstraint
155 [AST.ToRange (AST.PrimLit "0")
156 (AST.PrimName (AST.NAttribute $
157 AST.AttribName (AST.NSimple vecPar) lengthId Nothing) AST.:-:
158 (AST.PrimLit "2")) ]))
160 -- res AST.:= vec(1 to vec'length-1)
161 tailExpr = AST.NSimple resId AST.:= (vecSlice
163 (AST.PrimName (AST.NAttribute $
164 AST.AttribName (AST.NSimple vecPar) lengthId Nothing)
165 AST.:-: AST.PrimLit "1"))
166 tailRet = AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple resId)
167 takeSpec = AST.Function takeId [AST.IfaceVarDec nPar naturalTM,
168 AST.IfaceVarDec vecPar vectorTM ] vectorTM
169 -- variable res : fsvec_x (0 to n-1);
172 (AST.SubtypeIn vectorTM
173 (Just $ AST.ConstraintIndex $ AST.IndexConstraint
174 [AST.ToRange (AST.PrimLit "0")
175 ((AST.PrimName (AST.NSimple nPar)) AST.:-:
176 (AST.PrimLit "1")) ]))
178 -- res AST.:= vec(0 to n-1)
179 takeExpr = AST.NSimple resId AST.:=
180 (vecSlice (AST.PrimLit "1")
181 (AST.PrimName (AST.NSimple $ nPar) AST.:-: AST.PrimLit "1"))
182 takeRet = AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple resId)
183 dropSpec = AST.Function dropId [AST.IfaceVarDec nPar naturalTM,
184 AST.IfaceVarDec vecPar vectorTM ] vectorTM
185 -- variable res : fsvec_x (0 to vec'length-n-1);
188 (AST.SubtypeIn vectorTM
189 (Just $ AST.ConstraintIndex $ AST.IndexConstraint
190 [AST.ToRange (AST.PrimLit "0")
191 (AST.PrimName (AST.NAttribute $
192 AST.AttribName (AST.NSimple vecPar) lengthId Nothing) AST.:-:
193 (AST.PrimName $ AST.NSimple nPar)AST.:-: (AST.PrimLit "1")) ]))
195 -- res AST.:= vec(n to vec'length-1)
196 dropExpr = AST.NSimple resId AST.:= (vecSlice
197 (AST.PrimName $ AST.NSimple nPar)
198 (AST.PrimName (AST.NAttribute $
199 AST.AttribName (AST.NSimple vecPar) lengthId Nothing)
200 AST.:-: AST.PrimLit "1"))
201 dropRet = AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple resId)
202 plusgtSpec = AST.Function plusgtId [AST.IfaceVarDec aPar elemTM,
203 AST.IfaceVarDec vecPar vectorTM] vectorTM
204 -- variable res : fsvec_x (0 to vec'length);
207 (AST.SubtypeIn vectorTM
208 (Just $ AST.ConstraintIndex $ AST.IndexConstraint
209 [AST.ToRange (AST.PrimLit "0")
210 (AST.PrimName (AST.NAttribute $
211 AST.AttribName (AST.NSimple vecPar) lengthId Nothing))]))
213 plusgtExpr = AST.NSimple resId AST.:=
214 ((AST.PrimName $ AST.NSimple aPar) AST.:&:
215 (AST.PrimName $ AST.NSimple vecPar))
216 plusgtRet = AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple resId)
217 emptySpec = AST.Function emptyId [] vectorTM
220 (AST.SubtypeIn vectorTM
221 (Just $ AST.ConstraintIndex $ AST.IndexConstraint
222 [AST.ToRange (AST.PrimLit "0")
223 (AST.PrimLit "-1")]))
225 emptyExpr = AST.ReturnSm (Just $ AST.PrimName (AST.NSimple resId))
226 singletonSpec = AST.Function singletonId [AST.IfaceVarDec aPar elemTM ]
228 -- variable res : fsvec_x (0 to 0) := (others => a);
231 (AST.SubtypeIn vectorTM
232 (Just $ AST.ConstraintIndex $ AST.IndexConstraint
233 [AST.ToRange (AST.PrimLit "0") (AST.PrimLit "0")]))
234 (Just $ AST.Aggregate [AST.ElemAssoc (Just AST.Others)
235 (AST.PrimName $ AST.NSimple aPar)])
236 singletonRet = AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple resId)