Almost finished support for 'map'

[matthijs/master-project/cλash.git] / Generate.hs

diff --git a/Generate.hs b/Generate.hs
index 2beacb8d5616e7c9014f3fef35a6644d02773a49..f81d7692434a7247325f1d1fdc3f1292d23df9b7 100644 (file)
--- a/Generate.hs
+++ b/Generate.hs
@@ -1,7 +1,20 @@
 module Generate where
-  
+
+import qualified Control.Monad as Monad
+import qualified Maybe
+
 import qualified ForSyDe.Backend.VHDL.AST as AST
 import Constants
+import VHDLTypes
+
+-- | Generate a binary operator application. The first argument should be a
+-- constructor from the AST.Expr type, e.g. AST.And.
+genExprOp2 :: (AST.Expr -> AST.Expr -> AST.Expr) -> [AST.Expr] -> AST.Expr
+genExprOp2 op [arg1, arg2] = op arg1 arg2
+
+-- | Generate a unary operator application
+genExprOp1 :: (AST.Expr -> AST.Expr) -> [AST.Expr] -> AST.Expr
+genExprOp1 op [arg] = op arg
 
 -- | Generate a function call from the Function Name and a list of expressions
 --   (its arguments)
@@ -10,15 +23,31 @@ genExprFCall fName args =
    AST.PrimFCall $ AST.FCall (AST.NSimple fName)  $
              map (\exp -> Nothing AST.:=>: AST.ADExpr exp) args
 
--- | List version of genExprFCall1
-genExprFCall1L :: AST.VHDLId -> [AST.Expr] -> AST.Expr
-genExprFCall1L fName [arg] = genExprFCall fName [arg]
-genExprFCall1L _ _ = error "Generate.genExprFCall1L incorrect length"
-
--- | List version of genExprFCall2
-genExprFCall2L :: AST.VHDLId -> [AST.Expr] -> AST.Expr
-genExprFCall2L fName [arg1, arg2] = genExprFCall fName [arg1,arg2]
-genExprFCall2L _ _ = error "Generate.genExprFCall2L incorrect length"
+-- | Generate a generate statement for the builtin function "map"
+genMapCall :: 
+  Int -- | The length of the vector 
+  -> Entity -- | The entity to map
+  -> [AST.VHDLId] -- | The vectors
+  -> AST.GenerateSm -- | The resulting generate statement
+genMapCall len entity [arg, res] = genSm
+  where
+    label = AST.unsafeVHDLBasicId "mapVector"
+    nPar  = AST.unsafeVHDLBasicId "n"
+    range = AST.ToRange (AST.PrimLit "0") (AST.PrimLit $ show (len-1))
+    genScheme = AST.ForGn nPar range
+    entity_id = ent_id entity
+    argport = map (Monad.liftM fst) (ent_args entity)
+    resport = (Monad.liftM fst) (ent_res entity)
+    inport = mkAssocElem (head argport) arg
+    outport = mkAssocElem resport res
+    portmaps = Maybe.catMaybes [inport,outport]
+    portmap = AST.CSISm $ AST.CompInsSm (AST.unsafeVHDLBasicId "map12") (AST.IUEntity (AST.NSimple entity_id)) (AST.PMapAspect portmaps)
+    genSm = AST.GenerateSm label genScheme [] [portmap]
+    -- | Create an VHDL port -> signal association
+    mkAssocElem :: Maybe AST.VHDLId -> AST.VHDLId -> Maybe AST.AssocElem
+    mkAssocElem (Just port) signal = Just $ Just port AST.:=>: (AST.ADName (AST.NIndexed (AST.IndexedName 
+                    (AST.NSimple signal) [AST.PrimName $ AST.NSimple nPar])))
+    mkAssocElem Nothing _ = Nothing
 
 genUnconsVectorFuns :: AST.TypeMark -- ^ type of the vector elements
                     -> AST.TypeMark -- ^ type of the vector
@@ -31,7 +60,9 @@ genUnconsVectorFuns elemTM vectorTM  =
   , AST.SubProgBody initSpec    [AST.SPVD initVar]  [initExpr, initRet]         
   , AST.SubProgBody tailSpec    [AST.SPVD tailVar]  [tailExpr, tailRet]         
   , AST.SubProgBody takeSpec    [AST.SPVD takeVar]  [takeExpr, takeRet]         
-  , AST.SubProgBody dropSpec    [AST.SPVD dropVar]  [dropExpr, dropRet]         
+  , AST.SubProgBody dropSpec    [AST.SPVD dropVar]  [dropExpr, dropRet]    
+  , AST.SubProgBody plusgtSpec  [AST.SPVD plusgtVar] [plusgtExpr, plusgtRet]
+  , AST.SubProgBody emptySpec   [AST.SPVD emptyVar] [emptyExpr]    
   ]
   where 
     ixPar   = AST.unsafeVHDLBasicId "ix"
@@ -54,7 +85,7 @@ genUnconsVectorFuns elemTM vectorTM  =
     replaceVar =
          AST.VarDec resId 
                 (AST.SubtypeIn vectorTM
-                  (Just $ AST.IndexConstraint 
+                  (Just $ AST.ConstraintIndex $ AST.IndexConstraint 
                    [AST.ToRange (AST.PrimLit "0")
                             (AST.PrimName (AST.NAttribute $ 
                               AST.AttribName (AST.NSimple vecPar) lengthId Nothing) AST.:-:
@@ -89,7 +120,7 @@ genUnconsVectorFuns elemTM vectorTM  =
     initVar = 
          AST.VarDec resId 
                 (AST.SubtypeIn vectorTM
-                  (Just $ AST.IndexConstraint 
+                  (Just $ AST.ConstraintIndex $ AST.IndexConstraint 
                    [AST.ToRange (AST.PrimLit "0")
                             (AST.PrimName (AST.NAttribute $ 
                               AST.AttribName (AST.NSimple vecPar) lengthId Nothing) AST.:-:
@@ -107,7 +138,7 @@ genUnconsVectorFuns elemTM vectorTM  =
     tailVar = 
          AST.VarDec resId 
                 (AST.SubtypeIn vectorTM
-                  (Just $ AST.IndexConstraint 
+                  (Just $ AST.ConstraintIndex $ AST.IndexConstraint 
                    [AST.ToRange (AST.PrimLit "0")
                             (AST.PrimName (AST.NAttribute $ 
                               AST.AttribName (AST.NSimple vecPar) lengthId Nothing) AST.:-:
@@ -126,7 +157,7 @@ genUnconsVectorFuns elemTM vectorTM  =
     takeVar = 
          AST.VarDec resId 
                 (AST.SubtypeIn vectorTM
-                  (Just $ AST.IndexConstraint 
+                  (Just $ AST.ConstraintIndex $ AST.IndexConstraint 
                    [AST.ToRange (AST.PrimLit "0")
                                ((AST.PrimName (AST.NSimple nPar)) AST.:-:
                                 (AST.PrimLit "1"))   ]))
@@ -142,7 +173,7 @@ genUnconsVectorFuns elemTM vectorTM  =
     dropVar = 
          AST.VarDec resId 
                 (AST.SubtypeIn vectorTM
-                  (Just $ AST.IndexConstraint 
+                  (Just $ AST.ConstraintIndex $ AST.IndexConstraint 
                    [AST.ToRange (AST.PrimLit "0")
                             (AST.PrimName (AST.NAttribute $ 
                               AST.AttribName (AST.NSimple vecPar) lengthId Nothing) AST.:-:
@@ -154,4 +185,28 @@ genUnconsVectorFuns elemTM vectorTM  =
                                (AST.PrimName (AST.NAttribute $ 
                                   AST.AttribName (AST.NSimple vecPar) lengthId Nothing) 
                                                              AST.:-: AST.PrimLit "1"))
-    dropRet =  AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple resId)
\ No newline at end of file
+    dropRet =  AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple resId)
+    plusgtSpec = AST.Function plusgtId [AST.IfaceVarDec aPar   elemTM,
+                                       AST.IfaceVarDec vecPar vectorTM] vectorTM 
+    -- variable res : fsvec_x (0 to vec'length);
+    plusgtVar = 
+      AST.VarDec resId 
+             (AST.SubtypeIn vectorTM
+               (Just $ AST.ConstraintIndex $ AST.IndexConstraint 
+                [AST.ToRange (AST.PrimLit "0")
+                        (AST.PrimName (AST.NAttribute $ 
+                          AST.AttribName (AST.NSimple vecPar) lengthId Nothing))]))
+             Nothing
+    plusgtExpr = AST.NSimple resId AST.:= 
+                   ((AST.PrimName $ AST.NSimple aPar) AST.:&: 
+                    (AST.PrimName $ AST.NSimple vecPar))
+    plusgtRet = AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple resId)
+    emptySpec = AST.Function emptyId [] vectorTM
+    emptyVar = 
+          AST.VarDec resId 
+              (AST.SubtypeIn vectorTM
+                (Just $ AST.ConstraintIndex $ AST.IndexConstraint 
+                 [AST.ToRange (AST.PrimLit "0")
+                          (AST.PrimLit "-1")]))
+              Nothing
+    emptyExpr = AST.ReturnSm (Just $ AST.PrimName (AST.NSimple resId))
\ No newline at end of file