Moved to new GHC API (6.11). Also use vhdl package for the VHDL AST

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

diff --git a/Generate.hs b/Generate.hs
index bd7b482714438a63834234d95433a643b5a08248..8dc7a0aaaef50b0dacc7bc0be63df0f0d5a28013 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,12 +7,14 @@ 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.MonadState as MonadState
 import Debug.Trace
 
 -- ForSyDe
 import Data.Accessor
 import Data.Accessor.MonadState as MonadState
 import Debug.Trace
 
 -- ForSyDe

-import qualified ForSyDe.Backend.VHDL.AST as AST
+import qualified Language.VHDL.AST as AST

 
 -- GHC API
 import CoreSyn
 
 -- GHC API
 import CoreSyn


@@ -18,6 +22,8 @@ import Type
 import qualified Var
 import qualified IdInfo
 import qualified Literal
 import qualified Var
 import qualified IdInfo
 import qualified Literal

+import qualified Name
+import qualified TyCon

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


@@ -32,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 ::


@@ -83,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 


@@ -105,69 +125,94 @@ genFromSizedWord' (Left res) f args = do
              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
 
              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
 -- 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 args = do
-  return $ AST.PrimLit (pprString (last args))
+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
 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

-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


@@ -177,11 +222,23 @@ 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
   -- 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


@@ -207,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")


@@ -230,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


@@ -242,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")


@@ -264,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 <- MonadState.lift vsType $ 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 <- 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
-    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'


@@ -328,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))


@@ -368,11 +425,21 @@ 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
   -- -- 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


@@ -395,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


@@ -416,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


@@ -447,59 +510,69 @@ 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 =
-  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 <- MonadState.lift vsType $ getFieldLabels (Var.varType bndr)
-        return $ zipWith mkassign labels $ map (either exprToVHDLExpr id) args
-        where
-          mkassign :: AST.VHDLId -> AST.Expr -> AST.ConcSm
-          mkassign label arg =
-            let sel_name = mkSelectedName ((either varToVHDLName id) dst) label in
-            mkUncondAssign (Right sel_name) arg
-      Right _ -> error $ "\nGenerate.genApplication: Can't generate dataconstructor application without an original binder"
-    IdInfo.VanillaGlobal -> do
-      -- It's a global value imported from elsewhere. These can be builtin
-      -- functions. Look up the function name in the name table and execute
-      -- the associated builder if there is any and the argument count matches
-      -- (this should always be the case if it typechecks, but just to be
-      -- sure...).
-      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(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
+genApplication dst f args = do
+  case Var.isGlobalId f of
+    False -> 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.
       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]

-    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
+        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']
+    True ->
+      case Var.idDetails 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 <- 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 =
+                let sel_name = mkSelectedName ((either varToVHDLName id) dst) label in
+                mkUncondAssign (Right sel_name) arg
+          Right _ -> error $ "\nGenerate.genApplication: Can't generate dataconstructor application without an original binder"
+        IdInfo.VanillaId -> do
+          -- It's a global value imported from elsewhere. These can be builtin
+          -- functions. Look up the function name in the name table and execute
+          -- the associated builder if there is any and the argument count matches
+          -- (this should always be the case if it typechecks, but just to be
+          -- sure...).
+          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(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.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

 
 -----------------------------------------------------------------------------
 -- Functions to generate functions dealing with vectors.
 
 -----------------------------------------------------------------------------
 -- Functions to generate functions dealing with vectors.


@@ -957,8 +1030,9 @@ globalNameTable = Map.fromList
   , (hwnotId          , (1, genOperator1 AST.Not    ) )
   , (plusId           , (2, genOperator2 (AST.:+:)  ) )
   , (timesId          , (2, genOperator2 (AST.:*:)  ) )
   , (hwnotId          , (1, genOperator1 AST.Not    ) )
   , (plusId           , (2, genOperator2 (AST.:+:)  ) )
   , (timesId          , (2, genOperator2 (AST.:*:)  ) )

-  , (negateId         , (1, genOperator1 AST.Not    ) )
+  , (negateId         , (1, genNegation             ) )

   , (minusId          , (2, genOperator2 (AST.:-:)  ) )
   , (fromSizedWordId  , (1, genFromSizedWord        ) )
   , (fromIntegerId    , (1, genFromInteger          ) )
   , (minusId          , (2, genOperator2 (AST.:-:)  ) )
   , (fromSizedWordId  , (1, genFromSizedWord        ) )
   , (fromIntegerId    , (1, genFromInteger          ) )

+  , (resizeId         , (1, genResize               ) )

   ]
   ]