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   , AST.SubProgBody copySpec    [AST.SPVD copyVar]      [copyExpr]
  80   ]
  81   where
  82     ixPar   = AST.unsafeVHDLBasicId "ix"
  83     vecPar  = AST.unsafeVHDLBasicId "vec"
  84     nPar    = AST.unsafeVHDLBasicId "n"
  85     iId     = AST.unsafeVHDLBasicId "i"
  86     iPar    = iId
  87     aPar    = AST.unsafeVHDLBasicId "a"
  88     resId   = AST.unsafeVHDLBasicId "res"
  89     exSpec = AST.Function exId [AST.IfaceVarDec vecPar vectorTM,
  90                                AST.IfaceVarDec ixPar  naturalTM] elemTM
  91     exExpr = AST.ReturnSm (Just $ AST.PrimName $ AST.NIndexed
  92               (AST.IndexedName (AST.NSimple vecPar) [AST.PrimName $
  93                 AST.NSimple ixPar]))
  94     replaceSpec = AST.Function replaceId  [ AST.IfaceVarDec vecPar vectorTM
  95                                           , AST.IfaceVarDec iPar   naturalTM
  96                                           , AST.IfaceVarDec aPar   elemTM
  97                                           ] vectorTM
  98        -- variable res : fsvec_x (0 to vec'length-1);
  99     replaceVar =
 100          AST.VarDec resId
 101                 (AST.SubtypeIn vectorTM
 102                   (Just $ AST.ConstraintIndex $ AST.IndexConstraint
 103                    [AST.ToRange (AST.PrimLit "0")
 104                             (AST.PrimName (AST.NAttribute $
 105                               AST.AttribName (AST.NSimple vecPar) lengthId Nothing) AST.:-:
 106                                 (AST.PrimLit "1"))   ]))
 107                 Nothing
 108        --  res AST.:= vec(0 to i-1) & a & vec(i+1 to length'vec-1)
 109     replaceExpr = AST.NSimple resId AST.:=
 110            (vecSlice (AST.PrimLit "0") (AST.PrimName (AST.NSimple iPar) AST.:-: AST.PrimLit "1") AST.:&:
 111             AST.PrimName (AST.NSimple aPar) AST.:&:
 112              vecSlice (AST.PrimName (AST.NSimple iPar) AST.:+: AST.PrimLit "1")
 113                       ((AST.PrimName (AST.NAttribute $
 114                                 AST.AttribName (AST.NSimple vecPar) lengthId Nothing))
 115                                                               AST.:-: AST.PrimLit "1"))
 116     replaceRet =  AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple resId)
 117     vecSlice init last =  AST.PrimName (AST.NSlice
 118                                         (AST.SliceName
 119                                               (AST.NSimple vecPar)
 120                                               (AST.ToRange init last)))
 121     headSpec = AST.Function headId [AST.IfaceVarDec vecPar vectorTM] elemTM
 122        -- return vec(0);
 123     headExpr = AST.ReturnSm (Just $ (AST.PrimName $ AST.NIndexed (AST.IndexedName
 124                     (AST.NSimple vecPar) [AST.PrimLit "0"])))
 125     lastSpec = AST.Function lastId [AST.IfaceVarDec vecPar vectorTM] elemTM
 126        -- return vec(vec'length-1);
 127     lastExpr = AST.ReturnSm (Just $ (AST.PrimName $ AST.NIndexed (AST.IndexedName
 128                     (AST.NSimple vecPar)
 129                     [AST.PrimName (AST.NAttribute $
 130                                 AST.AttribName (AST.NSimple vecPar) lengthId Nothing)
 131                                                              AST.:-: AST.PrimLit "1"])))
 132     initSpec = AST.Function initId [AST.IfaceVarDec vecPar vectorTM] vectorTM
 133        -- variable res : fsvec_x (0 to vec'length-2);
 134     initVar =
 135          AST.VarDec resId
 136                 (AST.SubtypeIn vectorTM
 137                   (Just $ AST.ConstraintIndex $ AST.IndexConstraint
 138                    [AST.ToRange (AST.PrimLit "0")
 139                             (AST.PrimName (AST.NAttribute $
 140                               AST.AttribName (AST.NSimple vecPar) lengthId Nothing) AST.:-:
 141                                 (AST.PrimLit "2"))   ]))
 142                 Nothing
 143        -- resAST.:= vec(0 to vec'length-2)
 144     initExpr = AST.NSimple resId AST.:= (vecSlice
 145                                (AST.PrimLit "0")
 146                                (AST.PrimName (AST.NAttribute $
 147                                   AST.AttribName (AST.NSimple vecPar) lengthId Nothing)
 148                                                              AST.:-: AST.PrimLit "2"))
 149     initRet =  AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple resId)
 150     tailSpec = AST.Function tailId [AST.IfaceVarDec vecPar vectorTM] vectorTM
 151        -- variable res : fsvec_x (0 to vec'length-2);
 152     tailVar =
 153          AST.VarDec resId
 154                 (AST.SubtypeIn vectorTM
 155                   (Just $ AST.ConstraintIndex $ AST.IndexConstraint
 156                    [AST.ToRange (AST.PrimLit "0")
 157                             (AST.PrimName (AST.NAttribute $
 158                               AST.AttribName (AST.NSimple vecPar) lengthId Nothing) AST.:-:
 159                                 (AST.PrimLit "2"))   ]))
 160                 Nothing
 161        -- res AST.:= vec(1 to vec'length-1)
 162     tailExpr = AST.NSimple resId AST.:= (vecSlice
 163                                (AST.PrimLit "1")
 164                                (AST.PrimName (AST.NAttribute $
 165                                   AST.AttribName (AST.NSimple vecPar) lengthId Nothing)
 166                                                              AST.:-: AST.PrimLit "1"))
 167     tailRet = AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple resId)
 168     takeSpec = AST.Function takeId [AST.IfaceVarDec nPar   naturalTM,
 169                                    AST.IfaceVarDec vecPar vectorTM ] vectorTM
 170        -- variable res : fsvec_x (0 to n-1);
 171     takeVar =
 172          AST.VarDec resId
 173                 (AST.SubtypeIn vectorTM
 174                   (Just $ AST.ConstraintIndex $ AST.IndexConstraint
 175                    [AST.ToRange (AST.PrimLit "0")
 176                                ((AST.PrimName (AST.NSimple nPar)) AST.:-:
 177                                 (AST.PrimLit "1"))   ]))
 178                 Nothing
 179        -- res AST.:= vec(0 to n-1)
 180     takeExpr = AST.NSimple resId AST.:=
 181                     (vecSlice (AST.PrimLit "1")
 182                               (AST.PrimName (AST.NSimple $ nPar) AST.:-: AST.PrimLit "1"))
 183     takeRet =  AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple resId)
 184     dropSpec = AST.Function dropId [AST.IfaceVarDec nPar   naturalTM,
 185                                    AST.IfaceVarDec vecPar vectorTM ] vectorTM
 186        -- variable res : fsvec_x (0 to vec'length-n-1);
 187     dropVar =
 188          AST.VarDec resId
 189                 (AST.SubtypeIn vectorTM
 190                   (Just $ AST.ConstraintIndex $ AST.IndexConstraint
 191                    [AST.ToRange (AST.PrimLit "0")
 192                             (AST.PrimName (AST.NAttribute $
 193                               AST.AttribName (AST.NSimple vecPar) lengthId Nothing) AST.:-:
 194                                (AST.PrimName $ AST.NSimple nPar)AST.:-: (AST.PrimLit "1")) ]))
 195                Nothing
 196        -- res AST.:= vec(n to vec'length-1)
 197     dropExpr = AST.NSimple resId AST.:= (vecSlice
 198                                (AST.PrimName $ AST.NSimple nPar)
 199                                (AST.PrimName (AST.NAttribute $
 200                                   AST.AttribName (AST.NSimple vecPar) lengthId Nothing)
 201                                                              AST.:-: AST.PrimLit "1"))
 202     dropRet =  AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple resId)
 203     plusgtSpec = AST.Function plusgtId [AST.IfaceVarDec aPar   elemTM,
 204                                        AST.IfaceVarDec vecPar vectorTM] vectorTM
 205     -- variable res : fsvec_x (0 to vec'length);
 206     plusgtVar =
 207       AST.VarDec resId
 208              (AST.SubtypeIn vectorTM
 209                (Just $ AST.ConstraintIndex $ AST.IndexConstraint
 210                 [AST.ToRange (AST.PrimLit "0")
 211                         (AST.PrimName (AST.NAttribute $
 212                           AST.AttribName (AST.NSimple vecPar) lengthId Nothing))]))
 213              Nothing
 214     plusgtExpr = AST.NSimple resId AST.:=
 215                    ((AST.PrimName $ AST.NSimple aPar) AST.:&:
 216                     (AST.PrimName $ AST.NSimple vecPar))
 217     plusgtRet = AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple resId)
 218     emptySpec = AST.Function emptyId [] vectorTM
 219     emptyVar =
 220           AST.VarDec resId
 221               (AST.SubtypeIn vectorTM
 222                 (Just $ AST.ConstraintIndex $ AST.IndexConstraint
 223                  [AST.ToRange (AST.PrimLit "0")
 224                           (AST.PrimLit "-1")]))
 225               Nothing
 226     emptyExpr = AST.ReturnSm (Just $ AST.PrimName (AST.NSimple resId))
 227     singletonSpec = AST.Function singletonId [AST.IfaceVarDec aPar elemTM ]
 228                                          vectorTM
 229     -- variable res : fsvec_x (0 to 0) := (others => a);
 230     singletonVar =
 231       AST.VarDec resId
 232              (AST.SubtypeIn vectorTM
 233                (Just $ AST.ConstraintIndex $ AST.IndexConstraint
 234                 [AST.ToRange (AST.PrimLit "0") (AST.PrimLit "0")]))
 235              (Just $ AST.Aggregate [AST.ElemAssoc (Just AST.Others)
 236                                           (AST.PrimName $ AST.NSimple aPar)])
 237     singletonRet = AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple resId)
 238     copySpec = AST.Function copyId [AST.IfaceVarDec nPar   naturalTM,
 239                                    AST.IfaceVarDec aPar   elemTM   ] vectorTM
 240     -- variable res : fsvec_x (0 to n-1) := (others => a);
 241     copyVar =
 242       AST.VarDec resId
 243              (AST.SubtypeIn vectorTM
 244                (Just $ AST.ConstraintIndex $ AST.IndexConstraint
 245                 [AST.ToRange (AST.PrimLit "0")
 246                             ((AST.PrimName (AST.NSimple nPar)) AST.:-:
 247                              (AST.PrimLit "1"))   ]))
 248              (Just $ AST.Aggregate [AST.ElemAssoc (Just AST.Others)
 249                                           (AST.PrimName $ AST.NSimple aPar)])
 250     -- return res
 251     copyExpr = AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple resId)