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)