Split off the VHDL type generating code.
[matthijs/master-project/cλash.git] / Generate.hs
1 module Generate where
2   
3 import qualified ForSyDe.Backend.VHDL.AST as AST
4 import Constants
5
6 -- | Generate a function call from the Function Name and a list of expressions
7 --   (its arguments)
8 genExprFCall :: AST.VHDLId -> [AST.Expr] -> AST.Expr
9 genExprFCall fName args = 
10    AST.PrimFCall $ AST.FCall (AST.NSimple fName)  $
11              map (\exp -> Nothing AST.:=>: AST.ADExpr exp) args
12
13 -- | List version of genExprFCall1
14 genExprFCall1L :: AST.VHDLId -> [AST.Expr] -> AST.Expr
15 genExprFCall1L fName [arg] = genExprFCall fName [arg]
16 genExprFCall1L _ _ = error "Generate.genExprFCall1L incorrect length"
17
18 -- | List version of genExprFCall2
19 genExprFCall2L :: AST.VHDLId -> [AST.Expr] -> AST.Expr
20 genExprFCall2L fName [arg1, arg2] = genExprFCall fName [arg1,arg2]
21 genExprFCall2L _ _ = error "Generate.genExprFCall2L incorrect length"
22
23 genUnconsVectorFuns :: AST.TypeMark -- ^ type of the vector elements
24                     -> AST.TypeMark -- ^ type of the vector
25                     -> [AST.SubProgBody]
26 genUnconsVectorFuns elemTM vectorTM  = 
27   [ AST.SubProgBody exSpec      []                  [exExpr]                    
28   , AST.SubProgBody replaceSpec [AST.SPVD replaceVar] [replaceExpr,replaceRet]   
29     , AST.SubProgBody headSpec    []                  [headExpr]                  
30     , AST.SubProgBody lastSpec    []                  [lastExpr]                  
31     , AST.SubProgBody initSpec    [AST.SPVD initVar]  [initExpr, initRet]         
32     , AST.SubProgBody tailSpec    [AST.SPVD tailVar]  [tailExpr, tailRet]         
33     , AST.SubProgBody takeSpec    [AST.SPVD takeVar]  [takeExpr, takeRet]         
34     , AST.SubProgBody dropSpec    [AST.SPVD dropVar]  [dropExpr, dropRet]         
35   ]
36   where 
37     ixPar   = AST.unsafeVHDLBasicId "ix"
38     vecPar  = AST.unsafeVHDLBasicId "vec"
39     nPar    = AST.unsafeVHDLBasicId "n"
40     iId     = AST.unsafeVHDLBasicId "i"
41     iPar    = iId
42     aPar    = AST.unsafeVHDLBasicId "a"
43     resId   = AST.unsafeVHDLBasicId "res"
44     exSpec = AST.Function exId [AST.IfaceVarDec vecPar vectorTM,
45                                AST.IfaceVarDec ixPar  naturalTM] elemTM
46     exExpr = AST.ReturnSm (Just $ AST.PrimName $ AST.NIndexed 
47               (AST.IndexedName (AST.NSimple vecPar) [AST.PrimName $ 
48                 AST.NSimple ixPar]))
49     replaceSpec = AST.Function replaceId  [ AST.IfaceVarDec vecPar vectorTM
50                                           , AST.IfaceVarDec iPar   naturalTM
51                                           , AST.IfaceVarDec aPar   elemTM
52                                           ] vectorTM 
53        -- variable res : fsvec_x (0 to vec'length-1);
54     replaceVar =
55          AST.VarDec resId 
56                 (AST.SubtypeIn vectorTM
57                   (Just $ AST.IndexConstraint 
58                    [AST.ToRange (AST.PrimLit "0")
59                             (AST.PrimName (AST.NAttribute $ 
60                               AST.AttribName (AST.NSimple vecPar) lengthId Nothing) AST.:-:
61                                 (AST.PrimLit "1"))   ]))
62                 Nothing
63        --  res AST.:= vec(0 to i-1) & a & vec(i+1 to length'vec-1)
64     replaceExpr = AST.NSimple resId AST.:=
65            (vecSlice (AST.PrimLit "0") (AST.PrimName (AST.NSimple iPar) AST.:-: AST.PrimLit "1") AST.:&:
66             AST.PrimName (AST.NSimple aPar) AST.:&: 
67              vecSlice (AST.PrimName (AST.NSimple iPar) AST.:+: AST.PrimLit "1")
68                       ((AST.PrimName (AST.NAttribute $ 
69                                 AST.AttribName (AST.NSimple vecPar) lengthId Nothing)) 
70                                                               AST.:-: AST.PrimLit "1"))
71     replaceRet =  AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple resId)
72     vecSlice init last =  AST.PrimName (AST.NSlice 
73                                         (AST.SliceName 
74                                               (AST.NSimple vecPar) 
75                                               (AST.ToRange init last)))
76     headSpec = AST.Function headId [AST.IfaceVarDec vecPar vectorTM] elemTM
77        -- return vec(0);
78     headExpr = AST.ReturnSm (Just $ (AST.PrimName $ AST.NIndexed (AST.IndexedName 
79                     (AST.NSimple vecPar) [AST.PrimLit "0"])))
80     lastSpec = AST.Function lastId [AST.IfaceVarDec vecPar vectorTM] elemTM
81        -- return vec(vec'length-1);
82     lastExpr = AST.ReturnSm (Just $ (AST.PrimName $ AST.NIndexed (AST.IndexedName 
83                     (AST.NSimple vecPar) 
84                     [AST.PrimName (AST.NAttribute $ 
85                                 AST.AttribName (AST.NSimple vecPar) lengthId Nothing) 
86                                                              AST.:-: AST.PrimLit "1"])))
87     initSpec = AST.Function initId [AST.IfaceVarDec vecPar vectorTM] vectorTM 
88        -- variable res : fsvec_x (0 to vec'length-2);
89     initVar = 
90          AST.VarDec resId 
91                 (AST.SubtypeIn vectorTM
92                   (Just $ AST.IndexConstraint 
93                    [AST.ToRange (AST.PrimLit "0")
94                             (AST.PrimName (AST.NAttribute $ 
95                               AST.AttribName (AST.NSimple vecPar) lengthId Nothing) AST.:-:
96                                 (AST.PrimLit "2"))   ]))
97                 Nothing
98        -- resAST.:= vec(0 to vec'length-2)
99     initExpr = AST.NSimple resId AST.:= (vecSlice 
100                                (AST.PrimLit "0") 
101                                (AST.PrimName (AST.NAttribute $ 
102                                   AST.AttribName (AST.NSimple vecPar) lengthId Nothing) 
103                                                              AST.:-: AST.PrimLit "2"))
104     initRet =  AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple resId)
105     tailSpec = AST.Function tailId [AST.IfaceVarDec vecPar vectorTM] vectorTM
106        -- variable res : fsvec_x (0 to vec'length-2); 
107     tailVar = 
108          AST.VarDec resId 
109                 (AST.SubtypeIn vectorTM
110                   (Just $ AST.IndexConstraint 
111                    [AST.ToRange (AST.PrimLit "0")
112                             (AST.PrimName (AST.NAttribute $ 
113                               AST.AttribName (AST.NSimple vecPar) lengthId Nothing) AST.:-:
114                                 (AST.PrimLit "2"))   ]))
115                 Nothing       
116        -- res AST.:= vec(1 to vec'length-1)
117     tailExpr = AST.NSimple resId AST.:= (vecSlice 
118                                (AST.PrimLit "1") 
119                                (AST.PrimName (AST.NAttribute $ 
120                                   AST.AttribName (AST.NSimple vecPar) lengthId Nothing) 
121                                                              AST.:-: AST.PrimLit "1"))
122     tailRet = AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple resId)
123     takeSpec = AST.Function takeId [AST.IfaceVarDec nPar   naturalTM,
124                                    AST.IfaceVarDec vecPar vectorTM ] vectorTM
125        -- variable res : fsvec_x (0 to n-1);
126     takeVar = 
127          AST.VarDec resId 
128                 (AST.SubtypeIn vectorTM
129                   (Just $ AST.IndexConstraint 
130                    [AST.ToRange (AST.PrimLit "0")
131                                ((AST.PrimName (AST.NSimple nPar)) AST.:-:
132                                 (AST.PrimLit "1"))   ]))
133                 Nothing
134        -- res AST.:= vec(0 to n-1)
135     takeExpr = AST.NSimple resId AST.:= 
136                     (vecSlice (AST.PrimLit "1") 
137                               (AST.PrimName (AST.NSimple $ nPar) AST.:-: AST.PrimLit "1"))
138     takeRet =  AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple resId)
139     dropSpec = AST.Function dropId [AST.IfaceVarDec nPar   naturalTM,
140                                    AST.IfaceVarDec vecPar vectorTM ] vectorTM 
141        -- variable res : fsvec_x (0 to vec'length-n-1);
142     dropVar = 
143          AST.VarDec resId 
144                 (AST.SubtypeIn vectorTM
145                   (Just $ AST.IndexConstraint 
146                    [AST.ToRange (AST.PrimLit "0")
147                             (AST.PrimName (AST.NAttribute $ 
148                               AST.AttribName (AST.NSimple vecPar) lengthId Nothing) AST.:-:
149                                (AST.PrimName $ AST.NSimple nPar)AST.:-: (AST.PrimLit "1")) ]))
150                Nothing
151        -- res AST.:= vec(n to vec'length-1)
152     dropExpr = AST.NSimple resId AST.:= (vecSlice 
153                                (AST.PrimName $ AST.NSimple nPar) 
154                                (AST.PrimName (AST.NAttribute $ 
155                                   AST.AttribName (AST.NSimple vecPar) lengthId Nothing) 
156                                                              AST.:-: AST.PrimLit "1"))
157     dropRet =  AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple resId)