From: Christiaan Baaij <christiaan.baaij@gmail.com>
Date: Wed, 24 Jun 2009 10:35:50 +0000 (+0200)
Subject: Merge branch 'cλash' of http://git.stderr.nl/matthijs/projects/master-project
X-Git-Url: https://git.stderr.nl/gitweb?a=commitdiff_plain;h=4d96e10ba2805470597642cf4c2ba797eda1b1f9;hp=-c;p=matthijs%2Fmaster-project%2Fc%CE%BBash.git

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

* 'cλash' of http://git.stderr.nl/matthijs/projects/master-project:
  Put the Builders in the VHDLSession.
  Remove the globalNameTable from the VHDLState.
  Swap the VHDLState and VHDLSession type names.
---

4d96e10ba2805470597642cf4c2ba797eda1b1f9
diff --combined Generate.hs
index 692d912,75bea24..8065363
--- a/Generate.hs
+++ b/Generate.hs
@@@ -19,26 -19,26 +19,26 @@@ import CoreTool
  
  -- | 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 +48,10 @@@
      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,34 -60,6 +60,34 @@@
      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
@@@ -102,7 -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]
    ]
@@@ -245,9 -217,12 +245,9 @@@
      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