Generate.hs

   1 module Generate where
   2
   3 import qualified Control.Monad as Monad
   4 import qualified Maybe
   5
   6 import qualified ForSyDe.Backend.VHDL.AST as AST
   7 import Constants
   8 import VHDLTypes
   9
  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
  14
  15 -- | Generate a unary operator application
  16 genExprOp1 :: (AST.Expr -> AST.Expr) -> [AST.Expr] -> AST.Expr
  17 genExprOp1 op [arg] = op arg
  18
  19 -- | Generate a function call from the Function Name and a list of expressions
  20 --   (its arguments)
  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
  25
  26 -- | Generate a generate statement for the builtin function "map"
  27 genMapCall ::
  28   Int -- | The length of the vector
  29   -> Entity -- | The entity to map
  30   -> AST.VHDLId -- | The input vector
  31   -> AST.VHDLId -- | The output vector
  32   -> AST.GenerateSm -- | The resulting generate statement
  33 genMapCall len entity arg res = genSm
  34   where
  35     label = AST.unsafeVHDLBasicId "mapVector"
  36     nPar  = AST.unsafeVHDLBasicId "n"
  37     range = AST.ToRange (AST.PrimLit "0") (AST.PrimLit $ show (len-1))
  38     genScheme = AST.ForGn nPar range
  39     entity_id = ent_id entity
  40     argport = map (Monad.liftM fst) (ent_args entity)
  41     resport = (Monad.liftM fst) (ent_res entity)
  42     inport = mkAssocElem (head argport) arg
  43     outport = mkAssocElem resport res
  44     portmaps = Maybe.catMaybes [inport,outport]
  45     portmap = AST.CSISm $ AST.CompInsSm (AST.unsafeVHDLBasicId "map12") (AST.IUEntity (AST.NSimple entity_id)) (AST.PMapAspect portmaps)
  46     genSm = AST.GenerateSm label genScheme [] [portmap]
  47     -- | Create an VHDL port -> signal association
  48     mkAssocElem :: Maybe AST.VHDLId -> AST.VHDLId -> Maybe AST.AssocElem
  49     mkAssocElem (Just port) signal = Just $ Just port AST.:=>: (AST.ADName (AST.NIndexed (AST.IndexedName
  50                     (AST.NSimple signal) [AST.PrimName $ AST.NSimple nPar])))
  51     mkAssocElem Nothing _ = Nothing
  52
  53 genUnconsVectorFuns :: AST.TypeMark -- ^ type of the vector elements
  54                     -> AST.TypeMark -- ^ type of the vector
  55                     -> [AST.SubProgBody]
  56 genUnconsVectorFuns elemTM vectorTM  =
  57   [ AST.SubProgBody exSpec      []                  [exExpr]
  58   , AST.SubProgBody replaceSpec [AST.SPVD replaceVar] [replaceExpr,replaceRet]
  59   , AST.SubProgBody headSpec    []                  [headExpr]
  60   , AST.SubProgBody lastSpec    []                  [lastExpr]
  61   , AST.SubProgBody initSpec    [AST.SPVD initVar]  [initExpr, initRet]
  62   , AST.SubProgBody tailSpec    [AST.SPVD tailVar]  [tailExpr, tailRet]
  63   , AST.SubProgBody takeSpec    [AST.SPVD takeVar]  [takeExpr, takeRet]
  64   , AST.SubProgBody dropSpec    [AST.SPVD dropVar]  [dropExpr, dropRet]
  65   , AST.SubProgBody plusgtSpec  [AST.SPVD plusgtVar] [plusgtExpr, plusgtRet]
  66   , AST.SubProgBody emptySpec   [AST.SPVD emptyVar] [emptyExpr]
  67   ]
  68   where
  69     ixPar   = AST.unsafeVHDLBasicId "ix"
  70     vecPar  = AST.unsafeVHDLBasicId "vec"
  71     nPar    = AST.unsafeVHDLBasicId "n"
  72     iId     = AST.unsafeVHDLBasicId "i"
  73     iPar    = iId
  74     aPar    = AST.unsafeVHDLBasicId "a"
  75     resId   = AST.unsafeVHDLBasicId "res"
  76     exSpec = AST.Function exId [AST.IfaceVarDec vecPar vectorTM,
  77                                AST.IfaceVarDec ixPar  naturalTM] elemTM
  78     exExpr = AST.ReturnSm (Just $ AST.PrimName $ AST.NIndexed
  79               (AST.IndexedName (AST.NSimple vecPar) [AST.PrimName $
  80                 AST.NSimple ixPar]))
  81     replaceSpec = AST.Function replaceId  [ AST.IfaceVarDec vecPar vectorTM
  82                                           , AST.IfaceVarDec iPar   naturalTM
  83                                           , AST.IfaceVarDec aPar   elemTM
  84                                           ] vectorTM
  85        -- variable res : fsvec_x (0 to vec'length-1);
  86     replaceVar =
  87          AST.VarDec resId
  88                 (AST.SubtypeIn vectorTM
  89                   (Just $ AST.ConstraintIndex $ AST.IndexConstraint
  90                    [AST.ToRange (AST.PrimLit "0")
  91                             (AST.PrimName (AST.NAttribute $
  92                               AST.AttribName (AST.NSimple vecPar) lengthId Nothing) AST.:-:
  93                                 (AST.PrimLit "1"))   ]))
  94                 Nothing
  95        --  res AST.:= vec(0 to i-1) & a & vec(i+1 to length'vec-1)
  96     replaceExpr = AST.NSimple resId AST.:=
  97            (vecSlice (AST.PrimLit "0") (AST.PrimName (AST.NSimple iPar) AST.:-: AST.PrimLit "1") AST.:&:
  98             AST.PrimName (AST.NSimple aPar) AST.:&:
  99              vecSlice (AST.PrimName (AST.NSimple iPar) AST.:+: AST.PrimLit "1")
 100                       ((AST.PrimName (AST.NAttribute $
 101                                 AST.AttribName (AST.NSimple vecPar) lengthId Nothing))
 102                                                               AST.:-: AST.PrimLit "1"))
 103     replaceRet =  AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple resId)
 104     vecSlice init last =  AST.PrimName (AST.NSlice
 105                                         (AST.SliceName
 106                                               (AST.NSimple vecPar)
 107                                               (AST.ToRange init last)))
 108     headSpec = AST.Function headId [AST.IfaceVarDec vecPar vectorTM] elemTM
 109        -- return vec(0);
 110     headExpr = AST.ReturnSm (Just $ (AST.PrimName $ AST.NIndexed (AST.IndexedName
 111                     (AST.NSimple vecPar) [AST.PrimLit "0"])))
 112     lastSpec = AST.Function lastId [AST.IfaceVarDec vecPar vectorTM] elemTM
 113        -- return vec(vec'length-1);
 114     lastExpr = AST.ReturnSm (Just $ (AST.PrimName $ AST.NIndexed (AST.IndexedName
 115                     (AST.NSimple vecPar)
 116                     [AST.PrimName (AST.NAttribute $
 117                                 AST.AttribName (AST.NSimple vecPar) lengthId Nothing)
 118                                                              AST.:-: AST.PrimLit "1"])))
 119     initSpec = AST.Function initId [AST.IfaceVarDec vecPar vectorTM] vectorTM
 120        -- variable res : fsvec_x (0 to vec'length-2);
 121     initVar =
 122          AST.VarDec resId
 123                 (AST.SubtypeIn vectorTM
 124                   (Just $ AST.ConstraintIndex $ AST.IndexConstraint
 125                    [AST.ToRange (AST.PrimLit "0")
 126                             (AST.PrimName (AST.NAttribute $
 127                               AST.AttribName (AST.NSimple vecPar) lengthId Nothing) AST.:-:
 128                                 (AST.PrimLit "2"))   ]))
 129                 Nothing
 130        -- resAST.:= vec(0 to vec'length-2)
 131     initExpr = AST.NSimple resId AST.:= (vecSlice
 132                                (AST.PrimLit "0")
 133                                (AST.PrimName (AST.NAttribute $
 134                                   AST.AttribName (AST.NSimple vecPar) lengthId Nothing)
 135                                                              AST.:-: AST.PrimLit "2"))
 136     initRet =  AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple resId)
 137     tailSpec = AST.Function tailId [AST.IfaceVarDec vecPar vectorTM] vectorTM
 138        -- variable res : fsvec_x (0 to vec'length-2);
 139     tailVar =
 140          AST.VarDec resId
 141                 (AST.SubtypeIn vectorTM
 142                   (Just $ AST.ConstraintIndex $ AST.IndexConstraint
 143                    [AST.ToRange (AST.PrimLit "0")
 144                             (AST.PrimName (AST.NAttribute $
 145                               AST.AttribName (AST.NSimple vecPar) lengthId Nothing) AST.:-:
 146                                 (AST.PrimLit "2"))   ]))
 147                 Nothing
 148        -- res AST.:= vec(1 to vec'length-1)
 149     tailExpr = AST.NSimple resId AST.:= (vecSlice
 150                                (AST.PrimLit "1")
 151                                (AST.PrimName (AST.NAttribute $
 152                                   AST.AttribName (AST.NSimple vecPar) lengthId Nothing)
 153                                                              AST.:-: AST.PrimLit "1"))
 154     tailRet = AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple resId)
 155     takeSpec = AST.Function takeId [AST.IfaceVarDec nPar   naturalTM,
 156                                    AST.IfaceVarDec vecPar vectorTM ] vectorTM
 157        -- variable res : fsvec_x (0 to n-1);
 158     takeVar =
 159          AST.VarDec resId
 160                 (AST.SubtypeIn vectorTM
 161                   (Just $ AST.ConstraintIndex $ AST.IndexConstraint
 162                    [AST.ToRange (AST.PrimLit "0")
 163                                ((AST.PrimName (AST.NSimple nPar)) AST.:-:
 164                                 (AST.PrimLit "1"))   ]))
 165                 Nothing
 166        -- res AST.:= vec(0 to n-1)
 167     takeExpr = AST.NSimple resId AST.:=
 168                     (vecSlice (AST.PrimLit "1")
 169                               (AST.PrimName (AST.NSimple $ nPar) AST.:-: AST.PrimLit "1"))
 170     takeRet =  AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple resId)
 171     dropSpec = AST.Function dropId [AST.IfaceVarDec nPar   naturalTM,
 172                                    AST.IfaceVarDec vecPar vectorTM ] vectorTM
 173        -- variable res : fsvec_x (0 to vec'length-n-1);
 174     dropVar =
 175          AST.VarDec resId
 176                 (AST.SubtypeIn vectorTM
 177                   (Just $ AST.ConstraintIndex $ AST.IndexConstraint
 178                    [AST.ToRange (AST.PrimLit "0")
 179                             (AST.PrimName (AST.NAttribute $
 180                               AST.AttribName (AST.NSimple vecPar) lengthId Nothing) AST.:-:
 181                                (AST.PrimName $ AST.NSimple nPar)AST.:-: (AST.PrimLit "1")) ]))
 182                Nothing
 183        -- res AST.:= vec(n to vec'length-1)
 184     dropExpr = AST.NSimple resId AST.:= (vecSlice
 185                                (AST.PrimName $ AST.NSimple nPar)
 186                                (AST.PrimName (AST.NAttribute $
 187                                   AST.AttribName (AST.NSimple vecPar) lengthId Nothing)
 188                                                              AST.:-: AST.PrimLit "1"))
 189     dropRet =  AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple resId)
 190     plusgtSpec = AST.Function plusgtId [AST.IfaceVarDec aPar   elemTM,
 191                                        AST.IfaceVarDec vecPar vectorTM] vectorTM
 192     -- variable res : fsvec_x (0 to vec'length);
 193     plusgtVar =
 194       AST.VarDec resId
 195              (AST.SubtypeIn vectorTM
 196                (Just $ AST.ConstraintIndex $ AST.IndexConstraint
 197                 [AST.ToRange (AST.PrimLit "0")
 198                         (AST.PrimName (AST.NAttribute $
 199                           AST.AttribName (AST.NSimple vecPar) lengthId Nothing))]))
 200              Nothing
 201     plusgtExpr = AST.NSimple resId AST.:=
 202                    ((AST.PrimName $ AST.NSimple aPar) AST.:&:
 203                     (AST.PrimName $ AST.NSimple vecPar))
 204     plusgtRet = AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple resId)
 205     emptySpec = AST.Function emptyId [] vectorTM
 206     emptyVar =
 207           AST.VarDec resId
 208               (AST.SubtypeIn vectorTM
 209                 (Just $ AST.ConstraintIndex $ AST.IndexConstraint
 210                  [AST.ToRange (AST.PrimLit "0")
 211                           (AST.PrimLit "-1")]))
 212               Nothing
 213     emptyExpr = AST.ReturnSm (Just $ AST.PrimName (AST.NSimple resId))