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 = mkVHDLExtId ("mapVector" ++ (AST.fromVHDLId res))
  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 = mkAssocElemI (head argport) arg
  42     outport = mkAssocElemI resport res
  43     clk_port = mkAssocElem (Just $ mkVHDLExtId "clk") "clk"
  44     portmaps = Maybe.catMaybes [inport,outport,clk_port]
  45     portname = mkVHDLExtId ("map" ++ (AST.fromVHDLId entity_id))
  46     portmap = AST.CSISm $ AST.CompInsSm (AST.unsafeVHDLBasicId "map12") (AST.IUEntity (AST.NSimple entity_id)) (AST.PMapAspect portmaps)
  47     genSm = AST.GenerateSm label genScheme [] [portmap]
  48     -- | Create an VHDL port -> signal association
  49     mkAssocElemI :: Maybe AST.VHDLId -> AST.VHDLId -> Maybe AST.AssocElem
  50     mkAssocElemI (Just port) signal = Just $ Just port AST.:=>: (AST.ADName (AST.NIndexed (AST.IndexedName
  51                     (AST.NSimple signal) [AST.PrimName $ AST.NSimple nPar])))
  52     mkAssocElemI Nothing _ = Nothing
  53     mkAssocElem :: Maybe AST.VHDLId -> String -> Maybe AST.AssocElem
  54     mkAssocElem (Just port) signal = Just $ Just port AST.:=>: (AST.ADName (AST.NSimple (mkVHDLExtId signal)))
  55     mkAssocElem Nothing _ = Nothing
  56     mkVHDLExtId :: String -> AST.VHDLId
  57     mkVHDLExtId s =
  58       AST.unsafeVHDLExtId $ strip_invalid s
  59       where
  60         -- Allowed characters, taken from ForSyde's mkVHDLExtId
  61         allowed = ['A'..'Z'] ++ ['a'..'z'] ++ ['0'..'9'] ++ " \"#&\\'()*+,./:;<=>_|!$%@?[]^`{}~-"
  62         strip_invalid = filter (`elem` allowed)
  63
  64 genUnconsVectorFuns :: AST.TypeMark -- ^ type of the vector elements
  65                     -> AST.TypeMark -- ^ type of the vector
  66                     -> [AST.SubProgBody]
  67 genUnconsVectorFuns elemTM vectorTM  =
  68   [ AST.SubProgBody exSpec      []                  [exExpr]
  69   , AST.SubProgBody replaceSpec [AST.SPVD replaceVar] [replaceExpr,replaceRet]
  70   , AST.SubProgBody headSpec    []                  [headExpr]
  71   , AST.SubProgBody lastSpec    []                  [lastExpr]
  72   , AST.SubProgBody initSpec    [AST.SPVD initVar]  [initExpr, initRet]
  73   , AST.SubProgBody tailSpec    [AST.SPVD tailVar]  [tailExpr, tailRet]
  74   , AST.SubProgBody takeSpec    [AST.SPVD takeVar]  [takeExpr, takeRet]
  75   , AST.SubProgBody dropSpec    [AST.SPVD dropVar]  [dropExpr, dropRet]
  76   , AST.SubProgBody plusgtSpec  [AST.SPVD plusgtVar] [plusgtExpr, plusgtRet]
  77   , AST.SubProgBody emptySpec   [AST.SPVD emptyVar] [emptyExpr]
  78   , AST.SubProgBody singletonSpec [AST.SPVD singletonVar] [singletonRet]
  79   ]
  80   where
  81     ixPar   = AST.unsafeVHDLBasicId "ix"
  82     vecPar  = AST.unsafeVHDLBasicId "vec"
  83     nPar    = AST.unsafeVHDLBasicId "n"
  84     iId     = AST.unsafeVHDLBasicId "i"
  85     iPar    = iId
  86     aPar    = AST.unsafeVHDLBasicId "a"
  87     resId   = AST.unsafeVHDLBasicId "res"
  88     exSpec = AST.Function exId [AST.IfaceVarDec vecPar vectorTM,
  89                                AST.IfaceVarDec ixPar  naturalTM] elemTM
  90     exExpr = AST.ReturnSm (Just $ AST.PrimName $ AST.NIndexed
  91               (AST.IndexedName (AST.NSimple vecPar) [AST.PrimName $
  92                 AST.NSimple ixPar]))
  93     replaceSpec = AST.Function replaceId  [ AST.IfaceVarDec vecPar vectorTM
  94                                           , AST.IfaceVarDec iPar   naturalTM
  95                                           , AST.IfaceVarDec aPar   elemTM
  96                                           ] vectorTM
  97        -- variable res : fsvec_x (0 to vec'length-1);
  98     replaceVar =
  99          AST.VarDec resId
 100                 (AST.SubtypeIn vectorTM
 101                   (Just $ AST.ConstraintIndex $ AST.IndexConstraint
 102                    [AST.ToRange (AST.PrimLit "0")
 103                             (AST.PrimName (AST.NAttribute $
 104                               AST.AttribName (AST.NSimple vecPar) lengthId Nothing) AST.:-:
 105                                 (AST.PrimLit "1"))   ]))
 106                 Nothing
 107        --  res AST.:= vec(0 to i-1) & a & vec(i+1 to length'vec-1)
 108     replaceExpr = AST.NSimple resId AST.:=
 109            (vecSlice (AST.PrimLit "0") (AST.PrimName (AST.NSimple iPar) AST.:-: AST.PrimLit "1") AST.:&:
 110             AST.PrimName (AST.NSimple aPar) AST.:&:
 111              vecSlice (AST.PrimName (AST.NSimple iPar) AST.:+: AST.PrimLit "1")
 112                       ((AST.PrimName (AST.NAttribute $
 113                                 AST.AttribName (AST.NSimple vecPar) lengthId Nothing))
 114                                                               AST.:-: AST.PrimLit "1"))
 115     replaceRet =  AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple resId)
 116     vecSlice init last =  AST.PrimName (AST.NSlice
 117                                         (AST.SliceName
 118                                               (AST.NSimple vecPar)
 119                                               (AST.ToRange init last)))
 120     headSpec = AST.Function headId [AST.IfaceVarDec vecPar vectorTM] elemTM
 121        -- return vec(0);
 122     headExpr = AST.ReturnSm (Just $ (AST.PrimName $ AST.NIndexed (AST.IndexedName
 123                     (AST.NSimple vecPar) [AST.PrimLit "0"])))
 124     lastSpec = AST.Function lastId [AST.IfaceVarDec vecPar vectorTM] elemTM
 125        -- return vec(vec'length-1);
 126     lastExpr = AST.ReturnSm (Just $ (AST.PrimName $ AST.NIndexed (AST.IndexedName
 127                     (AST.NSimple vecPar)
 128                     [AST.PrimName (AST.NAttribute $
 129                                 AST.AttribName (AST.NSimple vecPar) lengthId Nothing)
 130                                                              AST.:-: AST.PrimLit "1"])))
 131     initSpec = AST.Function initId [AST.IfaceVarDec vecPar vectorTM] vectorTM
 132        -- variable res : fsvec_x (0 to vec'length-2);
 133     initVar =
 134          AST.VarDec resId
 135                 (AST.SubtypeIn vectorTM
 136                   (Just $ AST.ConstraintIndex $ AST.IndexConstraint
 137                    [AST.ToRange (AST.PrimLit "0")
 138                             (AST.PrimName (AST.NAttribute $
 139                               AST.AttribName (AST.NSimple vecPar) lengthId Nothing) AST.:-:
 140                                 (AST.PrimLit "2"))   ]))
 141                 Nothing
 142        -- resAST.:= vec(0 to vec'length-2)
 143     initExpr = AST.NSimple resId AST.:= (vecSlice
 144                                (AST.PrimLit "0")
 145                                (AST.PrimName (AST.NAttribute $
 146                                   AST.AttribName (AST.NSimple vecPar) lengthId Nothing)
 147                                                              AST.:-: AST.PrimLit "2"))
 148     initRet =  AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple resId)
 149     tailSpec = AST.Function tailId [AST.IfaceVarDec vecPar vectorTM] vectorTM
 150        -- variable res : fsvec_x (0 to vec'length-2);
 151     tailVar =
 152          AST.VarDec resId
 153                 (AST.SubtypeIn vectorTM
 154                   (Just $ AST.ConstraintIndex $ AST.IndexConstraint
 155                    [AST.ToRange (AST.PrimLit "0")
 156                             (AST.PrimName (AST.NAttribute $
 157                               AST.AttribName (AST.NSimple vecPar) lengthId Nothing) AST.:-:
 158                                 (AST.PrimLit "2"))   ]))
 159                 Nothing
 160        -- res AST.:= vec(1 to vec'length-1)
 161     tailExpr = AST.NSimple resId AST.:= (vecSlice
 162                                (AST.PrimLit "1")
 163                                (AST.PrimName (AST.NAttribute $
 164                                   AST.AttribName (AST.NSimple vecPar) lengthId Nothing)
 165                                                              AST.:-: AST.PrimLit "1"))
 166     tailRet = AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple resId)
 167     takeSpec = AST.Function takeId [AST.IfaceVarDec nPar   naturalTM,
 168                                    AST.IfaceVarDec vecPar vectorTM ] vectorTM
 169        -- variable res : fsvec_x (0 to n-1);
 170     takeVar =
 171          AST.VarDec resId
 172                 (AST.SubtypeIn vectorTM
 173                   (Just $ AST.ConstraintIndex $ AST.IndexConstraint
 174                    [AST.ToRange (AST.PrimLit "0")
 175                                ((AST.PrimName (AST.NSimple nPar)) AST.:-:
 176                                 (AST.PrimLit "1"))   ]))
 177                 Nothing
 178        -- res AST.:= vec(0 to n-1)
 179     takeExpr = AST.NSimple resId AST.:=
 180                     (vecSlice (AST.PrimLit "1")
 181                               (AST.PrimName (AST.NSimple $ nPar) AST.:-: AST.PrimLit "1"))
 182     takeRet =  AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple resId)
 183     dropSpec = AST.Function dropId [AST.IfaceVarDec nPar   naturalTM,
 184                                    AST.IfaceVarDec vecPar vectorTM ] vectorTM
 185        -- variable res : fsvec_x (0 to vec'length-n-1);
 186     dropVar =
 187          AST.VarDec resId
 188                 (AST.SubtypeIn vectorTM
 189                   (Just $ AST.ConstraintIndex $ AST.IndexConstraint
 190                    [AST.ToRange (AST.PrimLit "0")
 191                             (AST.PrimName (AST.NAttribute $
 192                               AST.AttribName (AST.NSimple vecPar) lengthId Nothing) AST.:-:
 193                                (AST.PrimName $ AST.NSimple nPar)AST.:-: (AST.PrimLit "1")) ]))
 194                Nothing
 195        -- res AST.:= vec(n to vec'length-1)
 196     dropExpr = AST.NSimple resId AST.:= (vecSlice
 197                                (AST.PrimName $ AST.NSimple nPar)
 198                                (AST.PrimName (AST.NAttribute $
 199                                   AST.AttribName (AST.NSimple vecPar) lengthId Nothing)
 200                                                              AST.:-: AST.PrimLit "1"))
 201     dropRet =  AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple resId)
 202     plusgtSpec = AST.Function plusgtId [AST.IfaceVarDec aPar   elemTM,
 203                                        AST.IfaceVarDec vecPar vectorTM] vectorTM
 204     -- variable res : fsvec_x (0 to vec'length);
 205     plusgtVar =
 206       AST.VarDec resId
 207              (AST.SubtypeIn vectorTM
 208                (Just $ AST.ConstraintIndex $ AST.IndexConstraint
 209                 [AST.ToRange (AST.PrimLit "0")
 210                         (AST.PrimName (AST.NAttribute $
 211                           AST.AttribName (AST.NSimple vecPar) lengthId Nothing))]))
 212              Nothing
 213     plusgtExpr = AST.NSimple resId AST.:=
 214                    ((AST.PrimName $ AST.NSimple aPar) AST.:&:
 215                     (AST.PrimName $ AST.NSimple vecPar))
 216     plusgtRet = AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple resId)
 217     emptySpec = AST.Function emptyId [] vectorTM
 218     emptyVar =
 219           AST.VarDec resId
 220               (AST.SubtypeIn vectorTM
 221                 (Just $ AST.ConstraintIndex $ AST.IndexConstraint
 222                  [AST.ToRange (AST.PrimLit "0")
 223                           (AST.PrimLit "-1")]))
 224               Nothing
 225     emptyExpr = AST.ReturnSm (Just $ AST.PrimName (AST.NSimple resId))
 226     singletonSpec = AST.Function singletonId [AST.IfaceVarDec aPar elemTM ]
 227                                          vectorTM
 228     -- variable res : fsvec_x (0 to 0) := (others => a);
 229     singletonVar =
 230       AST.VarDec resId
 231              (AST.SubtypeIn vectorTM
 232                (Just $ AST.ConstraintIndex $ AST.IndexConstraint
 233                 [AST.ToRange (AST.PrimLit "0") (AST.PrimLit "0")]))
 234              (Just $ AST.Aggregate [AST.ElemAssoc (Just AST.Others)
 235                                           (AST.PrimName $ AST.NSimple aPar)])
 236     singletonRet = AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple resId)