Merge git://github.com/darchon/clash into cλash

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

diff --git a/Generate.hs b/Generate.hs
index dfd9fad8bbfaed867db25a8d368493387cae7c57..f4cab36460d4f1b1b9e39ce5dc8819a582c68102 100644 (file)
--- a/Generate.hs
+++ b/Generate.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE PackageImports #-}
+

 module Generate where
 
 -- Standard modules
 module Generate where
 
 -- Standard modules


@@ -5,7 +7,10 @@ import qualified Control.Monad as Monad
 import qualified Data.Map as Map
 import qualified Maybe
 import qualified Data.Either as Either
 import qualified Data.Map as Map
 import qualified Maybe
 import qualified Data.Either as Either

+import qualified Control.Monad.Trans.State as State
+import qualified "transformers" Control.Monad.Identity as Identity

 import Data.Accessor
 import Data.Accessor

+import Data.Accessor.MonadState as MonadState

 import Debug.Trace
 
 -- ForSyDe
 import Debug.Trace
 
 -- ForSyDe


@@ -16,6 +21,9 @@ import CoreSyn
 import Type
 import qualified Var
 import qualified IdInfo
 import Type
 import qualified Var
 import qualified IdInfo

+import qualified Literal
+import qualified Name
+import qualified TyCon

 
 -- Local imports
 import Constants
 
 -- Local imports
 import Constants


@@ -30,12 +38,13 @@ import Pretty
 
 -- | A function to wrap a builder-like function that expects its arguments to
 -- be expressions.
 
 -- | A function to wrap a builder-like function that expects its arguments to
 -- be expressions.

-genExprArgs ::
-  (dst -> func -> [AST.Expr] -> res)
-  -> (dst -> func -> [Either CoreSyn.CoreExpr AST.Expr] -> res)
-genExprArgs wrap dst func args = wrap dst func args'
-  where args' = map (either (varToVHDLExpr.exprToVar) id) args
-  
+genExprArgs wrap dst func args = do
+  args' <- eitherCoreOrExprArgs args
+  wrap dst func args'
+
+eitherCoreOrExprArgs :: [Either CoreSyn.CoreExpr AST.Expr] -> VHDLSession [AST.Expr]
+eitherCoreOrExprArgs args = mapM (Either.either ((MonadState.lift vsType) . varToVHDLExpr . exprToVar) return) args
+

 -- | A function to wrap a builder-like function that expects its arguments to
 -- be variables.
 genVarArgs ::
 -- | A function to wrap a builder-like function that expects its arguments to
 -- be variables.
 genVarArgs ::


@@ -47,6 +56,18 @@ genVarArgs wrap dst func args = wrap dst func args'
     -- Check (rather crudely) that all arguments are CoreExprs
     (exprargs, []) = Either.partitionEithers args
 
     -- Check (rather crudely) that all arguments are CoreExprs
     (exprargs, []) = Either.partitionEithers args
 

+-- | A function to wrap a builder-like function that expects its arguments to
+-- be Literals
+genLitArgs ::
+  (dst -> func -> [Literal.Literal] -> res)
+  -> (dst -> func -> [Either CoreSyn.CoreExpr AST.Expr] -> res)
+genLitArgs wrap dst func args = wrap dst func args'
+  where
+    args' = map exprToLit litargs
+    -- FIXME: Check if we were passed an CoreSyn.App
+    litargs = concat (map getLiterals exprargs)
+    (exprargs, []) = Either.partitionEithers args
+

 -- | A function to wrap a builder-like function that produces an expression
 -- and expects it to be assigned to the destination.
 genExprRes ::
 -- | A function to wrap a builder-like function that produces an expression
 -- and expects it to be assigned to the destination.
 genExprRes ::


@@ -69,6 +90,19 @@ genOperator1 op = genExprArgs $ genExprRes (genOperator1' op)
 genOperator1' :: (AST.Expr -> AST.Expr) -> dst -> CoreSyn.CoreBndr -> [AST.Expr] -> VHDLSession AST.Expr
 genOperator1' op _ f [arg] = return $ op arg
 
 genOperator1' :: (AST.Expr -> AST.Expr) -> dst -> CoreSyn.CoreBndr -> [AST.Expr] -> VHDLSession AST.Expr
 genOperator1' op _ f [arg] = return $ op arg
 

+-- | Generate a unary operator application
+genNegation :: BuiltinBuilder 
+genNegation = genVarArgs $ genExprRes genNegation'
+genNegation' :: dst -> CoreSyn.CoreBndr -> [Var.Var] -> VHDLSession AST.Expr
+genNegation' _ f [arg] = do
+  arg1 <- MonadState.lift vsType $ varToVHDLExpr arg
+  let ty = Var.varType arg
+  let (tycon, args) = Type.splitTyConApp ty
+  let name = Name.getOccString (TyCon.tyConName tycon)
+  case name of
+    "SizedInt" -> return $ AST.Neg arg1
+    otherwise -> error $ "\nGenerate.genNegation': Negation allowed for type: " ++ show name 
+

 -- | Generate a function call from the destination binder, function name and a
 -- list of expressions (its arguments)
 genFCall :: Bool -> BuiltinBuilder 
 -- | Generate a function call from the destination binder, function name and a
 -- list of expressions (its arguments)
 genFCall :: Bool -> BuiltinBuilder 


@@ -77,64 +111,108 @@ genFCall' :: Bool -> Either CoreSyn.CoreBndr AST.VHDLName -> CoreSyn.CoreBndr ->
 genFCall' switch (Left res) f args = do
   let fname = varToString f
   let el_ty = if switch then (Var.varType res) else ((tfvec_elem . Var.varType) res)
 genFCall' switch (Left res) f args = do
   let fname = varToString f
   let el_ty = if switch then (Var.varType res) else ((tfvec_elem . Var.varType) res)

-  id <- vectorFunId el_ty fname
+  id <- MonadState.lift vsType $ vectorFunId el_ty fname

   return $ AST.PrimFCall $ AST.FCall (AST.NSimple id)  $
              map (\exp -> Nothing AST.:=>: AST.ADExpr exp) args
 genFCall' _ (Right name) _ _ = error $ "\nGenerate.genFCall': Cannot generate builtin function call assigned to a VHDLName: " ++ show name
 
   return $ AST.PrimFCall $ AST.FCall (AST.NSimple id)  $
              map (\exp -> Nothing AST.:=>: AST.ADExpr exp) args
 genFCall' _ (Right name) _ _ = error $ "\nGenerate.genFCall': Cannot generate builtin function call assigned to a VHDLName: " ++ show name
 

+genFromSizedWord :: BuiltinBuilder
+genFromSizedWord = genExprArgs $ genExprRes genFromSizedWord'
+genFromSizedWord' :: Either CoreSyn.CoreBndr AST.VHDLName -> CoreSyn.CoreBndr -> [AST.Expr] -> VHDLSession AST.Expr
+genFromSizedWord' (Left res) f args = do
+  let fname = varToString f
+  return $ AST.PrimFCall $ AST.FCall (AST.NSimple (mkVHDLBasicId toIntegerId))  $
+             map (\exp -> Nothing AST.:=>: AST.ADExpr exp) args
+genFromSizedWord' (Right name) _ _ = error $ "\nGenerate.genFromSizedWord': Cannot generate builtin function call assigned to a VHDLName: " ++ show name
+
+genResize :: BuiltinBuilder
+genResize = genExprArgs $ genExprRes genResize'
+genResize' :: Either CoreSyn.CoreBndr AST.VHDLName -> CoreSyn.CoreBndr -> [AST.Expr] -> VHDLSession AST.Expr
+genResize' (Left res) f [arg] = do {
+  ; let { ty = Var.varType res
+        ; (tycon, args) = Type.splitTyConApp ty
+        ; name = Name.getOccString (TyCon.tyConName tycon)
+        } ;
+  ; len <- case name of
+      "SizedInt" -> MonadState.lift vsType $ tfp_to_int (sized_int_len_ty ty)
+      "SizedWord" -> MonadState.lift vsType $ tfp_to_int (sized_word_len_ty ty)
+  ; return $ AST.PrimFCall $ AST.FCall (AST.NSimple (mkVHDLBasicId resizeId))
+             [Nothing AST.:=>: AST.ADExpr arg, Nothing AST.:=>: AST.ADExpr( AST.PrimLit (show len))]
+  }
+genResize' (Right name) _ _ = error $ "\nGenerate.genFromSizedWord': Cannot generate builtin function call assigned to a VHDLName: " ++ show name
+
+-- FIXME: I'm calling genLitArgs which is very specific function,
+-- which needs to be fixed as well
+genFromInteger :: BuiltinBuilder
+genFromInteger = genLitArgs $ genExprRes genFromInteger'
+genFromInteger' :: Either CoreSyn.CoreBndr AST.VHDLName -> CoreSyn.CoreBndr -> [Literal.Literal] -> VHDLSession AST.Expr
+genFromInteger' (Left res) f lits = do {
+  ; let { ty = Var.varType res
+        ; (tycon, args) = Type.splitTyConApp ty
+        ; name = Name.getOccString (TyCon.tyConName tycon)
+        } ;
+  ; len <- case name of
+    "SizedInt" -> MonadState.lift vsType $ tfp_to_int (sized_int_len_ty ty)
+    "SizedWord" -> MonadState.lift vsType $ tfp_to_int (sized_word_len_ty ty)
+  ; let fname = case name of "SizedInt" -> toSignedId ; "SizedWord" -> toUnsignedId
+  ; return $ AST.PrimFCall $ AST.FCall (AST.NSimple (mkVHDLBasicId fname)) 
+            [Nothing AST.:=>: AST.ADExpr (AST.PrimLit (show (last lits))), Nothing AST.:=>: AST.ADExpr( AST.PrimLit (show len))]
+  }
+
+genFromInteger' (Right name) _ _ = error $ "\nGenerate.genFromInteger': Cannot generate builtin function call assigned to a VHDLName: " ++ show name
+
+

 -- | Generate a generate statement for the builtin function "map"
 genMap :: BuiltinBuilder
 -- | Generate a generate statement for the builtin function "map"
 genMap :: BuiltinBuilder

-genMap (Left res) f [Left mapped_f, Left (Var arg)] =
+genMap (Left res) f [Left mapped_f, Left (Var arg)] = do {

   -- mapped_f must be a CoreExpr (since we can't represent functions as VHDL
   -- expressions). arg must be a CoreExpr (and should be a CoreSyn.Var), since
   -- we must index it (which we couldn't if it was a VHDL Expr, since only
   -- VHDLNames can be indexed).
   -- mapped_f must be a CoreExpr (since we can't represent functions as VHDL
   -- expressions). arg must be a CoreExpr (and should be a CoreSyn.Var), since
   -- we must index it (which we couldn't if it was a VHDL Expr, since only
   -- VHDLNames can be indexed).

-  let
-    -- Setup the generate scheme
-    len         = (tfvec_len . Var.varType) res
-    -- TODO: Use something better than varToString
-    label       = mkVHDLExtId ("mapVector" ++ (varToString res))
-    n_id        = mkVHDLBasicId "n"
-    n_expr      = idToVHDLExpr n_id
-    range       = AST.ToRange (AST.PrimLit "0") (AST.PrimLit $ show (len-1))
-    genScheme   = AST.ForGn n_id range
-
-    -- Create the content of the generate statement: Applying the mapped_f to
-    -- each of the elements in arg, storing to each element in res
-    resname     = mkIndexedName (varToVHDLName res) n_expr
-    argexpr     = vhdlNameToVHDLExpr $ mkIndexedName (varToVHDLName arg) n_expr
-  in do
-    let (CoreSyn.Var real_f, already_mapped_args) = CoreSyn.collectArgs mapped_f
-    let valargs = get_val_args (Var.varType real_f) already_mapped_args
-    app_concsms <- genApplication (Right resname) real_f (map Left valargs ++ [Right argexpr])
+  -- Setup the generate scheme
+  ; len <- MonadState.lift vsType $ tfp_to_int $ (tfvec_len_ty . Var.varType) res
+          -- TODO: Use something better than varToString
+  ; let { label       = mkVHDLExtId ("mapVector" ++ (varToString res))
+        ; n_id        = mkVHDLBasicId "n"
+        ; n_expr      = idToVHDLExpr n_id
+        ; range       = AST.ToRange (AST.PrimLit "0") (AST.PrimLit $ show (len-1))
+        ; genScheme   = AST.ForGn n_id range
+          -- Create the content of the generate statement: Applying the mapped_f to
+          -- each of the elements in arg, storing to each element in res
+        ; resname     = mkIndexedName (varToVHDLName res) n_expr
+        ; argexpr     = vhdlNameToVHDLExpr $ mkIndexedName (varToVHDLName arg) n_expr
+        ; (CoreSyn.Var real_f, already_mapped_args) = CoreSyn.collectArgs mapped_f
+        ; valargs = get_val_args (Var.varType real_f) already_mapped_args
+        } ;
+  ; app_concsms <- genApplication (Right resname) real_f (map Left valargs ++ [Right argexpr])

     -- Return the generate statement
     -- Return the generate statement

-    return [AST.CSGSm $ AST.GenerateSm label genScheme [] app_concsms]
+  ; return [AST.CSGSm $ AST.GenerateSm label genScheme [] app_concsms]
+  }

 
 genMap' (Right name) _ _ = error $ "\nGenerate.genMap': Cannot generate map function call assigned to a VHDLName: " ++ show name
     
 genZipWith :: BuiltinBuilder
 genZipWith = genVarArgs genZipWith'
 genZipWith' :: (Either CoreSyn.CoreBndr AST.VHDLName) -> CoreSyn.CoreBndr -> [Var.Var] -> VHDLSession [AST.ConcSm]
 
 genMap' (Right name) _ _ = error $ "\nGenerate.genMap': Cannot generate map function call assigned to a VHDLName: " ++ show name
     
 genZipWith :: BuiltinBuilder
 genZipWith = genVarArgs genZipWith'
 genZipWith' :: (Either CoreSyn.CoreBndr AST.VHDLName) -> CoreSyn.CoreBndr -> [Var.Var] -> VHDLSession [AST.ConcSm]

-genZipWith' (Left res) f args@[zipped_f, arg1, arg2] =
-  let
-    -- Setup the generate scheme
-    len         = (tfvec_len . Var.varType) res
-    -- TODO: Use something better than varToString
-    label       = mkVHDLExtId ("zipWithVector" ++ (varToString res))
-    n_id        = mkVHDLBasicId "n"
-    n_expr      = idToVHDLExpr n_id
-    range       = AST.ToRange (AST.PrimLit "0") (AST.PrimLit $ show (len-1))
-    genScheme   = AST.ForGn n_id range
-
-    -- Create the content of the generate statement: Applying the zipped_f to
-    -- each of the elements in arg1 and arg2, storing to each element in res
-    resname     = mkIndexedName (varToVHDLName res) n_expr
-    argexpr1    = vhdlNameToVHDLExpr $ mkIndexedName (varToVHDLName arg1) n_expr
-    argexpr2    = vhdlNameToVHDLExpr $ mkIndexedName (varToVHDLName arg2) n_expr
-  in do
-    app_concsms <- genApplication (Right resname) zipped_f [Right argexpr1, Right argexpr2]
+genZipWith' (Left res) f args@[zipped_f, arg1, arg2] = do {
+  -- Setup the generate scheme
+  ; len <- MonadState.lift vsType $ tfp_to_int $ (tfvec_len_ty . Var.varType) res
+          -- TODO: Use something better than varToString
+  ; let { label       = mkVHDLExtId ("zipWithVector" ++ (varToString res))
+        ; n_id        = mkVHDLBasicId "n"
+        ; n_expr      = idToVHDLExpr n_id
+        ; range       = AST.ToRange (AST.PrimLit "0") (AST.PrimLit $ show (len-1))
+        ; genScheme   = AST.ForGn n_id range
+          -- Create the content of the generate statement: Applying the zipped_f to
+          -- each of the elements in arg1 and arg2, storing to each element in res
+        ; resname     = mkIndexedName (varToVHDLName res) n_expr
+        ; argexpr1    = vhdlNameToVHDLExpr $ mkIndexedName (varToVHDLName arg1) n_expr
+        ; argexpr2    = vhdlNameToVHDLExpr $ mkIndexedName (varToVHDLName arg2) n_expr
+        } ;
+  ; app_concsms <- genApplication (Right resname) zipped_f [Right argexpr1, Right argexpr2]

     -- Return the generate functions
     -- Return the generate functions

-    return [AST.CSGSm $ AST.GenerateSm label genScheme [] app_concsms]
+  ; return [AST.CSGSm $ AST.GenerateSm label genScheme [] app_concsms]
+  }

 
 genFoldl :: BuiltinBuilder
 genFoldl = genFold True
 
 genFoldl :: BuiltinBuilder
 genFoldl = genFold True


@@ -144,18 +222,30 @@ genFoldr = genFold False
 
 genFold :: Bool -> BuiltinBuilder
 genFold left = genVarArgs (genFold' left)
 
 genFold :: Bool -> BuiltinBuilder
 genFold left = genVarArgs (genFold' left)

+

 genFold' :: Bool -> (Either CoreSyn.CoreBndr AST.VHDLName) -> CoreSyn.CoreBndr -> [Var.Var] -> VHDLSession [AST.ConcSm]
 genFold' :: Bool -> (Either CoreSyn.CoreBndr AST.VHDLName) -> CoreSyn.CoreBndr -> [Var.Var] -> VHDLSession [AST.ConcSm]

+genFold' left res f args@[folded_f , start ,vec]= do
+  len <- MonadState.lift vsType $ tfp_to_int $ (tfvec_len_ty (Var.varType vec))
+  genFold'' len left res f args
+
+genFold'' :: Int -> Bool -> (Either CoreSyn.CoreBndr AST.VHDLName) -> CoreSyn.CoreBndr -> [Var.Var] -> VHDLSession [AST.ConcSm]

 -- Special case for an empty input vector, just assign start to res
 -- Special case for an empty input vector, just assign start to res

-genFold' left (Left res) _ [_, start, vec] | len == 0 = return [mkUncondAssign (Left res) (varToVHDLExpr start)]
-    where len = (tfvec_len . Var.varType) vec
-genFold' left (Left res) f [folded_f, start, vec] = do
+genFold'' len left (Left res) _ [_, start, vec] | len == 0 = do
+  arg <- MonadState.lift vsType $ varToVHDLExpr start
+  return [mkUncondAssign (Left res) arg]
+    
+genFold'' len left (Left res) f [folded_f, start, vec] = do
+  -- The vector length
+  --len <- MonadState.lift vsType $ tfp_to_int $ (tfvec_len_ty . Var.varType) vec
+  -- An expression for len-1
+  let len_min_expr = (AST.PrimLit $ show (len-1))

   -- evec is (TFVec n), so it still needs an element type
   let (nvec, _) = splitAppTy (Var.varType vec)
   -- Put the type of the start value in nvec, this will be the type of our
   -- temporary vector
   let tmp_ty = Type.mkAppTy nvec (Var.varType start)
   let error_msg = "\nGenerate.genFold': Can not construct temp vector for element type: " ++ pprString tmp_ty 
   -- evec is (TFVec n), so it still needs an element type
   let (nvec, _) = splitAppTy (Var.varType vec)
   -- Put the type of the start value in nvec, this will be the type of our
   -- temporary vector
   let tmp_ty = Type.mkAppTy nvec (Var.varType start)
   let error_msg = "\nGenerate.genFold': Can not construct temp vector for element type: " ++ pprString tmp_ty 

-  tmp_vhdl_ty <- vhdl_ty error_msg tmp_ty
+  tmp_vhdl_ty <- MonadState.lift vsType $ vhdl_ty error_msg tmp_ty

   -- Setup the generate scheme
   let gen_label = mkVHDLExtId ("foldlVector" ++ (varToString vec))
   let block_label = mkVHDLExtId ("foldlVector" ++ (varToString start))
   -- Setup the generate scheme
   let gen_label = mkVHDLExtId ("foldlVector" ++ (varToString vec))
   let block_label = mkVHDLExtId ("foldlVector" ++ (varToString start))


@@ -174,22 +264,19 @@ genFold' left (Left res) f [folded_f, start, vec] = do
   let block = AST.BlockSm block_label [] (AST.PMapAspect []) [tmp_dec] [AST.CSGSm gen_sm, out_assign]
   return [AST.CSBSm block]
   where
   let block = AST.BlockSm block_label [] (AST.PMapAspect []) [tmp_dec] [AST.CSGSm gen_sm, out_assign]
   return [AST.CSBSm block]
   where

-    -- The vector length
-    len         = (tfvec_len . Var.varType) vec

     -- An id for the counter
     n_id = mkVHDLBasicId "n"
     n_cur = idToVHDLExpr n_id
     -- An expression for previous n
     n_prev = if left then (n_cur AST.:-: (AST.PrimLit "1"))
                      else (n_cur AST.:+: (AST.PrimLit "1"))
     -- An id for the counter
     n_id = mkVHDLBasicId "n"
     n_cur = idToVHDLExpr n_id
     -- An expression for previous n
     n_prev = if left then (n_cur AST.:-: (AST.PrimLit "1"))
                      else (n_cur AST.:+: (AST.PrimLit "1"))

-    -- An expression for len-1
-    len_min_expr = (AST.PrimLit $ show (len-1))

     -- An id for the tmp result vector
     tmp_id = mkVHDLBasicId "tmp"
     tmp_name = AST.NSimple tmp_id
     -- Generate parts of the fold
     genFirstCell, genOtherCell :: VHDLSession AST.GenerateSm
     genFirstCell = do
     -- An id for the tmp result vector
     tmp_id = mkVHDLBasicId "tmp"
     tmp_name = AST.NSimple tmp_id
     -- Generate parts of the fold
     genFirstCell, genOtherCell :: VHDLSession AST.GenerateSm
     genFirstCell = do

+      len <- MonadState.lift vsType $ tfp_to_int $ (tfvec_len_ty . Var.varType) vec

       let cond_label = mkVHDLExtId "firstcell"
       -- if n == 0 or n == len-1
       let cond_scheme = AST.IfGn $ n_cur AST.:=: (if left then (AST.PrimLit "0")
       let cond_label = mkVHDLExtId "firstcell"
       -- if n == 0 or n == len-1
       let cond_scheme = AST.IfGn $ n_cur AST.:=: (if left then (AST.PrimLit "0")


@@ -197,7 +284,7 @@ genFold' left (Left res) f [folded_f, start, vec] = do
       -- Output to tmp[current n]
       let resname = mkIndexedName tmp_name n_cur
       -- Input from start
       -- Output to tmp[current n]
       let resname = mkIndexedName tmp_name n_cur
       -- Input from start

-      let argexpr1 = varToVHDLExpr start
+      argexpr1 <- MonadState.lift vsType $ varToVHDLExpr start

       -- Input from vec[current n]
       let argexpr2 = vhdlNameToVHDLExpr $ mkIndexedName (varToVHDLName vec) n_cur
       app_concsms <- genApplication (Right resname) folded_f  ( if left then
       -- Input from vec[current n]
       let argexpr2 = vhdlNameToVHDLExpr $ mkIndexedName (varToVHDLName vec) n_cur
       app_concsms <- genApplication (Right resname) folded_f  ( if left then


@@ -209,6 +296,7 @@ genFold' left (Left res) f [folded_f, start, vec] = do
       return $ AST.GenerateSm cond_label cond_scheme [] app_concsms
 
     genOtherCell = do
       return $ AST.GenerateSm cond_label cond_scheme [] app_concsms
 
     genOtherCell = do

+      len <- MonadState.lift vsType $ tfp_to_int $ (tfvec_len_ty . Var.varType) vec

       let cond_label = mkVHDLExtId "othercell"
       -- if n > 0 or n < len-1
       let cond_scheme = AST.IfGn $ n_cur AST.:/=: (if left then (AST.PrimLit "0")
       let cond_label = mkVHDLExtId "othercell"
       -- if n > 0 or n < len-1
       let cond_scheme = AST.IfGn $ n_cur AST.:/=: (if left then (AST.PrimLit "0")


@@ -231,55 +319,57 @@ genFold' left (Left res) f [folded_f, start, vec] = do
 genZip :: BuiltinBuilder
 genZip = genVarArgs genZip'
 genZip' :: (Either CoreSyn.CoreBndr AST.VHDLName) -> CoreSyn.CoreBndr -> [Var.Var] -> VHDLSession [AST.ConcSm]
 genZip :: BuiltinBuilder
 genZip = genVarArgs genZip'
 genZip' :: (Either CoreSyn.CoreBndr AST.VHDLName) -> CoreSyn.CoreBndr -> [Var.Var] -> VHDLSession [AST.ConcSm]

-genZip' (Left res) f args@[arg1, arg2] =
-  let
+genZip' (Left res) f args@[arg1, arg2] = do {

     -- Setup the generate scheme
     -- Setup the generate scheme

-    len             = (tfvec_len . Var.varType) res
-    -- TODO: Use something better than varToString
-    label           = mkVHDLExtId ("zipVector" ++ (varToString res))
-    n_id            = mkVHDLBasicId "n"
-    n_expr          = idToVHDLExpr n_id
-    range           = AST.ToRange (AST.PrimLit "0") (AST.PrimLit $ show (len-1))
-    genScheme       = AST.ForGn n_id range
-    resname'        = mkIndexedName (varToVHDLName res) n_expr
-    argexpr1        = vhdlNameToVHDLExpr $ mkIndexedName (varToVHDLName arg1) n_expr
-    argexpr2        = vhdlNameToVHDLExpr $ mkIndexedName (varToVHDLName arg2) n_expr
-  in do
-    labels <- getFieldLabels (tfvec_elem (Var.varType res))
-    let resnameA    = mkSelectedName resname' (labels!!0)
-    let resnameB    = mkSelectedName resname' (labels!!1)
-    let resA_assign = mkUncondAssign (Right resnameA) argexpr1
-    let resB_assign = mkUncondAssign (Right resnameB) argexpr2
+  ; len <- MonadState.lift vsType $ tfp_to_int $ (tfvec_len_ty . Var.varType) res
+          -- TODO: Use something better than varToString
+  ; let { label           = mkVHDLExtId ("zipVector" ++ (varToString res))
+        ; n_id            = mkVHDLBasicId "n"
+        ; n_expr          = idToVHDLExpr n_id
+        ; range           = AST.ToRange (AST.PrimLit "0") (AST.PrimLit $ show (len-1))
+        ; genScheme       = AST.ForGn n_id range
+        ; resname'        = mkIndexedName (varToVHDLName res) n_expr
+        ; argexpr1        = vhdlNameToVHDLExpr $ mkIndexedName (varToVHDLName arg1) n_expr
+        ; argexpr2        = vhdlNameToVHDLExpr $ mkIndexedName (varToVHDLName arg2) n_expr
+        } ; 
+  ; labels <- MonadState.lift vsType $ getFieldLabels (tfvec_elem (Var.varType res))
+  ; let { resnameA    = mkSelectedName resname' (labels!!0)
+        ; resnameB    = mkSelectedName resname' (labels!!1)
+        ; resA_assign = mkUncondAssign (Right resnameA) argexpr1
+        ; resB_assign = mkUncondAssign (Right resnameB) argexpr2
+        } ;

     -- Return the generate functions
     -- Return the generate functions

-    return [AST.CSGSm $ AST.GenerateSm label genScheme [] [resA_assign,resB_assign]]
+  ; return [AST.CSGSm $ AST.GenerateSm label genScheme [] [resA_assign,resB_assign]]
+  }

     
 -- | Generate a generate statement for the builtin function "unzip"
 genUnzip :: BuiltinBuilder
 genUnzip = genVarArgs genUnzip'
 genUnzip' :: (Either CoreSyn.CoreBndr AST.VHDLName) -> CoreSyn.CoreBndr -> [Var.Var] -> VHDLSession [AST.ConcSm]
     
 -- | Generate a generate statement for the builtin function "unzip"
 genUnzip :: BuiltinBuilder
 genUnzip = genVarArgs genUnzip'
 genUnzip' :: (Either CoreSyn.CoreBndr AST.VHDLName) -> CoreSyn.CoreBndr -> [Var.Var] -> VHDLSession [AST.ConcSm]

-genUnzip' (Left res) f args@[arg] =
-  let
+genUnzip' (Left res) f args@[arg] = do {

     -- Setup the generate scheme
     -- Setup the generate scheme

-    len             = (tfvec_len . Var.varType) arg
+  ; len <- MonadState.lift vsType $ tfp_to_int $ (tfvec_len_ty . Var.varType) arg

     -- TODO: Use something better than varToString
     -- TODO: Use something better than varToString

-    label           = mkVHDLExtId ("unzipVector" ++ (varToString res))
-    n_id            = mkVHDLBasicId "n"
-    n_expr          = idToVHDLExpr n_id
-    range           = AST.ToRange (AST.PrimLit "0") (AST.PrimLit $ show (len-1))
-    genScheme       = AST.ForGn n_id range
-    resname'        = varToVHDLName res
-    argexpr'        = mkIndexedName (varToVHDLName arg) n_expr
-  in do
-    reslabels <- getFieldLabels (Var.varType res)
-    arglabels <- getFieldLabels (tfvec_elem (Var.varType arg))
-    let resnameA    = mkIndexedName (mkSelectedName resname' (reslabels!!0)) n_expr
-    let resnameB    = mkIndexedName (mkSelectedName resname' (reslabels!!1)) n_expr
-    let argexprA    = vhdlNameToVHDLExpr $ mkSelectedName argexpr' (arglabels!!0)
-    let argexprB    = vhdlNameToVHDLExpr $ mkSelectedName argexpr' (arglabels!!1)
-    let resA_assign = mkUncondAssign (Right resnameA) argexprA
-    let resB_assign = mkUncondAssign (Right resnameB) argexprB
+  ; let { label           = mkVHDLExtId ("unzipVector" ++ (varToString res))
+        ; n_id            = mkVHDLBasicId "n"
+        ; n_expr          = idToVHDLExpr n_id
+        ; range           = AST.ToRange (AST.PrimLit "0") (AST.PrimLit $ show (len-1))
+        ; genScheme       = AST.ForGn n_id range
+        ; resname'        = varToVHDLName res
+        ; argexpr'        = mkIndexedName (varToVHDLName arg) n_expr
+        } ;
+  ; reslabels <- MonadState.lift vsType $ getFieldLabels (Var.varType res)
+  ; arglabels <- MonadState.lift vsType $ getFieldLabels (tfvec_elem (Var.varType arg))
+  ; let { resnameA    = mkIndexedName (mkSelectedName resname' (reslabels!!0)) n_expr
+        ; resnameB    = mkIndexedName (mkSelectedName resname' (reslabels!!1)) n_expr
+        ; argexprA    = vhdlNameToVHDLExpr $ mkSelectedName argexpr' (arglabels!!0)
+        ; argexprB    = vhdlNameToVHDLExpr $ mkSelectedName argexpr' (arglabels!!1)
+        ; resA_assign = mkUncondAssign (Right resnameA) argexprA
+        ; resB_assign = mkUncondAssign (Right resnameB) argexprB
+        } ;

     -- Return the generate functions
     -- Return the generate functions

-    return [AST.CSGSm $ AST.GenerateSm label genScheme [] [resA_assign,resB_assign]]
+  ; return [AST.CSGSm $ AST.GenerateSm label genScheme [] [resA_assign,resB_assign]]
+  }

 
 genCopy :: BuiltinBuilder 
 genCopy = genVarArgs genCopy'
 
 genCopy :: BuiltinBuilder 
 genCopy = genVarArgs genCopy'


@@ -295,28 +385,28 @@ genCopy' (Left res) f args@[arg] =
 genConcat :: BuiltinBuilder
 genConcat = genVarArgs genConcat'
 genConcat' :: (Either CoreSyn.CoreBndr AST.VHDLName) -> CoreSyn.CoreBndr -> [Var.Var] -> VHDLSession [AST.ConcSm]
 genConcat :: BuiltinBuilder
 genConcat = genVarArgs genConcat'
 genConcat' :: (Either CoreSyn.CoreBndr AST.VHDLName) -> CoreSyn.CoreBndr -> [Var.Var] -> VHDLSession [AST.ConcSm]

-genConcat' (Left res) f args@[arg] =
-  let
+genConcat' (Left res) f args@[arg] = do {

     -- Setup the generate scheme
     -- Setup the generate scheme

-    len1        = (tfvec_len . Var.varType) arg
-    (_, nvec)   = splitAppTy (Var.varType arg)
-    len2        = tfvec_len nvec
-    -- TODO: Use something better than varToString
-    label       = mkVHDLExtId ("concatVector" ++ (varToString res))
-    n_id        = mkVHDLBasicId "n"
-    n_expr      = idToVHDLExpr n_id
-    fromRange   = n_expr AST.:*: (AST.PrimLit $ show len2)
-    genScheme   = AST.ForGn n_id range
-    -- Create the content of the generate statement: Applying the mapped_f to
-    -- each of the elements in arg, storing to each element in res
-    toRange     = (n_expr AST.:*: (AST.PrimLit $ show len2)) AST.:+: (AST.PrimLit $ show (len2-1))
-    range       = AST.ToRange (AST.PrimLit "0") (AST.PrimLit $ show (len1-1))
-    resname     = vecSlice fromRange toRange
-    argexpr     = vhdlNameToVHDLExpr $ mkIndexedName (varToVHDLName arg) n_expr
-    out_assign  = mkUncondAssign (Right resname) argexpr
-  in
+  ; len1 <- MonadState.lift vsType $ tfp_to_int $ (tfvec_len_ty . Var.varType) arg
+  ; let (_, nvec) = splitAppTy (Var.varType arg)
+  ; len2 <- MonadState.lift vsType $ tfp_to_int $ tfvec_len_ty nvec
+          -- TODO: Use something better than varToString
+  ; let { label       = mkVHDLExtId ("concatVector" ++ (varToString res))
+        ; n_id        = mkVHDLBasicId "n"
+        ; n_expr      = idToVHDLExpr n_id
+        ; fromRange   = n_expr AST.:*: (AST.PrimLit $ show len2)
+        ; genScheme   = AST.ForGn n_id range
+          -- Create the content of the generate statement: Applying the mapped_f to
+          -- each of the elements in arg, storing to each element in res
+        ; toRange     = (n_expr AST.:*: (AST.PrimLit $ show len2)) AST.:+: (AST.PrimLit $ show (len2-1))
+        ; range       = AST.ToRange (AST.PrimLit "0") (AST.PrimLit $ show (len1-1))
+        ; resname     = vecSlice fromRange toRange
+        ; argexpr     = vhdlNameToVHDLExpr $ mkIndexedName (varToVHDLName arg) n_expr
+        ; out_assign  = mkUncondAssign (Right resname) argexpr
+        } ;

     -- Return the generate statement
     -- Return the generate statement

-    return [AST.CSGSm $ AST.GenerateSm label genScheme [] [out_assign]]
+  ; return [AST.CSGSm $ AST.GenerateSm label genScheme [] [out_assign]]
+  }

   where
     vecSlice init last =  AST.NSlice (AST.SliceName (varToVHDLName res) 
                             (AST.ToRange init last))
   where
     vecSlice init last =  AST.NSlice (AST.SliceName (varToVHDLName res) 
                             (AST.ToRange init last))


@@ -335,18 +425,28 @@ genGenerate = genIterateOrGenerate False
 
 genIterateOrGenerate :: Bool -> BuiltinBuilder
 genIterateOrGenerate iter = genVarArgs (genIterateOrGenerate' iter)
 
 genIterateOrGenerate :: Bool -> BuiltinBuilder
 genIterateOrGenerate iter = genVarArgs (genIterateOrGenerate' iter)

+

 genIterateOrGenerate' :: Bool -> (Either CoreSyn.CoreBndr AST.VHDLName) -> CoreSyn.CoreBndr -> [Var.Var] -> VHDLSession [AST.ConcSm]
 genIterateOrGenerate' :: Bool -> (Either CoreSyn.CoreBndr AST.VHDLName) -> CoreSyn.CoreBndr -> [Var.Var] -> VHDLSession [AST.ConcSm]

+genIterateOrGenerate' iter (Left res) f args = do
+  len <- MonadState.lift vsType $ tfp_to_int ((tfvec_len_ty . Var.varType) res)
+  genIterateOrGenerate'' len iter (Left res) f args
+
+genIterateOrGenerate'' :: Int -> Bool -> (Either CoreSyn.CoreBndr AST.VHDLName) -> CoreSyn.CoreBndr -> [Var.Var] -> VHDLSession [AST.ConcSm]

 -- Special case for an empty input vector, just assign start to res
 -- Special case for an empty input vector, just assign start to res

-genIterateOrGenerate' iter (Left res) _ [app_f, start] | len == 0 = return [mkUncondAssign (Left res) (AST.PrimLit "\"\"")]
-    where len = (tfvec_len . Var.varType) res
-genIterateOrGenerate' iter (Left res) f [app_f, start] = do
+genIterateOrGenerate'' len iter (Left res) _ [app_f, start] | len == 0 = return [mkUncondAssign (Left res) (AST.PrimLit "\"\"")]
+
+genIterateOrGenerate'' len iter (Left res) f [app_f, start] = do
+  -- The vector length
+  -- len <- MonadState.lift vsType $ tfp_to_int ((tfvec_len_ty . Var.varType) res)
+  -- An expression for len-1
+  let len_min_expr = (AST.PrimLit $ show (len-1))

   -- -- evec is (TFVec n), so it still needs an element type
   -- let (nvec, _) = splitAppTy (Var.varType vec)
   -- -- Put the type of the start value in nvec, this will be the type of our
   -- -- temporary vector
   let tmp_ty = Var.varType res
   let error_msg = "\nGenerate.genFold': Can not construct temp vector for element type: " ++ pprString tmp_ty 
   -- -- evec is (TFVec n), so it still needs an element type
   -- let (nvec, _) = splitAppTy (Var.varType vec)
   -- -- Put the type of the start value in nvec, this will be the type of our
   -- -- temporary vector
   let tmp_ty = Var.varType res
   let error_msg = "\nGenerate.genFold': Can not construct temp vector for element type: " ++ pprString tmp_ty 

-  tmp_vhdl_ty <- vhdl_ty error_msg tmp_ty
+  tmp_vhdl_ty <- MonadState.lift vsType $ vhdl_ty error_msg tmp_ty

   -- Setup the generate scheme
   let gen_label = mkVHDLExtId ("iterateVector" ++ (varToString start))
   let block_label = mkVHDLExtId ("iterateVector" ++ (varToString res))
   -- Setup the generate scheme
   let gen_label = mkVHDLExtId ("iterateVector" ++ (varToString start))
   let block_label = mkVHDLExtId ("iterateVector" ++ (varToString res))


@@ -362,15 +462,11 @@ genIterateOrGenerate' iter (Left res) f [app_f, start] = do
   let block = AST.BlockSm block_label [] (AST.PMapAspect []) [tmp_dec] [AST.CSGSm gen_sm, out_assign]
   return [AST.CSBSm block]
   where
   let block = AST.BlockSm block_label [] (AST.PMapAspect []) [tmp_dec] [AST.CSGSm gen_sm, out_assign]
   return [AST.CSBSm block]
   where

-    -- The vector length
-    len = (tfvec_len . Var.varType) res

     -- An id for the counter
     n_id = mkVHDLBasicId "n"
     n_cur = idToVHDLExpr n_id
     -- An expression for previous n
     n_prev = n_cur AST.:-: (AST.PrimLit "1")
     -- An id for the counter
     n_id = mkVHDLBasicId "n"
     n_cur = idToVHDLExpr n_id
     -- An expression for previous n
     n_prev = n_cur AST.:-: (AST.PrimLit "1")

-    -- An expression for len-1
-    len_min_expr = (AST.PrimLit $ show (len-1))

     -- An id for the tmp result vector
     tmp_id = mkVHDLBasicId "tmp"
     tmp_name = AST.NSimple tmp_id
     -- An id for the tmp result vector
     tmp_id = mkVHDLBasicId "tmp"
     tmp_name = AST.NSimple tmp_id


@@ -383,7 +479,7 @@ genIterateOrGenerate' iter (Left res) f [app_f, start] = do
       -- Output to tmp[current n]
       let resname = mkIndexedName tmp_name n_cur
       -- Input from start
       -- Output to tmp[current n]
       let resname = mkIndexedName tmp_name n_cur
       -- Input from start

-      let argexpr = varToVHDLExpr start
+      argexpr <- MonadState.lift vsType $ varToVHDLExpr start

       let startassign = mkUncondAssign (Right resname) argexpr
       app_concsms <- genApplication (Right resname) app_f  [Right argexpr]
       -- Return the conditional generate part
       let startassign = mkUncondAssign (Right resname) argexpr
       app_concsms <- genApplication (Right resname) app_f  [Right argexpr]
       -- Return the conditional generate part


@@ -414,14 +510,15 @@ genApplication ::
   -> CoreSyn.CoreBndr -- ^ The function to apply
   -> [Either CoreSyn.CoreExpr AST.Expr] -- ^ The arguments to apply
   -> VHDLSession [AST.ConcSm] -- ^ The resulting concurrent statements
   -> CoreSyn.CoreBndr -- ^ The function to apply
   -> [Either CoreSyn.CoreExpr AST.Expr] -- ^ The arguments to apply
   -> VHDLSession [AST.ConcSm] -- ^ The resulting concurrent statements

-genApplication dst f args =
+genApplication dst f args = do

   case Var.globalIdVarDetails f of
     IdInfo.DataConWorkId dc -> case dst of
       -- It's a datacon. Create a record from its arguments.
       Left bndr -> do
         -- We have the bndr, so we can get at the type
   case Var.globalIdVarDetails f of
     IdInfo.DataConWorkId dc -> case dst of
       -- It's a datacon. Create a record from its arguments.
       Left bndr -> do
         -- We have the bndr, so we can get at the type

-        labels <- getFieldLabels (Var.varType bndr)
-        return $ zipWith mkassign labels $ map (either exprToVHDLExpr id) args
+        labels <- MonadState.lift vsType $ getFieldLabels (Var.varType bndr)
+        args' <- eitherCoreOrExprArgs args
+        return $ zipWith mkassign labels $ args'

         where
           mkassign :: AST.VHDLId -> AST.Expr -> AST.ConcSm
           mkassign label arg =
         where
           mkassign :: AST.VHDLId -> AST.Expr -> AST.ConcSm
           mkassign label arg =


@@ -439,23 +536,41 @@ genApplication dst f args =
           if length args == arg_count then
             builder dst f args
           else
           if length args == arg_count then
             builder dst f args
           else

-            error $ "\nGenerate.genApplication: Incorrect number of arguments to builtin function: " ++ pprString f ++ " Args: " ++ show args
-        Nothing -> error $ "\nGenerate.genApplication: Using function from another module that is not a known builtin: " ++ pprString f
+            error $ "\nGenerate.genApplication(VanillaGlobal): Incorrect number of arguments to builtin function: " ++ pprString f ++ " Args: " ++ show args
+        Nothing -> error $ "\nGenerate.genApplication(VanillaGlobal): Using function from another module that is not a known builtin: " ++ pprString f

     IdInfo.NotGlobalId -> do
       signatures <- getA vsSignatures
       -- This is a local id, so it should be a function whose definition we
       -- have and which can be turned into a component instantiation.
     IdInfo.NotGlobalId -> do
       signatures <- getA vsSignatures
       -- This is a local id, so it should be a function whose definition we
       -- have and which can be turned into a component instantiation.

-      let  
-        signature = Maybe.fromMaybe 
-          (error $ "\nGenerate.genApplication: Using function '" ++ (varToString f) ++ "' without signature? This should not happen!") 
-          (Map.lookup f signatures)
-        entity_id = ent_id signature
-        -- TODO: Using show here isn't really pretty, but we'll need some
-        -- unique-ish value...
-        label = "comp_ins_" ++ (either show prettyShow) dst
-        portmaps = mkAssocElems (map (either exprToVHDLExpr id) args) ((either varToVHDLName id) dst) signature
-        in
+      case (Map.lookup f signatures) of
+        Just signature -> do
+          args' <- eitherCoreOrExprArgs args
+          -- We have a signature, this is a top level binding. Generate a
+          -- component instantiation.
+          let entity_id = ent_id signature
+          -- TODO: Using show here isn't really pretty, but we'll need some
+          -- unique-ish value...
+          let label = "comp_ins_" ++ (either show prettyShow) dst
+          let portmaps = mkAssocElems args' ((either varToVHDLName id) dst) signature

           return [mkComponentInst label entity_id portmaps]
           return [mkComponentInst label entity_id portmaps]

+        Nothing -> do
+          -- No signature, so this must be a local variable reference. It
+          -- should have a representable type (and thus, no arguments) and a
+          -- signal should be generated for it. Just generate an
+          -- unconditional assignment here.
+          f' <- MonadState.lift vsType $ varToVHDLExpr f
+          return $ [mkUncondAssign dst f']
+            
+    IdInfo.ClassOpId cls -> do
+      -- FIXME: Not looking for what instance this class op is called for
+      -- Is quite stupid of course.
+      case (Map.lookup (varToString f) globalNameTable) of
+        Just (arg_count, builder) ->
+          if length args == arg_count then
+            builder dst f args
+          else
+            error $ "\nGenerate.genApplication(ClassOpId): Incorrect number of arguments to builtin function: " ++ pprString f ++ " Args: " ++ show args
+        Nothing -> error $ "\nGenerate.genApplication(ClassOpId): Using function from another module that is not a known builtin: " ++ pprString f

     details -> error $ "\nGenerate.genApplication: Calling unsupported function " ++ pprString f ++ " with GlobalIdDetails " ++ pprString details
 
 -----------------------------------------------------------------------------
     details -> error $ "\nGenerate.genApplication: Calling unsupported function " ++ pprString f ++ " with GlobalIdDetails " ++ pprString details
 
 -----------------------------------------------------------------------------


@@ -464,7 +579,7 @@ genApplication dst f args =
 
 -- Returns the VHDLId of the vector function with the given name for the given
 -- element type. Generates -- this function if needed.
 
 -- Returns the VHDLId of the vector function with the given name for the given
 -- element type. Generates -- this function if needed.

-vectorFunId :: Type.Type -> String -> VHDLSession AST.VHDLId
+vectorFunId :: Type.Type -> String -> TypeSession AST.VHDLId

 vectorFunId el_ty fname = do
   let error_msg = "\nGenerate.vectorFunId: Can not construct vector function for element: " ++ pprString el_ty
   elemTM <- vhdl_ty error_msg el_ty
 vectorFunId el_ty fname = do
   let error_msg = "\nGenerate.vectorFunId: Can not construct vector function for element: " ++ pprString el_ty
   elemTM <- vhdl_ty error_msg el_ty


@@ -912,4 +1027,11 @@ globalNameTable = Map.fromList
   , (hwandId          , (2, genOperator2 AST.And    ) )
   , (hworId           , (2, genOperator2 AST.Or     ) )
   , (hwnotId          , (1, genOperator1 AST.Not    ) )
   , (hwandId          , (2, genOperator2 AST.And    ) )
   , (hworId           , (2, genOperator2 AST.Or     ) )
   , (hwnotId          , (1, genOperator1 AST.Not    ) )

+  , (plusId           , (2, genOperator2 (AST.:+:)  ) )
+  , (timesId          , (2, genOperator2 (AST.:*:)  ) )
+  , (negateId         , (1, genNegation             ) )
+  , (minusId          , (2, genOperator2 (AST.:-:)  ) )
+  , (fromSizedWordId  , (1, genFromSizedWord        ) )
+  , (fromIntegerId    , (1, genFromInteger          ) )
+  , (resizeId         , (1, genResize               ) )

   ]
   ]