X-Git-Url: https://git.stderr.nl/gitweb?a=blobdiff_plain;f=Generate.hs;h=8065363ca53b8ec7965e1636f4f6ba16e6907532;hb=4d96e10ba2805470597642cf4c2ba797eda1b1f9;hp=654dc8625cbc864ce49c15a9c7963d05419bda80;hpb=597f1b6823417f2c4cc54549f2a9d1b9f131893c;p=matthijs%2Fmaster-project%2Fc%CE%BBash.git

diff --git a/Generate.hs b/Generate.hs
index 654dc86..8065363 100644
--- a/Generate.hs
+++ b/Generate.hs
@@ -19,26 +19,26 @@ import CoreTools
 
 -- | 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
+genExprOp2 :: (AST.Expr -> AST.Expr -> AST.Expr) -> [AST.Expr] -> VHDLSession AST.Expr
+genExprOp2 op [arg1, arg2] = return $ op arg1 arg2
 
 -- | Generate a unary operator application
-genExprOp1 :: (AST.Expr -> AST.Expr) -> [AST.Expr] -> AST.Expr
-genExprOp1 op [arg] = op arg
+genExprOp1 :: (AST.Expr -> AST.Expr) -> [AST.Expr] -> VHDLSession AST.Expr
+genExprOp1 op [arg] = return $ op arg
 
 -- | Generate a function call from the Function Name and a list of expressions
 --   (its arguments)
-genExprFCall :: AST.VHDLId -> [AST.Expr] -> AST.Expr
+genExprFCall :: AST.VHDLId -> [AST.Expr] -> VHDLSession AST.Expr
 genExprFCall fName args = 
-   AST.PrimFCall $ AST.FCall (AST.NSimple fName)  $
+   return $ AST.PrimFCall $ AST.FCall (AST.NSimple fName)  $
              map (\exp -> Nothing AST.:=>: AST.ADExpr exp) args
 
 -- | Generate a generate statement for the builtin function "map"
 genMapCall :: 
   Entity -- | The entity to map
   -> [CoreSyn.CoreBndr] -- | The vectors
-  -> AST.GenerateSm -- | The resulting generate statement
-genMapCall entity [arg, res] = genSm
+  -> VHDLSession AST.GenerateSm -- | The resulting generate statement
+genMapCall entity [arg, res] = return $ genSm
   where
     -- Setup the generate scheme
     len         = (tfvec_len . Var.varType) res
@@ -48,10 +48,10 @@ genMapCall entity [arg, res] = genSm
     genScheme   = AST.ForGn nPar range
     -- Get the entity name and port names
     entity_id   = ent_id entity
-    argport     = map (Monad.liftM fst) (ent_args entity)
+    argports   = map (Monad.liftM fst) (ent_args entity)
     resport     = (Monad.liftM fst) (ent_res entity)
     -- Assign the ports
-    inport      = mkAssocElemIndexed (head argport) (varToString arg) nPar
+    inport      = mkAssocElemIndexed (argports!!0) (varToString arg) nPar
     outport     = mkAssocElemIndexed resport (varToString res) nPar
     clk_port    = mkAssocElem (Just $ mkVHDLExtId "clk") "clk"
     portassigns = Maybe.catMaybes [inport,outport,clk_port]
@@ -60,6 +60,34 @@ genMapCall entity [arg, res] = genSm
     compins     = mkComponentInst mapLabel entity_id portassigns
     -- Return the generate functions
     genSm       = AST.GenerateSm label genScheme [] [compins]
+    
+genZipWithCall ::
+  Entity
+  -> [CoreSyn.CoreBndr]
+  -> AST.GenerateSm
+genZipWithCall entity [arg1, arg2, res] = genSm
+  where
+    -- Setup the generate scheme
+    len         = (tfvec_len . Var.varType) res
+    label       = mkVHDLExtId ("zipWithVector" ++ (varToString res))
+    nPar        = AST.unsafeVHDLBasicId "n"
+    range       = AST.ToRange (AST.PrimLit "0") (AST.PrimLit $ show (len-1))
+    genScheme   = AST.ForGn nPar range
+    -- Get the entity name and port names
+    entity_id   = ent_id entity
+    argports    = map (Monad.liftM fst) (ent_args entity)
+    resport     = (Monad.liftM fst) (ent_res entity)
+    -- Assign the ports
+    inport1     = mkAssocElemIndexed (argports!!0) (varToString arg1) nPar
+    inport2     = mkAssocElemIndexed (argports!!1) (varToString arg2) nPar 
+    outport     = mkAssocElemIndexed resport (varToString res) nPar
+    clk_port    = mkAssocElem (Just $ mkVHDLExtId "clk") "clk"
+    portassigns = Maybe.catMaybes [inport1,inport2,outport,clk_port]
+    -- Generate the portmap
+    mapLabel    = "zipWith" ++ (AST.fromVHDLId entity_id)
+    compins     = mkComponentInst mapLabel entity_id portassigns
+    -- Return the generate functions
+    genSm       = AST.GenerateSm label genScheme [] [compins]
 
 genUnconsVectorFuns :: AST.TypeMark -- ^ type of the vector elements
                     -> AST.TypeMark -- ^ type of the vector
@@ -74,7 +102,7 @@ genUnconsVectorFuns elemTM vectorTM  =
   , AST.SubProgBody takeSpec    [AST.SPVD takeVar]  [takeExpr, takeRet]         
   , AST.SubProgBody dropSpec    [AST.SPVD dropVar]  [dropExpr, dropRet]    
   , AST.SubProgBody plusgtSpec  [AST.SPVD plusgtVar] [plusgtExpr, plusgtRet]
-  , AST.SubProgBody emptySpec   [AST.SPVD emptyVar] [emptyExpr]
+  , AST.SubProgBody emptySpec   [AST.SPCD emptyVar] [emptyExpr]
   , AST.SubProgBody singletonSpec [AST.SPVD singletonVar] [singletonRet] 
   , AST.SubProgBody copySpec    [AST.SPVD copyVar]      [copyExpr]
   ]
@@ -217,12 +245,9 @@ genUnconsVectorFuns elemTM vectorTM  =
     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
+          AST.ConstDec resId 
+              (AST.SubtypeIn vectorTM Nothing)
+              (Just $ AST.PrimLit "\"\"")
     emptyExpr = AST.ReturnSm (Just $ AST.PrimName (AST.NSimple resId))
     singletonSpec = AST.Function singletonId [AST.IfaceVarDec aPar elemTM ] 
                                          vectorTM