From 6fffdcf32a54a6372442d22a87537ee9733073ad Mon Sep 17 00:00:00 2001
From: Matthijs Kooijman <m.kooijman@student.utwente.nl>
Date: Wed, 24 Jun 2009 12:08:05 +0200
Subject: [PATCH] Put the Builders in the VHDLSession.

---
 Generate.hs  | 16 ++++++++--------
 VHDL.hs      | 33 +++++++++++++++------------------
 VHDLTypes.hs |  2 +-
 3 files changed, 24 insertions(+), 27 deletions(-)

diff --git a/Generate.hs b/Generate.hs
index 654dc86..75bea24 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
diff --git a/VHDL.hs b/VHDL.hs
index 636634e..f9367ef 100644
--- a/VHDL.hs
+++ b/VHDL.hs
@@ -299,24 +299,21 @@ mkConcSm (bndr, app@(CoreSyn.App _ _))= do
         Just (arg_count, builder) ->
           if length valargs == arg_count then
             case builder of
-              Left funBuilder ->
-                let
-                  sigs = map (varToVHDLExpr.exprToVar) valargs
-                  func = funBuilder sigs
-                  src_wform = AST.Wform [AST.WformElem func Nothing]
-                  dst_name = AST.NSimple (mkVHDLExtId (varToString bndr))
-                  assign = dst_name AST.:<==: (AST.ConWforms [] src_wform Nothing)
-                in
-                  return [AST.CSSASm assign]
-              Right genBuilder ->
-                let
-                  sigs = map exprToVar valargs
-                  signature = Maybe.fromMaybe
-                    (error $ "Using function '" ++ (varToString (head sigs)) ++ "' without signature? This should not happen!") 
-                    (Map.lookup (head sigs) signatures)
-                  arg = tail sigs
-                  genSm = genBuilder signature (arg ++ [bndr])  
-                in return [AST.CSGSm genSm]
+              Left funBuilder -> do
+                let sigs = map (varToVHDLExpr.exprToVar) valargs
+                func <- funBuilder sigs
+                let src_wform = AST.Wform [AST.WformElem func Nothing]
+                let dst_name = AST.NSimple (mkVHDLExtId (varToString bndr))
+                let assign = dst_name AST.:<==: (AST.ConWforms [] src_wform Nothing)
+                return [AST.CSSASm assign]
+              Right genBuilder -> do
+                let sigs = map exprToVar valargs
+                let signature = Maybe.fromMaybe
+                      (error $ "Using function '" ++ (varToString (head sigs)) ++ "' without signature? This should not happen!") 
+                      (Map.lookup (head sigs) signatures)
+                let arg = tail sigs
+                genSm <- genBuilder signature (arg ++ [bndr])  
+                return [AST.CSGSm genSm]
           else
             error $ "VHDL.mkConcSm Incorrect number of arguments to builtin function: " ++ pprString f ++ " Args: " ++ pprString valargs
         Nothing -> error $ "Using function from another module that is not a known builtin: " ++ pprString f
diff --git a/VHDLTypes.hs b/VHDLTypes.hs
index 59da9c1..3a8bce1 100644
--- a/VHDLTypes.hs
+++ b/VHDLTypes.hs
@@ -75,7 +75,7 @@ type VHDLSession = State.State VHDLState
 -- | A substate containing just the types
 type TypeState = State.State TypeMap
 
-type Builder = Either ([AST.Expr] -> AST.Expr) (Entity -> [CoreSyn.CoreBndr] -> AST.GenerateSm)
+type Builder = Either ([AST.Expr] -> VHDLSession AST.Expr) (Entity -> [CoreSyn.CoreBndr] -> VHDLSession AST.GenerateSm)
 
 -- A map of a builtin function to VHDL function builder 
 type NameTable = Map.Map String (Int, Builder )
-- 
2.30.2