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