Generate.hs

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