Merge branch 'cλash' of http://git.stderr.nl/matthijs/projects/master-project

* 'cλash' of http://git.stderr.nl/matthijs/projects/master-project:
  Generate vector functions on demand.

Conflicts:
	Generate.hs
	GlobalNameTable.hs

diff --git a/Generate.hs b/Generate.hs
index de8c1a6604699320024636b3d5e32a5eab7c576d..cc3cb675b3a405fd7a10cb1d1d973c86195f3742 100644 (file)
--- a/Generate.hs
+++ b/Generate.hs
@@ -53,10 +53,10 @@ genMapCall entity [arg, res] = return $ 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]
@@ -65,6 +65,34 @@ genMapCall entity [arg, res] = return $ genSm
     compins     = mkComponentInst mapLabel entity_id portassigns
     -- Return the generate functions
     genSm       = AST.GenerateSm label genScheme [] [compins]
+    
+genZipWithCall ::
+  Entity
+  -> [CoreSyn.CoreBndr]
+  -> VHDLSession AST.GenerateSm
+genZipWithCall entity [arg1, arg2, res] = return $ 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]
 
 -- Returns the VHDLId of the vector function with the given name for the given
 -- element type. Generates -- this function if needed.
@@ -102,7 +130,7 @@ genUnconsVectorFuns elemTM vectorTM  =
   , (takeId, AST.SubProgBody takeSpec    [AST.SPVD takeVar]  [takeExpr, takeRet])
   , (dropId, AST.SubProgBody dropSpec    [AST.SPVD dropVar]  [dropExpr, dropRet])
   , (plusgtId, AST.SubProgBody plusgtSpec  [AST.SPVD plusgtVar] [plusgtExpr, plusgtRet])
-  , (emptyId, AST.SubProgBody emptySpec   [AST.SPVD emptyVar] [emptyExpr])
+  , (emptyId, AST.SubProgBody emptySpec   [AST.SPCD emptyVar] [emptyExpr])
   , (singletonId, AST.SubProgBody singletonSpec [AST.SPVD singletonVar] [singletonRet])
   , (copyId, AST.SubProgBody copySpec    [AST.SPVD copyVar]      [copyExpr])
   ]
@@ -245,12 +273,9 @@ genUnconsVectorFuns elemTM vectorTM  =
     plusgtRet = AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple resId)
     emptySpec = AST.Function (mkVHDLExtId 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 (mkVHDLExtId singletonId) [AST.IfaceVarDec aPar elemTM ] 
                                          vectorTM

diff --git a/GlobalNameTable.hs b/GlobalNameTable.hs
index dda018c7fc1a41a7dcba431e6e7805f865d24965..feea40170e750e69ec32390abda99bbaa33ed68d 100644 (file)
--- a/GlobalNameTable.hs
+++ b/GlobalNameTable.hs
@@ -27,6 +27,7 @@ globalNameTable = mkGlobalNameTable
   , (dropId           , (2, Left $ genExprFCall dropId                    ) )
   , (plusgtId         , (2, Left $ genExprFCall plusgtId                  ) )
   , (mapId            , (2, Right $ genMapCall                            ) )
+  , (zipWithId        , (3, Right $ genZipWithCall                        ) )
   , (emptyId          , (0, Left $ genExprFCall emptyId                   ) )
   , (singletonId      , (1, Left $ genExprFCall singletonId               ) )
   , (copyId           , (2, Left $ genExprFCall copyId                    ) )