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