Add genCoreArgs wrapper to VHDL.Generate.

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

diff --git a/cλash/CLasH/VHDL/Generate.hs b/cλash/CLasH/VHDL/Generate.hs
index ae4769b3842bbec5850dfe5d7fd875ac94cee797..07cf0e89864022936af27fa5c9f0fd6cb6719ecc 100644 (file)
--- a/cλash/CLasH/VHDL/Generate.hs
+++ b/cλash/CLasH/VHDL/Generate.hs
@@ -6,11 +6,9 @@ import qualified Data.Map as Map
 import qualified Control.Monad as Monad
 import qualified Maybe
 import qualified Data.Either as Either
 import qualified Control.Monad as Monad
 import qualified Maybe
 import qualified Data.Either as Either

-import Data.Accessor
-import Data.Accessor.MonadState as MonadState
-import Debug.Trace
+import qualified Data.Accessor.Monad.Trans.State as MonadState

 
 

--- ForSyDe
+-- VHDL Imports

 import qualified Language.VHDL.AST as AST
 
 -- GHC API
 import qualified Language.VHDL.AST as AST
 
 -- GHC API


@@ -28,7 +26,7 @@ import CLasH.Translator.TranslatorTypes
 import CLasH.VHDL.Constants
 import CLasH.VHDL.VHDLTypes
 import CLasH.VHDL.VHDLTools
 import CLasH.VHDL.Constants
 import CLasH.VHDL.VHDLTypes
 import CLasH.VHDL.VHDLTools

-import CLasH.Utils as Utils
+import CLasH.Utils

 import CLasH.Utils.Core.CoreTools
 import CLasH.Utils.Pretty
 import qualified CLasH.Normalize as Normalize
 import CLasH.Utils.Core.CoreTools
 import CLasH.Utils.Pretty
 import qualified CLasH.Normalize as Normalize


@@ -42,17 +40,17 @@ getEntity ::
   CoreSyn.CoreBndr
   -> TranslatorSession Entity -- ^ The resulting entity
 
   CoreSyn.CoreBndr
   -> TranslatorSession Entity -- ^ The resulting entity
 

-getEntity fname = Utils.makeCached fname tsEntities $ do
-      expr <- Normalize.getNormalized fname
-      -- Strip off lambda's, these will be arguments
-      let (args, letexpr) = CoreSyn.collectBinders expr
+getEntity fname = makeCached fname tsEntities $ do
+      expr <- Normalize.getNormalized False fname
+      -- Split the normalized expression
+      let (args, binds, res) = Normalize.splitNormalized expr

       -- Generate ports for all non-empty types
       args' <- catMaybesM $ mapM mkMap args
       -- Generate ports for all non-empty types
       args' <- catMaybesM $ mapM mkMap args

-      -- There must be a let at top level 
-      let (CoreSyn.Let binds (CoreSyn.Var res)) = letexpr

       -- TODO: Handle Nothing
       res' <- mkMap res
       -- TODO: Handle Nothing
       res' <- mkMap res

-      let vhdl_id = mkVHDLBasicId $ varToString fname ++ "_" ++ varToStringUniq fname
+      count <- MonadState.get tsEntityCounter 
+      let vhdl_id = mkVHDLBasicId $ varToString fname ++ "Component_" ++ show count
+      MonadState.set tsEntityCounter (count + 1)

       let ent_decl = createEntityAST vhdl_id args' res'
       let signature = Entity vhdl_id args' res' ent_decl
       return signature
       let ent_decl = createEntityAST vhdl_id args' res'
       let signature = Entity vhdl_id args' res' ent_decl
       return signature


@@ -71,7 +69,7 @@ getEntity fname = Utils.makeCached fname tsEntities $ do
         ty = Var.varType bndr
         error_msg = "\nVHDL.createEntity.mkMap: Can not create entity: " ++ pprString fname ++ "\nbecause no type can be created for port: " ++ pprString bndr 
       in do
         ty = Var.varType bndr
         error_msg = "\nVHDL.createEntity.mkMap: Can not create entity: " ++ pprString fname ++ "\nbecause no type can be created for port: " ++ pprString bndr 
       in do

-        type_mark_maybe <- MonadState.lift tsType $ vhdl_ty error_msg ty
+        type_mark_maybe <- MonadState.lift tsType $ vhdlTy error_msg ty

         case type_mark_maybe of 
           Just type_mark -> return $ Just (id, type_mark)
           Nothing -> return Nothing
         case type_mark_maybe of 
           Just type_mark -> return $ Just (id, type_mark)
           Nothing -> return Nothing


@@ -90,9 +88,10 @@ createEntityAST vhdl_id args res =
     -- Create a basic Id, since VHDL doesn't grok filenames with extended Ids.
     ports = map (mkIfaceSigDec AST.In) args
               ++ (Maybe.maybeToList res_port)
     -- Create a basic Id, since VHDL doesn't grok filenames with extended Ids.
     ports = map (mkIfaceSigDec AST.In) args
               ++ (Maybe.maybeToList res_port)

-              ++ [clk_port]
+              ++ [clk_port,resetn_port]

     -- Add a clk port if we have state
     clk_port = AST.IfaceSigDec clockId AST.In std_logicTM
     -- Add a clk port if we have state
     clk_port = AST.IfaceSigDec clockId AST.In std_logicTM

+    resetn_port = AST.IfaceSigDec resetId AST.In std_logicTM

     res_port = fmap (mkIfaceSigDec AST.Out) res
 
 -- | Create a port declaration
     res_port = fmap (mkIfaceSigDec AST.Out) res
 
 -- | Create a port declaration


@@ -109,47 +108,60 @@ getArchitecture ::
   -> TranslatorSession (Architecture, [CoreSyn.CoreBndr])
   -- ^ The architecture for this function
 
   -> TranslatorSession (Architecture, [CoreSyn.CoreBndr])
   -- ^ The architecture for this function
 

-getArchitecture fname = Utils.makeCached fname tsArchitectures $ do
-  expr <- Normalize.getNormalized fname
+getArchitecture fname = makeCached fname tsArchitectures $ do
+  expr <- Normalize.getNormalized False fname
+  -- Split the normalized expression
+  let (args, binds, res) = Normalize.splitNormalized expr
+  
+  -- Get the entity for this function

   signature <- getEntity fname
   let entity_id = ent_id signature
   signature <- getEntity fname
   let entity_id = ent_id signature

-  -- Strip off lambda's, these will be arguments
-  let (args, letexpr) = CoreSyn.collectBinders expr
-  -- There must be a let at top level 
-  let (CoreSyn.Let (CoreSyn.Rec binds) (CoreSyn.Var res)) = letexpr

 
   -- Create signal declarations for all binders in the let expression, except
   -- for the output port (that will already have an output port declared in
   -- the entity).
   sig_dec_maybes <- mapM (mkSigDec . fst) (filter ((/=res).fst) binds)
 
   -- Create signal declarations for all binders in the let expression, except
   -- for the output port (that will already have an output port declared in
   -- the entity).
   sig_dec_maybes <- mapM (mkSigDec . fst) (filter ((/=res).fst) binds)

-  let sig_decs = Maybe.catMaybes $ sig_dec_maybes
+  let sig_decs = Maybe.catMaybes sig_dec_maybes

   -- Process each bind, resulting in info about state variables and concurrent
   -- statements.
   (state_vars, sms) <- Monad.mapAndUnzipM dobind binds
   let (in_state_maybes, out_state_maybes) = unzip state_vars
   let (statementss, used_entitiess) = unzip sms
   -- Process each bind, resulting in info about state variables and concurrent
   -- statements.
   (state_vars, sms) <- Monad.mapAndUnzipM dobind binds
   let (in_state_maybes, out_state_maybes) = unzip state_vars
   let (statementss, used_entitiess) = unzip sms

+  -- Get initial state, if it's there
+  initSmap <- MonadState.get tsInitStates
+  let init_state = Map.lookup fname initSmap

   -- Create a state proc, if needed
   -- Create a state proc, if needed

-  let state_proc = case (Maybe.catMaybes in_state_maybes, Maybe.catMaybes out_state_maybes) of
-        ([in_state], [out_state]) -> [AST.CSPSm $ mkStateProcSm (in_state, out_state)]
-        ([], []) -> []
-        (ins, outs) -> error $ "Weird use of state in " ++ show fname ++ ". In: " ++ show ins ++ " Out: " ++ show outs
+  (state_proc, resbndr) <- case (Maybe.catMaybes in_state_maybes, Maybe.catMaybes out_state_maybes, init_state) of
+        ([in_state], [out_state], Nothing) -> do 
+          nonEmpty <- hasNonEmptyType in_state
+          if nonEmpty 
+            then error ("No initial state defined for: " ++ show fname) 
+            else return ([],[])
+        ([in_state], [out_state], Just resetval) -> do
+          nonEmpty <- hasNonEmptyType in_state
+          if nonEmpty 
+            then mkStateProcSm (in_state, out_state, resetval)
+            else error ("Initial state defined for function with only substate: " ++ show fname)
+        ([], [], Just _) -> error $ "Initial state defined for state-less function: " ++ show fname
+        ([], [], Nothing) -> return ([],[])
+        (ins, outs, res) -> error $ "Weird use of state in " ++ show fname ++ ". In: " ++ show ins ++ " Out: " ++ show outs

   -- Join the create statements and the (optional) state_proc
   let statements = concat statementss ++ state_proc
   -- Create the architecture
   let arch = AST.ArchBody (mkVHDLBasicId "structural") (AST.NSimple entity_id) (map AST.BDISD sig_decs) statements
   -- Join the create statements and the (optional) state_proc
   let statements = concat statementss ++ state_proc
   -- Create the architecture
   let arch = AST.ArchBody (mkVHDLBasicId "structural") (AST.NSimple entity_id) (map AST.BDISD sig_decs) statements

-  let used_entities = concat used_entitiess
+  let used_entities = (concat used_entitiess) ++ resbndr

   return (arch, used_entities)
   where
     dobind :: (CoreSyn.CoreBndr, CoreSyn.CoreExpr) -- ^ The bind to process
               -> TranslatorSession ((Maybe CoreSyn.CoreBndr, Maybe CoreSyn.CoreBndr), ([AST.ConcSm], [CoreSyn.CoreBndr]))
               -- ^ ((Input state variable, output state variable), (statements, used entities))
     -- newtype unpacking is just a cast
   return (arch, used_entities)
   where
     dobind :: (CoreSyn.CoreBndr, CoreSyn.CoreExpr) -- ^ The bind to process
               -> TranslatorSession ((Maybe CoreSyn.CoreBndr, Maybe CoreSyn.CoreBndr), ([AST.ConcSm], [CoreSyn.CoreBndr]))
               -- ^ ((Input state variable, output state variable), (statements, used entities))
     -- newtype unpacking is just a cast

-    dobind (bndr, (CoreSyn.Cast expr coercion)) 
-      | hasStateType expr
+    dobind (bndr, unpacked@(CoreSyn.Cast packed coercion)) 
+      | hasStateType packed && not (hasStateType unpacked)

       = return ((Just bndr, Nothing), ([], []))
     -- With simplCore, newtype packing is just a cast
       = return ((Just bndr, Nothing), ([], []))
     -- With simplCore, newtype packing is just a cast

-    dobind (bndr, expr@(CoreSyn.Cast (CoreSyn.Var state) coercion)) 
-      | hasStateType expr
+    dobind (bndr, packed@(CoreSyn.Cast unpacked@(CoreSyn.Var state) coercion)) 
+      | hasStateType packed && not (hasStateType unpacked)

       = return ((Nothing, Just state), ([], []))
     -- Without simplCore, newtype packing uses a data constructor
     dobind (bndr, (CoreSyn.App (CoreSyn.App (CoreSyn.Var con) (CoreSyn.Type _)) (CoreSyn.Var state))) 
       = return ((Nothing, Just state), ([], []))
     -- Without simplCore, newtype packing uses a data constructor
     dobind (bndr, (CoreSyn.App (CoreSyn.App (CoreSyn.Var con) (CoreSyn.Type _)) (CoreSyn.Var state))) 


@@ -161,19 +173,43 @@ getArchitecture fname = Utils.makeCached fname tsArchitectures $ do
       return ((Nothing, Nothing), sms)
 
 mkStateProcSm :: 
       return ((Nothing, Nothing), sms)
 
 mkStateProcSm :: 

-  (CoreSyn.CoreBndr, CoreSyn.CoreBndr) -- ^ The current and new state variables
-  -> AST.ProcSm -- ^ The resulting statement
-mkStateProcSm (old, new) =
-  AST.ProcSm label [clk] [statement]
-  where
-    label       = mkVHDLBasicId $ "state"
-    clk         = mkVHDLBasicId "clock"
-    rising_edge = AST.NSimple $ mkVHDLBasicId "rising_edge"
-    wform       = AST.Wform [AST.WformElem (AST.PrimName $ varToVHDLName new) Nothing]
-    assign      = AST.SigAssign (varToVHDLName old) wform
-    rising_edge_clk = AST.PrimFCall $ AST.FCall rising_edge [Nothing AST.:=>: (AST.ADName $ AST.NSimple clk)]
-    statement   = AST.IfSm rising_edge_clk [assign] [] Nothing
-
+  (CoreSyn.CoreBndr, CoreSyn.CoreBndr, CoreSyn.CoreBndr) -- ^ The current state, new state and reset variables
+  -> TranslatorSession ([AST.ConcSm], [CoreSyn.CoreBndr]) -- ^ The resulting statements
+mkStateProcSm (old, new, res) = do
+  let error_msg = "\nVHDL.mkSigDec: Can not make signal declaration for type: \n" ++ pprString res 
+  type_mark_old_maybe <- MonadState.lift tsType $ vhdlTy error_msg (Var.varType old)
+  let type_mark_old = Maybe.fromMaybe 
+                        (error $ "\nGenerate.mkStateProcSm: empty type for state? Type: " ++ pprString (Var.varType old))
+                        type_mark_old_maybe
+  type_mark_res_maybe <- MonadState.lift tsType $ vhdlTy error_msg (Var.varType res)
+  let type_mark_res' = Maybe.fromMaybe 
+                        (error $ "\nGenerate.mkStateProcSm: empty type for initial state? Type: " ++ pprString (Var.varType res))
+                        type_mark_res_maybe
+  let type_mark_res = if type_mark_old == type_mark_res' then
+                        type_mark_res'
+                      else 
+                        error $ "Initial state has different type than state type, state type: " ++ show type_mark_old ++ ", init type: "  ++ show type_mark_res'    
+  let resvalid  = mkVHDLExtId $ varToString res ++ "val"
+  let resvaldec = AST.BDISD $ AST.SigDec resvalid type_mark_res Nothing
+  let reswform  = AST.Wform [AST.WformElem (AST.PrimName $ AST.NSimple resvalid) Nothing]
+  let res_assign = AST.SigAssign (varToVHDLName old) reswform
+  let blocklabel       = mkVHDLBasicId "state"
+  let statelabel  = mkVHDLBasicId "stateupdate"
+  let rising_edge = AST.NSimple $ mkVHDLBasicId "rising_edge"
+  let wform       = AST.Wform [AST.WformElem (AST.PrimName $ varToVHDLName new) Nothing]
+  let clk_assign      = AST.SigAssign (varToVHDLName old) wform
+  let rising_edge_clk = AST.PrimFCall $ AST.FCall rising_edge [Nothing AST.:=>: (AST.ADName $ AST.NSimple clockId)]
+  let resetn_is_low  = (AST.PrimName $ AST.NSimple resetId) AST.:=: (AST.PrimLit "'0'")
+  signature <- getEntity res
+  let entity_id = ent_id signature
+  let reslabel = "resetval_" ++ ((prettyShow . varToVHDLName) res)
+  let portmaps = mkAssocElems [] (AST.NSimple resvalid) signature
+  let reset_statement = mkComponentInst reslabel entity_id portmaps
+  let clk_statement = [AST.ElseIf rising_edge_clk [clk_assign]]
+  let statement   = AST.IfSm resetn_is_low [res_assign] clk_statement Nothing
+  let stateupdate = AST.CSPSm $ AST.ProcSm statelabel [clockId,resetId,resvalid] [statement]
+  let block = AST.CSBSm $ AST.BlockSm blocklabel [] (AST.PMapAspect []) [resvaldec] [reset_statement,stateupdate]
+  return ([block],[res])

 
 -- | Transforms a core binding into a VHDL concurrent statement
 mkConcSm ::
 
 -- | Transforms a core binding into a VHDL concurrent statement
 mkConcSm ::


@@ -184,13 +220,16 @@ mkConcSm ::
 
 
 -- Ignore Cast expressions, they should not longer have any meaning as long as
 
 
 -- Ignore Cast expressions, they should not longer have any meaning as long as

--- the type works out.
+-- the type works out. Throw away state repacking
+mkConcSm (bndr, to@(CoreSyn.Cast from ty))
+  | hasStateType to && hasStateType from
+  = return ([],[])

 mkConcSm (bndr, CoreSyn.Cast expr ty) = mkConcSm (bndr, expr)
 
 -- Simple a = b assignments are just like applications, but without arguments.
 -- We can't just generate an unconditional assignment here, since b might be a
 -- top level binding (e.g., a function with no arguments).
 mkConcSm (bndr, CoreSyn.Cast expr ty) = mkConcSm (bndr, expr)
 
 -- Simple a = b assignments are just like applications, but without arguments.
 -- We can't just generate an unconditional assignment here, since b might be a
 -- top level binding (e.g., a function with no arguments).

-mkConcSm (bndr, CoreSyn.Var v) = do
+mkConcSm (bndr, CoreSyn.Var v) =

   genApplication (Left bndr) v []
 
 mkConcSm (bndr, app@(CoreSyn.App _ _))= do
   genApplication (Left bndr) v []
 
 mkConcSm (bndr, app@(CoreSyn.App _ _))= do


@@ -198,7 +237,7 @@ mkConcSm (bndr, app@(CoreSyn.App _ _))= do
   let valargs = get_val_args (Var.varType f) args
   genApplication (Left bndr) f (map Left valargs)
 
   let valargs = get_val_args (Var.varType f) args
   genApplication (Left bndr) f (map Left valargs)
 

--- A single alt case must be a selector. This means thee scrutinee is a simple
+-- A single alt case must be a selector. This means the scrutinee is a simple

 -- variable, the alternative is a dataalt with a single non-wild binder that
 -- is also returned.
 mkConcSm (bndr, expr@(CoreSyn.Case (CoreSyn.Var scrut) b ty [alt])) 
 -- variable, the alternative is a dataalt with a single non-wild binder that
 -- is also returned.
 mkConcSm (bndr, expr@(CoreSyn.Case (CoreSyn.Var scrut) b ty [alt])) 


@@ -207,15 +246,35 @@ mkConcSm (bndr, expr@(CoreSyn.Case (CoreSyn.Var scrut) b ty [alt]))
                 | otherwise =
   case alt of
     (CoreSyn.DataAlt dc, bndrs, (CoreSyn.Var sel_bndr)) -> do
                 | otherwise =
   case alt of
     (CoreSyn.DataAlt dc, bndrs, (CoreSyn.Var sel_bndr)) -> do

-      bndrs' <- Monad.filterM hasNonEmptyType bndrs
-      case List.elemIndex sel_bndr bndrs' of
-        Just i -> do
-          labels <- MonadState.lift tsType $ getFieldLabels (Id.idType scrut)
-          let label = labels!!i
-          let sel_name = mkSelectedName (varToVHDLName scrut) label
-          let sel_expr = AST.PrimName sel_name
-          return ([mkUncondAssign (Left bndr) sel_expr], [])
-        Nothing -> error $ "\nVHDL.mkConcSM: Not in normal form: Not a selector case:\n" ++ (pprString expr)
+      nonemptysel <- hasNonEmptyType sel_bndr 
+      if nonemptysel 
+        then do
+          bndrs' <- Monad.filterM hasNonEmptyType bndrs
+          case List.elemIndex sel_bndr bndrs' of
+            Just i -> do
+              htypeScrt <- MonadState.lift tsType $ mkHTypeEither (Var.varType scrut)
+              htypeBndr <- MonadState.lift tsType $ mkHTypeEither (Var.varType bndr)
+              case htypeScrt == htypeBndr of
+                True -> do
+                  let sel_name = varToVHDLName scrut
+                  let sel_expr = AST.PrimName sel_name
+                  return ([mkUncondAssign (Left bndr) sel_expr], [])
+                otherwise ->
+                  case htypeScrt of
+                    Right (AggrType _ _) -> do
+                      labels <- MonadState.lift tsType $ getFieldLabels (Id.idType scrut)
+                      let label = labels!!i
+                      let sel_name = mkSelectedName (varToVHDLName scrut) label
+                      let sel_expr = AST.PrimName sel_name
+                      return ([mkUncondAssign (Left bndr) sel_expr], [])
+                    _ -> do -- error $ "DIE!"
+                      let sel_name = varToVHDLName scrut
+                      let sel_expr = AST.PrimName sel_name
+                      return ([mkUncondAssign (Left bndr) sel_expr], [])
+            Nothing -> error $ "\nVHDL.mkConcSM: Not in normal form: Not a selector case: result is not one of the binders\n" ++ (pprString expr)
+          else
+            -- A selector case that selects a state value, ignore it.
+            return ([], [])

       
     _ -> error $ "\nVHDL.mkConcSM: Not in normal form: Not a selector case:\n" ++ (pprString expr)
 
       
     _ -> error $ "\nVHDL.mkConcSM: Not in normal form: Not a selector case:\n" ++ (pprString expr)
 


@@ -223,15 +282,24 @@ mkConcSm (bndr, expr@(CoreSyn.Case (CoreSyn.Var scrut) b ty [alt]))
 -- binders in the alts and only variables in the case values and a variable
 -- for a scrutinee. We check the constructor of the second alt, since the
 -- first is the default case, if there is any.
 -- binders in the alts and only variables in the case values and a variable
 -- for a scrutinee. We check the constructor of the second alt, since the
 -- first is the default case, if there is any.

-mkConcSm (bndr, (CoreSyn.Case (CoreSyn.Var scrut) b ty [(_, _, CoreSyn.Var false), (con, _, CoreSyn.Var true)])) = do
-  scrut' <- MonadState.lift tsType $ varToVHDLExpr scrut
-  let cond_expr = scrut' AST.:=: (altconToVHDLExpr con)
-  true_expr <- MonadState.lift tsType $ varToVHDLExpr true
-  false_expr <- MonadState.lift tsType $ varToVHDLExpr false
-  return ([mkCondAssign (Left bndr) cond_expr true_expr false_expr], [])

 
 

-mkConcSm (_, (CoreSyn.Case (CoreSyn.Var _) _ _ alts)) = error "\nVHDL.mkConcSm: Not in normal form: Case statement with more than two alternatives"
-mkConcSm (_, CoreSyn.Case _ _ _ _) = error "\nVHDL.mkConcSm: Not in normal form: Case statement has does not have a simple variable as scrutinee"
+-- mkConcSm (bndr, (CoreSyn.Case (CoreSyn.Var scrut) b ty [(_, _, CoreSyn.Var false), (con, _, CoreSyn.Var true)])) = do
+--   scrut' <- MonadState.lift tsType $ varToVHDLExpr scrut
+--   altcon <- MonadState.lift tsType $ altconToVHDLExpr con
+--   let cond_expr = scrut' AST.:=: altcon
+--   true_expr <- MonadState.lift tsType $ varToVHDLExpr true
+--   false_expr <- MonadState.lift tsType $ varToVHDLExpr false
+--   return ([mkCondAssign (Left bndr) cond_expr true_expr false_expr], [])
+mkConcSm (bndr, (CoreSyn.Case (CoreSyn.Var scrut) _ _ (alt:alts))) = do --error "\nVHDL.mkConcSm: Not in normal form: Case statement with more than two alternatives"
+  scrut' <- MonadState.lift tsType $ varToVHDLExpr scrut
+  -- Omit first condition, which is the default
+  altcons <- MonadState.lift tsType $ mapM (altconToVHDLExpr . (\(con,_,_) -> con)) alts
+  let cond_exprs = map (\x -> scrut' AST.:=: x) altcons
+  -- Rotate expressions to the left, so that the expression related to the default case is the last
+  exprs <- MonadState.lift tsType $ mapM (varToVHDLExpr . (\(_,_,CoreSyn.Var expr) -> expr)) (alts ++ [alt])
+  return ([mkAltsAssign (Left bndr) cond_exprs exprs], [])
+
+mkConcSm (_, CoreSyn.Case _ _ _ _) = error "\nVHDL.mkConcSm: Not in normal form: Case statement does not have a simple variable as scrutinee"

 mkConcSm (bndr, expr) = error $ "\nVHDL.mkConcSM: Unsupported binding in let expression: " ++ pprString bndr ++ " = " ++ pprString expr
 
 -----------------------------------------------------------------------------
 mkConcSm (bndr, expr) = error $ "\nVHDL.mkConcSM: Unsupported binding in let expression: " ++ pprString bndr ++ " = " ++ pprString expr
 
 -----------------------------------------------------------------------------


@@ -251,12 +319,12 @@ argsToVHDLExprs = catMaybesM . (mapM argToVHDLExpr)
 argToVHDLExpr :: Either CoreSyn.CoreExpr AST.Expr -> TranslatorSession (Maybe AST.Expr)
 argToVHDLExpr (Left expr) = MonadState.lift tsType $ do
   let errmsg = "Generate.argToVHDLExpr: Using non-representable type? Should not happen!"
 argToVHDLExpr :: Either CoreSyn.CoreExpr AST.Expr -> TranslatorSession (Maybe AST.Expr)
 argToVHDLExpr (Left expr) = MonadState.lift tsType $ do
   let errmsg = "Generate.argToVHDLExpr: Using non-representable type? Should not happen!"

-  ty_maybe <- vhdl_ty errmsg expr
+  ty_maybe <- vhdlTy errmsg expr

   case ty_maybe of
     Just _ -> do
       vhdl_expr <- varToVHDLExpr $ exprToVar expr
       return $ Just vhdl_expr
   case ty_maybe of
     Just _ -> do
       vhdl_expr <- varToVHDLExpr $ exprToVar expr
       return $ Just vhdl_expr

-    Nothing -> return $ Nothing
+    Nothing -> return Nothing

 
 argToVHDLExpr (Right expr) = return $ Just expr
 
 
 argToVHDLExpr (Right expr) = return $ Just expr
 


@@ -274,23 +342,35 @@ genNoInsts wrap dst func args = do
 genVarArgs ::
   (dst -> func -> [Var.Var] -> res)
   -> (dst -> func -> [Either CoreSyn.CoreExpr AST.Expr] -> res)
 genVarArgs ::
   (dst -> func -> [Var.Var] -> res)
   -> (dst -> func -> [Either CoreSyn.CoreExpr AST.Expr] -> res)

-genVarArgs wrap dst func args = wrap dst func args'
+genVarArgs wrap = genCoreArgs $ \dst func args -> let
+    args' = map exprToVar args
+  in
+    wrap dst func args'
+
+-- | A function to wrap a builder-like function that expects its arguments to
+-- be core expressions.
+genCoreArgs ::
+  (dst -> func -> [CoreSyn.CoreExpr] -> res)
+  -> (dst -> func -> [Either CoreSyn.CoreExpr AST.Expr] -> res)
+genCoreArgs wrap dst func args = wrap dst func args'

   where
   where

-    args' = map exprToVar exprargs

     -- Check (rather crudely) that all arguments are CoreExprs
     -- Check (rather crudely) that all arguments are CoreExprs

-    (exprargs, []) = Either.partitionEithers args
+    args' = case Either.partitionEithers args of 
+      (exprargs, []) -> exprargs
+      (exprsargs, rest) -> error $ "\nGenerate.genCoreArgs: expect core expression arguments but found ast exprs:" ++ (show rest)

 
 -- | A function to wrap a builder-like function that expects its arguments to
 -- be Literals
 genLitArgs ::
 
 -- | 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
+  (dst -> func -> [Literal.Literal] -> TranslatorSession [AST.ConcSm])
+  -> (dst -> func -> [Either CoreSyn.CoreExpr AST.Expr] -> TranslatorSession [AST.ConcSm])
+genLitArgs wrap dst func args = do
+  hscenv <- MonadState.lift tsType $ MonadState.get tsHscEnv
+  let (exprargs, []) = Either.partitionEithers args
+  -- FIXME: Check if we were passed an CoreSyn.App
+  let litargs = concatMap (getLiterals hscenv) exprargs
+  let args' = map exprToLit litargs
+  wrap dst func args'   

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


@@ -299,7 +379,7 @@ genExprRes ::
   -> ((Either CoreSyn.CoreBndr AST.VHDLName) -> func -> [arg] -> TranslatorSession [AST.ConcSm])
 genExprRes wrap dst func args = do
   expr <- wrap dst func args
   -> ((Either CoreSyn.CoreBndr AST.VHDLName) -> func -> [arg] -> TranslatorSession [AST.ConcSm])
 genExprRes wrap dst func args = do
   expr <- wrap dst func args

-  return $ [mkUncondAssign dst expr]
+  return [mkUncondAssign dst expr]

 
 -- | Generate a binary operator application. The first argument should be a
 -- constructor from the AST.Expr type, e.g. AST.And.
 
 -- | Generate a binary operator application. The first argument should be a
 -- constructor from the AST.Expr type, e.g. AST.And.


@@ -325,7 +405,7 @@ genNegation' _ f [arg] = do
   let name = Name.getOccString (TyCon.tyConName tycon)
   case name of
     "SizedInt" -> return $ AST.Neg arg1
   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 
+    otherwise -> error $ "\nGenerate.genNegation': Negation not allowed for type: " ++ show name 

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


@@ -341,14 +421,29 @@ genFCall' switch (Left res) f args = do
 genFCall' _ (Right name) _ _ = error $ "\nGenerate.genFCall': Cannot generate builtin function call assigned to a VHDLName: " ++ show name
 
 genFromSizedWord :: BuiltinBuilder
 genFCall' _ (Right name) _ _ = error $ "\nGenerate.genFCall': Cannot generate builtin function call assigned to a VHDLName: " ++ show name
 
 genFromSizedWord :: BuiltinBuilder

-genFromSizedWord = genNoInsts $ genExprArgs $ genExprRes genFromSizedWord'
-genFromSizedWord' :: Either CoreSyn.CoreBndr AST.VHDLName -> CoreSyn.CoreBndr -> [AST.Expr] -> TranslatorSession 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 = genNoInsts $ genExprArgs genFromSizedWord'
+genFromSizedWord' :: Either CoreSyn.CoreBndr AST.VHDLName -> CoreSyn.CoreBndr -> [AST.Expr] -> TranslatorSession [AST.ConcSm]
+genFromSizedWord' (Left res) f args@[arg] =
+  return [mkUncondAssign (Left res) arg]
+  -- 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
 
 genFromSizedWord' (Right name) _ _ = error $ "\nGenerate.genFromSizedWord': Cannot generate builtin function call assigned to a VHDLName: " ++ show name
 

+genFromRangedWord :: BuiltinBuilder
+genFromRangedWord = genNoInsts $ genExprArgs $ genExprRes genFromRangedWord'
+genFromRangedWord' :: Either CoreSyn.CoreBndr AST.VHDLName -> CoreSyn.CoreBndr -> [AST.Expr] -> TranslatorSession AST.Expr
+genFromRangedWord' (Left res) f [arg] = do {
+  ; let { ty = Var.varType res
+        ; (tycon, args) = Type.splitTyConApp ty
+        ; name = Name.getOccString (TyCon.tyConName tycon)
+        } ;
+  ; len <- MonadState.lift tsType $ 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))]
+  }
+genFromRangedWord' (Right name) _ _ = error $ "\nGenerate.genFromRangedWord': Cannot generate builtin function call assigned to a VHDLName: " ++ show name
+

 genResize :: BuiltinBuilder
 genResize = genNoInsts $ genExprArgs $ genExprRes genResize'
 genResize' :: Either CoreSyn.CoreBndr AST.VHDLName -> CoreSyn.CoreBndr -> [AST.Expr] -> TranslatorSession AST.Expr
 genResize :: BuiltinBuilder
 genResize = genNoInsts $ genExprArgs $ genExprRes genResize'
 genResize' :: Either CoreSyn.CoreBndr AST.VHDLName -> CoreSyn.CoreBndr -> [AST.Expr] -> TranslatorSession AST.Expr


@@ -365,6 +460,26 @@ genResize' (Left res) f [arg] = do {
   }
 genResize' (Right name) _ _ = error $ "\nGenerate.genFromSizedWord': Cannot generate builtin function call assigned to a VHDLName: " ++ show name
 
   }
 genResize' (Right name) _ _ = error $ "\nGenerate.genFromSizedWord': Cannot generate builtin function call assigned to a VHDLName: " ++ show name
 

+genTimes :: BuiltinBuilder
+genTimes = genNoInsts $ genExprArgs $ genExprRes genTimes'
+genTimes' :: Either CoreSyn.CoreBndr AST.VHDLName -> CoreSyn.CoreBndr -> [AST.Expr] -> TranslatorSession AST.Expr
+genTimes' (Left res) f [arg1,arg2] = do {
+  ; let { ty = Var.varType res
+        ; (tycon, args) = Type.splitTyConApp ty
+        ; name = Name.getOccString (TyCon.tyConName tycon)
+        } ;
+  ; len <- case name of
+      "SizedInt" -> MonadState.lift tsType $ tfp_to_int (sized_int_len_ty ty)
+      "SizedWord" -> MonadState.lift tsType $ tfp_to_int (sized_word_len_ty ty)
+      "RangedWord" -> do {  ubound <- MonadState.lift tsType $ tfp_to_int (ranged_word_bound_ty ty)
+                         ;  let bitsize = floor (logBase 2 (fromInteger (toInteger ubound)))
+                         ;  return bitsize
+                         }
+  ; return $ AST.PrimFCall $ AST.FCall (AST.NSimple (mkVHDLBasicId resizeId))
+             [Nothing AST.:=>: AST.ADExpr (arg1 AST.:*: arg2), Nothing AST.:=>: AST.ADExpr( AST.PrimLit (show len))]
+  }
+genTimes' (Right name) _ _ = error $ "\nGenerate.genTimes': 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
 -- FIXME: I'm calling genLitArgs which is very specific function,
 -- which needs to be fixed as well
 genFromInteger :: BuiltinBuilder


@@ -375,17 +490,17 @@ genFromInteger' (Left res) f lits = do {
         ; (tycon, args) = Type.splitTyConApp ty
         ; name = Name.getOccString (TyCon.tyConName tycon)
         } ;
         ; (tycon, args) = Type.splitTyConApp ty
         ; name = Name.getOccString (TyCon.tyConName tycon)
         } ;

-  ; case name of
-    "RangedWord" -> return $ AST.PrimLit (show (last lits))
-    otherwise -> do {
-      ; len <- case name of
-        "SizedInt" -> MonadState.lift tsType $ tfp_to_int (sized_int_len_ty ty)
-        "SizedWord" -> MonadState.lift tsType $ tfp_to_int (sized_word_len_ty ty)
-        "RangedWord" -> MonadState.lift tsType $ tfp_to_int (ranged_word_bound_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))]
+  ; len <- case name of
+    "SizedInt" -> MonadState.lift tsType $ tfp_to_int (sized_int_len_ty ty)
+    "SizedWord" -> MonadState.lift tsType $ tfp_to_int (sized_word_len_ty ty)
+    "RangedWord" -> do {
+      ; bound <- MonadState.lift tsType $ tfp_to_int (ranged_word_bound_ty ty)
+      ; return $ floor (logBase 2 (fromInteger (toInteger (bound)))) + 1

       }
       }

+  ; let fname = case name of "SizedInt" -> toSignedId ; "SizedWord" -> toUnsignedId ; "RangedWord" -> 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
   }
 
 genFromInteger' (Right name) _ _ = error $ "\nGenerate.genFromInteger': Cannot generate builtin function call assigned to a VHDLName: " ++ show name


@@ -494,9 +609,7 @@ genMap (Left res) f [Left mapped_f, Left (CoreSyn.Var arg)] = do {
 genMap' (Right name) _ _ = error $ "\nGenerate.genMap': Cannot generate map function call assigned to a VHDLName: " ++ show name
     
 genZipWith :: BuiltinBuilder
 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] -> TranslatorSession ([AST.ConcSm], [CoreSyn.CoreBndr])
-genZipWith' (Left res) f args@[zipped_f, arg1, arg2] = do {
+genZipWith (Left res) f args@[Left zipped_f, Left (CoreSyn.Var arg1), Left (CoreSyn.Var arg2)] = do {

   -- Setup the generate scheme
   ; len <- MonadState.lift tsType $ tfp_to_int $ (tfvec_len_ty . Var.varType) res
           -- TODO: Use something better than varToString
   -- Setup the generate scheme
   ; len <- MonadState.lift tsType $ tfp_to_int $ (tfvec_len_ty . Var.varType) res
           -- TODO: Use something better than varToString


@@ -508,10 +621,12 @@ genZipWith' (Left res) f args@[zipped_f, arg1, arg2] = do {
           -- 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
           -- 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

+        ; (CoreSyn.Var real_f, already_mapped_args) = CoreSyn.collectArgs zipped_f
+        ; valargs     = get_val_args (Var.varType real_f) already_mapped_args

         ; argexpr1    = vhdlNameToVHDLExpr $ mkIndexedName (varToVHDLName arg1) n_expr
         ; argexpr2    = vhdlNameToVHDLExpr $ mkIndexedName (varToVHDLName arg2) n_expr
         } ;
         ; argexpr1    = vhdlNameToVHDLExpr $ mkIndexedName (varToVHDLName arg1) n_expr
         ; argexpr2    = vhdlNameToVHDLExpr $ mkIndexedName (varToVHDLName arg2) n_expr
         } ;

-  ; (app_concsms, used) <- genApplication (Right resname) zipped_f [Right argexpr1, Right argexpr2]
+  ; (app_concsms, used) <- genApplication (Right resname) real_f (map Left valargs ++ [Right argexpr1, Right argexpr2])

     -- Return the generate functions
   ; return ([AST.CSGSm $ AST.GenerateSm label genScheme [] app_concsms], used)
   }
     -- Return the generate functions
   ; return ([AST.CSGSm $ AST.GenerateSm label genScheme [] app_concsms], used)
   }


@@ -527,7 +642,7 @@ genFold left = genVarArgs (genFold' left)
 
 genFold' :: Bool -> (Either CoreSyn.CoreBndr AST.VHDLName) -> CoreSyn.CoreBndr -> [Var.Var] -> TranslatorSession ([AST.ConcSm], [CoreSyn.CoreBndr])
 genFold' left res f args@[folded_f , start ,vec]= do
 
 genFold' :: Bool -> (Either CoreSyn.CoreBndr AST.VHDLName) -> CoreSyn.CoreBndr -> [Var.Var] -> TranslatorSession ([AST.ConcSm], [CoreSyn.CoreBndr])
 genFold' left res f args@[folded_f , start ,vec]= do

-  len <- MonadState.lift tsType $ tfp_to_int $ (tfvec_len_ty (Var.varType vec))
+  len <- MonadState.lift tsType $ 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] -> TranslatorSession ([AST.ConcSm], [CoreSyn.CoreBndr])
   genFold'' len left res f args
 
 genFold'' :: Int -> Bool -> (Either CoreSyn.CoreBndr AST.VHDLName) -> CoreSyn.CoreBndr -> [Var.Var] -> TranslatorSession ([AST.ConcSm], [CoreSyn.CoreBndr])


@@ -548,7 +663,7 @@ genFold'' len left (Left res) f [folded_f, start, vec] = do
   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 
   -- TODO: Handle Nothing
   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 
   -- TODO: Handle Nothing

-  Just tmp_vhdl_ty <- MonadState.lift tsType $ vhdl_ty error_msg tmp_ty
+  Just tmp_vhdl_ty <- MonadState.lift tsType $ vhdlTy error_msg tmp_ty

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


@@ -597,7 +712,7 @@ genFold'' len left (Left res) f [folded_f, start, vec] = do
                                                                   [Right argexpr2, Right argexpr1]
                                                               )
       -- Return the conditional generate part
                                                                   [Right argexpr2, Right argexpr1]
                                                               )
       -- Return the conditional generate part

-      return $ (AST.GenerateSm cond_label cond_scheme [] app_concsms, used)
+      return (AST.GenerateSm cond_label cond_scheme [] app_concsms, used)

 
     genOtherCell = do
       len <- MonadState.lift tsType $ tfp_to_int $ (tfvec_len_ty . Var.varType) vec
 
     genOtherCell = do
       len <- MonadState.lift tsType $ tfp_to_int $ (tfvec_len_ty . Var.varType) vec


@@ -617,7 +732,7 @@ genFold'' len left (Left res) f [folded_f, start, vec] = do
                                                                   [Right argexpr2, Right argexpr1]
                                                               )
       -- Return the conditional generate part
                                                                   [Right argexpr2, Right argexpr1]
                                                               )
       -- Return the conditional generate part

-      return $ (AST.GenerateSm cond_label cond_scheme [] app_concsms, used)
+      return (AST.GenerateSm cond_label cond_scheme [] app_concsms, used)

 
 -- | Generate a generate statement for the builtin function "zip"
 genZip :: BuiltinBuilder
 
 -- | Generate a generate statement for the builtin function "zip"
 genZip :: BuiltinBuilder


@@ -645,46 +760,94 @@ genZip' (Left res) f args@[arg1, arg2] = do {
     -- Return the generate functions
   ; return [AST.CSGSm $ AST.GenerateSm label genScheme [] [resA_assign,resB_assign]]
   }
     -- Return the generate functions
   ; return [AST.CSGSm $ AST.GenerateSm label genScheme [] [resA_assign,resB_assign]]
   }

+  
+-- | Generate a generate statement for the builtin function "fst"
+genFst :: BuiltinBuilder
+genFst = genNoInsts $ genVarArgs genFst'
+genFst' :: (Either CoreSyn.CoreBndr AST.VHDLName) -> CoreSyn.CoreBndr -> [Var.Var] -> TranslatorSession [AST.ConcSm]
+genFst' (Left res) f args@[arg] = do {
+  ; labels <- MonadState.lift tsType $ getFieldLabels (Var.varType arg)
+  ; let { argexpr'    = varToVHDLName arg
+        ; argexprA    = vhdlNameToVHDLExpr $ mkSelectedName argexpr' (labels!!0)
+        ; assign      = mkUncondAssign (Left res) argexprA
+        } ;
+    -- Return the generate functions
+  ; return [assign]
+  }
+  
+-- | Generate a generate statement for the builtin function "snd"
+genSnd :: BuiltinBuilder
+genSnd = genNoInsts $ genVarArgs genSnd'
+genSnd' :: (Either CoreSyn.CoreBndr AST.VHDLName) -> CoreSyn.CoreBndr -> [Var.Var] -> TranslatorSession [AST.ConcSm]
+genSnd' (Left res) f args@[arg] = do {
+  ; labels <- MonadState.lift tsType $ getFieldLabels (Var.varType arg)
+  ; let { argexpr'    = varToVHDLName arg
+        ; argexprB    = vhdlNameToVHDLExpr $ mkSelectedName argexpr' (labels!!1)
+        ; assign      = mkUncondAssign (Left res) argexprB
+        } ;
+    -- Return the generate functions
+  ; return [assign]
+  }

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

-genUnzip' (Left res) f args@[arg] = do {
-    -- Setup the generate scheme
-  ; len <- MonadState.lift tsType $ tfp_to_int $ (tfvec_len_ty . Var.varType) arg
-    -- TODO: Use something better than varToString
-  ; 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 tsType $ getFieldLabels (Var.varType res)
-  ; arglabels <- MonadState.lift tsType $ 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 [AST.CSGSm $ AST.GenerateSm label genScheme [] [resA_assign,resB_assign]]
-  }
+genUnzip' (Left res) f args@[arg] = do
+  let error_msg = "\nGenerate.genUnzip: Cannot generate unzip call: " ++ pprString res ++ " = " ++ pprString f ++ " " ++ pprString arg
+  htype <- MonadState.lift tsType $ mkHType error_msg (Var.varType arg)
+  -- Prepare a unconditional assignment, for the case when either part
+  -- of the unzip is a state variable, which will disappear in the
+  -- resulting VHDL, making the the unzip no longer required.
+  case htype of
+    -- A normal vector containing two-tuples
+    VecType _ (AggrType _ [_, _]) -> do {
+        -- Setup the generate scheme
+      ; len <- MonadState.lift tsType $ tfp_to_int $ (tfvec_len_ty . Var.varType) arg
+        -- TODO: Use something better than varToString
+      ; 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 tsType $ getFieldLabels (Var.varType res)
+      ; arglabels <- MonadState.lift tsType $ 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 [AST.CSGSm $ AST.GenerateSm label genScheme [] [resA_assign,resB_assign]]
+      }
+    -- Both elements of the tuple were state, so they've disappeared. No
+    -- need to do anything
+    VecType _ (AggrType _ []) -> return []
+    -- A vector containing aggregates with more than two elements?
+    VecType _ (AggrType _ _) -> error $ "Unzipping a value that is not a vector of two-tuples? Value: " ++ pprString arg ++ "\nType: " ++ pprString (Var.varType arg)
+    -- One of the elements of the tuple was state, so there won't be a
+    -- tuple (record) in the VHDL output. We can just do a plain
+    -- assignment, then.
+    VecType _ _ -> do
+      argexpr <- MonadState.lift tsType $ varToVHDLExpr arg
+      return [mkUncondAssign (Left res) argexpr]
+    _ -> error $ "Unzipping a value that is not a vector? Value: " ++ pprString arg ++ "\nType: " ++ pprString (Var.varType arg) ++ "\nhtype: " ++ show htype

 
 genCopy :: BuiltinBuilder 
 
 genCopy :: BuiltinBuilder 

-genCopy = genNoInsts $ genVarArgs genCopy'
-genCopy' :: (Either CoreSyn.CoreBndr AST.VHDLName ) -> CoreSyn.CoreBndr -> [Var.Var] -> TranslatorSession [AST.ConcSm]
-genCopy' (Left res) f args@[arg] =
-  let
-    resExpr = AST.Aggregate [AST.ElemAssoc (Just AST.Others) 
-                (AST.PrimName $ (varToVHDLName arg))]
-    out_assign = mkUncondAssign (Left res) resExpr
-  in 
-    return [out_assign]
+genCopy = genNoInsts genCopy'
+genCopy' :: (Either CoreSyn.CoreBndr AST.VHDLName ) -> CoreSyn.CoreBndr -> [Either CoreSyn.CoreExpr AST.Expr] -> TranslatorSession [AST.ConcSm]
+genCopy' (Left res) f [arg] = do {
+  ; [arg'] <- argsToVHDLExprs [arg]
+  ; let { resExpr = AST.Aggregate [AST.ElemAssoc (Just AST.Others) arg']
+        ; out_assign = mkUncondAssign (Left res) resExpr
+        }
+  ; return [out_assign]
+  }

     
 genConcat :: BuiltinBuilder
 genConcat = genNoInsts $ genVarArgs genConcat'
     
 genConcat :: BuiltinBuilder
 genConcat = genNoInsts $ genVarArgs genConcat'


@@ -751,7 +914,7 @@ genIterateOrGenerate'' len iter (Left res) f [app_f, start] = do
   let tmp_ty = Var.varType res
   let error_msg = "\nGenerate.genFold': Can not construct temp vector for element type: " ++ pprString tmp_ty 
   -- TODO: Handle Nothing
   let tmp_ty = Var.varType res
   let error_msg = "\nGenerate.genFold': Can not construct temp vector for element type: " ++ pprString tmp_ty 
   -- TODO: Handle Nothing

-  Just tmp_vhdl_ty <- MonadState.lift tsType $ vhdl_ty error_msg tmp_ty
+  Just tmp_vhdl_ty <- MonadState.lift tsType $ vhdlTy 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))


@@ -806,9 +969,70 @@ genIterateOrGenerate'' len iter (Left res) f [app_f, start] = do
       let argexpr = vhdlNameToVHDLExpr $ mkIndexedName tmp_name n_prev
       (app_concsms, used) <- genApplication (Right resname) app_f [Right argexpr]
       -- Return the conditional generate part
       let argexpr = vhdlNameToVHDLExpr $ mkIndexedName tmp_name n_prev
       (app_concsms, used) <- genApplication (Right resname) app_f [Right argexpr]
       -- Return the conditional generate part

-      return $ (AST.GenerateSm cond_label cond_scheme [] app_concsms, used)
-
-
+      return (AST.GenerateSm cond_label cond_scheme [] app_concsms, used)
+
+genBlockRAM :: BuiltinBuilder
+genBlockRAM = genNoInsts $ genExprArgs genBlockRAM'
+
+genBlockRAM' :: (Either CoreSyn.CoreBndr AST.VHDLName) -> CoreSyn.CoreBndr -> [AST.Expr] -> TranslatorSession [AST.ConcSm]
+genBlockRAM' (Left res) f args@[data_in,rdaddr,wraddr,wrenable] = do
+  -- Get the ram type
+  let (tup,data_out) = Type.splitAppTy (Var.varType res)
+  let (tup',ramvec) = Type.splitAppTy tup
+  let Just realram = Type.coreView ramvec
+  let Just (tycon, types) = Type.splitTyConApp_maybe realram
+  Just ram_vhdl_ty <- MonadState.lift tsType $ vhdlTy "wtf" (head types)
+  -- Make the intermediate vector
+  let ram_dec = AST.BDISD $ AST.SigDec ram_id ram_vhdl_ty Nothing
+  -- Get the data_out name
+  -- reslabels <- MonadState.lift tsType $ getFieldLabels (Var.varType res)
+  let resname = varToVHDLName res
+  -- let resname = mkSelectedName resname' (reslabels!!0)
+  let rdaddr_int = genExprFCall (mkVHDLBasicId toIntegerId) rdaddr
+  let argexpr = vhdlNameToVHDLExpr $ mkIndexedName (AST.NSimple ram_id) rdaddr_int
+  let assign = mkUncondAssign (Right resname) argexpr
+  let block_label = mkVHDLExtId ("blockRAM" ++ (varToString res))
+  let block = AST.BlockSm block_label [] (AST.PMapAspect []) [ram_dec] [assign, mkUpdateProcSm]
+  return [AST.CSBSm block]
+  where
+    ram_id = mkVHDLBasicId "ram"
+    mkUpdateProcSm :: AST.ConcSm
+    mkUpdateProcSm = AST.CSPSm $ AST.ProcSm proclabel [clockId] [statement]
+      where
+        proclabel   = mkVHDLBasicId "updateRAM"
+        rising_edge = mkVHDLBasicId "rising_edge"
+        wraddr_int  = genExprFCall (mkVHDLBasicId toIntegerId) wraddr
+        ramloc      = mkIndexedName (AST.NSimple ram_id) wraddr_int
+        wform       = AST.Wform [AST.WformElem data_in Nothing]
+        ramassign      = AST.SigAssign ramloc wform
+        rising_edge_clk = genExprFCall rising_edge (AST.PrimName $ AST.NSimple clockId)
+        statement   = AST.IfSm (AST.And rising_edge_clk wrenable) [ramassign] [] Nothing
+        
+genSplit :: BuiltinBuilder
+genSplit = genNoInsts $ genVarArgs genSplit'
+
+genSplit' :: (Either CoreSyn.CoreBndr AST.VHDLName) -> CoreSyn.CoreBndr -> [Var.Var] -> TranslatorSession [AST.ConcSm]
+genSplit' (Left res) f args@[vecIn] = do {
+  ; labels <- MonadState.lift tsType $ getFieldLabels (Var.varType res)
+  ; len <- MonadState.lift tsType $ tfp_to_int $ (tfvec_len_ty . Var.varType) vecIn
+  ; let { block_label = mkVHDLExtId ("split" ++ (varToString vecIn))
+        ; halflen   = round ((fromIntegral len) / 2)
+        ; rangeL    = vecSlice (AST.PrimLit "0") (AST.PrimLit $ show (halflen - 1))
+        ; rangeR    = vecSlice (AST.PrimLit $ show halflen) (AST.PrimLit $ show (len - 1))
+        ; resname   = varToVHDLName res
+        ; resnameL  = mkSelectedName resname (labels!!0)
+        ; resnameR  = mkSelectedName resname (labels!!1)
+        ; argexprL  = vhdlNameToVHDLExpr rangeL
+        ; argexprR  = vhdlNameToVHDLExpr rangeR
+        ; out_assignL = mkUncondAssign (Right resnameL) argexprL
+        ; out_assignR = mkUncondAssign (Right resnameR) argexprR
+        ; block = AST.BlockSm block_label [] (AST.PMapAspect []) [] [out_assignL, out_assignR]
+        }
+  ; return [AST.CSBSm block]
+  }
+  where
+    vecSlice init last =  AST.NSlice (AST.SliceName (varToVHDLName res) 
+                            (AST.ToRange init last))

 -----------------------------------------------------------------------------
 -- Function to generate VHDL for applications
 -----------------------------------------------------------------------------
 -----------------------------------------------------------------------------
 -- Function to generate VHDL for applications
 -----------------------------------------------------------------------------


@@ -820,111 +1044,123 @@ genApplication ::
   -- ^ The corresponding VHDL concurrent statements and entities
   --   instantiated.
 genApplication dst f args = do
   -- ^ The corresponding VHDL concurrent statements and entities
   --   instantiated.
 genApplication dst f args = do

-  case Var.isGlobalId f of
-    False -> do 
-      top <- isTopLevelBinder f
-      case top of
-        True -> do
-          -- Local binder that references a top level binding.  Generate a
-          -- component instantiation.
-          signature <- getEntity f
-          args' <- argsToVHDLExprs args
-          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
-          portmaps <- mkAssocElems args' ((either varToVHDLName id) dst) signature
-          return ([mkComponentInst label entity_id portmaps], [f])
-        False -> do
-          -- Not a top level binder, 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 tsType $ varToVHDLExpr f
-          return $ ([mkUncondAssign dst f'], [])
-    True | not stateful -> 
-      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 tsType $ getFieldLabels (Var.varType bndr)
-            args' <- argsToVHDLExprs 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.DataConWrapId dc -> case dst of
-          -- It's a datacon. Create a record from its arguments.
-          Left bndr -> do 
+  nonemptydst <- case dst of
+    Left bndr -> hasNonEmptyType bndr 
+    Right _ -> return True
+  if nonemptydst
+    then
+      if Var.isGlobalId f then
+        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
+              htype <- MonadState.lift tsType $ mkHTypeEither (Var.varType bndr)
+              let argsNostate = filter (\x -> not (either hasStateType (\x -> False) x)) args
+              case argsNostate of
+                [arg] -> do
+                  [arg'] <- argsToVHDLExprs [arg]
+                  return ([mkUncondAssign dst arg'], [])
+                otherwise ->
+                  case htype of
+                    Right (AggrType _ _) -> do
+                      labels <- MonadState.lift tsType $ getFieldLabels (Var.varType bndr)
+                      args' <- argsToVHDLExprs argsNostate
+                      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
+                    _ -> do -- error $ "DIE!"
+                      args' <- argsToVHDLExprs argsNostate
+                      return ([mkUncondAssign dst (head args')], [])            
+            Right _ -> error "\nGenerate.genApplication(DataConWorkId): Can't generate dataconstructor application without an original binder"
+          IdInfo.DataConWrapId dc -> case dst of
+            -- It's a datacon. Create a record from its arguments.
+            Left bndr ->
+              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(DataConWrapId): Incorrect number of arguments to builtin function: " ++ pprString f ++ " Args: " ++ show args
+               Nothing -> error $ "\nGenerate.genApplication(DataConWrapId): Can't generate dataconwrapper: " ++ (show dc)
+            Right _ -> error "\nGenerate.genApplication(DataConWrapId): Can't generate dataconwrapper application without an original binder"
+          IdInfo.VanillaId ->
+            -- 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
             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(DataConWrapId): Incorrect number of arguments to builtin function: " ++ pprString f ++ " Args: " ++ show args
-             Nothing -> error $ "\nGenerate.genApplication: Can't generate dataconwrapper: " ++ (show dc)
-          Right _ -> error $ "\nGenerate.genApplication: Can't generate dataconwrapper 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(VanillaId): Incorrect number of arguments to builtin function: " ++ pprString f ++ " Args: " ++ show args
-            Nothing -> do
-              top <- isTopLevelBinder f
-              case top of
-                True -> do
-                  -- Local binder that references a top level binding.  Generate a
-                  -- component instantiation.
-                  signature <- getEntity f
-                  args' <- argsToVHDLExprs args
-                  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
-                  portmaps <- mkAssocElems args' ((either varToVHDLName id) dst) signature
-                  return ([mkComponentInst label entity_id portmaps], [f])
-                False -> do
-                  -- Not a top level binder, 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.
-                  -- FIXME : I DONT KNOW IF THE ABOVE COMMENT HOLDS HERE, SO FOR NOW JUST ERROR!
-                  -- f' <- MonadState.lift tsType $ varToVHDLExpr f
-                  --                   return $ ([mkUncondAssign dst f'], [])
-                  error $ ("\nGenerate.genApplication(VanillaId): 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
-    -- If we can't generate a component instantiation, and the destination is
-    -- a state type, don't generate anything.
-    _ -> return ([], [])
-  where
-    -- Is our destination a state value?
-    stateful = case dst of
-      -- When our destination is a VHDL name, it won't have had a state type
-      Right _ -> False
-      -- Otherwise check its type
-      Left bndr -> hasStateType bndr
-
+              Just (arg_count, builder) ->
+                if length args == arg_count then
+                  builder dst f args
+                else
+                  error $ "\nGenerate.genApplication(VanillaId): Incorrect number of arguments to builtin function: " ++ pprString f ++ " Args: " ++ show args
+              Nothing -> do
+                top <- isTopLevelBinder f
+                if top then
+                  do
+                    -- Local binder that references a top level binding.  Generate a
+                    -- component instantiation.
+                    signature <- getEntity f
+                    args' <- argsToVHDLExprs args
+                    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], [f])
+                  else
+                    -- Not a top level binder, 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.
+                    -- FIXME : I DONT KNOW IF THE ABOVE COMMENT HOLDS HERE, SO FOR NOW JUST ERROR!
+                    -- f' <- MonadState.lift tsType $ varToVHDLExpr f
+                    --                   return $ ([mkUncondAssign dst f'], [])
+                  do errtype <- case dst of 
+                        Left bndr -> do 
+                          htype <- MonadState.lift tsType $ mkHTypeEither (Var.varType bndr)
+                          return (show htype)
+                        Right vhd -> return $ show vhd
+                     error ("\nGenerate.genApplication(VanillaId): Using function from another module that is not a known builtin: " ++ (pprString f) ++ "::" ++ errtype) 
+          IdInfo.ClassOpId cls ->
+            -- 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
+        else do
+          top <- isTopLevelBinder f
+          if top then
+            do
+               -- Local binder that references a top level binding.  Generate a
+               -- component instantiation.
+               signature <- getEntity f
+               args' <- argsToVHDLExprs args
+               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 (prettyShow . varToVHDLName) prettyShow) dst
+               let portmaps = mkAssocElems args' ((either varToVHDLName id) dst) signature
+               return ([mkComponentInst label entity_id portmaps], [f])
+            else
+              -- Not a top level binder, 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.
+            do f' <- MonadState.lift tsType $ varToVHDLExpr f
+               return ([mkUncondAssign dst f'], [])
+    else -- Destination has empty type, don't generate anything
+      return ([], [])

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


@@ -935,12 +1171,16 @@ 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
   -- TODO: Handle the Nothing case?
 vectorFunId el_ty fname = do
   let error_msg = "\nGenerate.vectorFunId: Can not construct vector function for element: " ++ pprString el_ty
   -- TODO: Handle the Nothing case?

-  Just elemTM <- vhdl_ty error_msg el_ty
+  elemTM_maybe <- vhdlTy error_msg el_ty
+  let elemTM = Maybe.fromMaybe
+                 (error $ "\nGenerate.vectorFunId: Cannot generate vector function \"" ++ fname ++ "\" for the empty type \"" ++ (pprString el_ty) ++ "\"")
+                 elemTM_maybe

   -- TODO: This should not be duplicated from mk_vector_ty. Probably but it in
   -- the VHDLState or something.
   let vectorTM = mkVHDLExtId $ "vector_" ++ (AST.fromVHDLId elemTM)
   -- TODO: This should not be duplicated from mk_vector_ty. Probably but it in
   -- the VHDLState or something.
   let vectorTM = mkVHDLExtId $ "vector_" ++ (AST.fromVHDLId elemTM)

-  typefuns <- getA tsTypeFuns
-  case Map.lookup (OrdType el_ty, fname) typefuns of
+  typefuns <- MonadState.get tsTypeFuns
+  el_htype <- mkHType error_msg el_ty
+  case Map.lookup (UVecType el_htype, fname) typefuns of

     -- Function already generated, just return it
     Just (id, _) -> return id
     -- Function not generated yet, generate it
     -- Function already generated, just return it
     Just (id, _) -> return id
     -- Function not generated yet, generate it


@@ -948,7 +1188,7 @@ vectorFunId el_ty fname = do
       let functions = genUnconsVectorFuns elemTM vectorTM
       case lookup fname functions of
         Just body -> do
       let functions = genUnconsVectorFuns elemTM vectorTM
       case lookup fname functions of
         Just body -> do

-          modA tsTypeFuns $ Map.insert (OrdType el_ty, fname) (function_id, (fst body))
+          MonadState.modify tsTypeFuns $ Map.insert (UVecType el_htype, fname) (function_id, (fst body))

           mapM_ (vectorFunId el_ty) (snd body)
           return function_id
         Nothing -> error $ "\nGenerate.vectorFunId: I don't know how to generate vector function " ++ fname
           mapM_ (vectorFunId el_ty) (snd body)
           return function_id
         Nothing -> error $ "\nGenerate.vectorFunId: I don't know how to generate vector function " ++ fname


@@ -960,7 +1200,7 @@ genUnconsVectorFuns :: AST.TypeMark -- ^ type of the vector elements
                     -> [(String, (AST.SubProgBody, [String]))]
 genUnconsVectorFuns elemTM vectorTM  = 
   [ (exId, (AST.SubProgBody exSpec      []                  [exExpr],[]))
                     -> [(String, (AST.SubProgBody, [String]))]
 genUnconsVectorFuns elemTM vectorTM  = 
   [ (exId, (AST.SubProgBody exSpec      []                  [exExpr],[]))

-  , (replaceId, (AST.SubProgBody replaceSpec [AST.SPVD replaceVar] [replaceExpr,replaceRet],[]))
+  , (replaceId, (AST.SubProgBody replaceSpec [AST.SPVD replaceVar] [replaceExpr1,replaceExpr2,replaceRet],[]))

   , (lastId, (AST.SubProgBody lastSpec    []                  [lastExpr],[]))
   , (initId, (AST.SubProgBody initSpec    [AST.SPVD initVar]  [initExpr, initRet],[]))
   , (minimumId, (AST.SubProgBody minimumSpec [] [minimumExpr],[]))
   , (lastId, (AST.SubProgBody lastSpec    []                  [lastExpr],[]))
   , (initId, (AST.SubProgBody initSpec    [AST.SPVD initVar]  [initExpr, initRet],[]))
   , (minimumId, (AST.SubProgBody minimumSpec [] [minimumExpr],[]))


@@ -996,12 +1236,11 @@ genUnconsVectorFuns elemTM vectorTM  =
     sPar = AST.unsafeVHDLBasicId "s"
     resId   = AST.unsafeVHDLBasicId "res"    
     exSpec = AST.Function (mkVHDLExtId exId) [AST.IfaceVarDec vecPar vectorTM,
     sPar = AST.unsafeVHDLBasicId "s"
     resId   = AST.unsafeVHDLBasicId "res"    
     exSpec = AST.Function (mkVHDLExtId exId) [AST.IfaceVarDec vecPar vectorTM,

-                               AST.IfaceVarDec ixPar  naturalTM] elemTM
+                               AST.IfaceVarDec ixPar  unsignedTM] elemTM

     exExpr = AST.ReturnSm (Just $ AST.PrimName $ AST.NIndexed 
     exExpr = AST.ReturnSm (Just $ AST.PrimName $ AST.NIndexed 

-              (AST.IndexedName (AST.NSimple vecPar) [AST.PrimName $ 
-                AST.NSimple ixPar]))
+              (AST.IndexedName (AST.NSimple vecPar) [genExprFCall (mkVHDLBasicId toIntegerId) (AST.PrimName $ AST.NSimple ixPar)]))

     replaceSpec = AST.Function (mkVHDLExtId replaceId)  [ AST.IfaceVarDec vecPar vectorTM
     replaceSpec = AST.Function (mkVHDLExtId replaceId)  [ AST.IfaceVarDec vecPar vectorTM

-                                          , AST.IfaceVarDec iPar   naturalTM
+                                          , AST.IfaceVarDec iPar   unsignedTM

                                           , AST.IfaceVarDec aPar   elemTM
                                           ] vectorTM 
        -- variable res : fsvec_x (0 to vec'length-1);
                                           , AST.IfaceVarDec aPar   elemTM
                                           ] vectorTM 
        -- variable res : fsvec_x (0 to vec'length-1);


@@ -1015,13 +1254,8 @@ genUnconsVectorFuns elemTM vectorTM  =
                                 (AST.PrimLit "1"))   ]))
                 Nothing
        --  res AST.:= vec(0 to i-1) & a & vec(i+1 to length'vec-1)
                                 (AST.PrimLit "1"))   ]))
                 Nothing
        --  res AST.:= vec(0 to i-1) & a & vec(i+1 to length'vec-1)

-    replaceExpr = AST.NSimple resId AST.:=
-           (vecSlice (AST.PrimLit "0") (AST.PrimName (AST.NSimple iPar) AST.:-: AST.PrimLit "1") AST.:&:
-            AST.PrimName (AST.NSimple aPar) AST.:&: 
-             vecSlice (AST.PrimName (AST.NSimple iPar) AST.:+: AST.PrimLit "1")
-                      ((AST.PrimName (AST.NAttribute $ 
-                                AST.AttribName (AST.NSimple vecPar) (AST.NSimple $ mkVHDLBasicId lengthId) Nothing)) 
-                                                              AST.:-: AST.PrimLit "1"))
+    replaceExpr1 = AST.NSimple resId AST.:= AST.PrimName (AST.NSimple vecPar)
+    replaceExpr2 = AST.NIndexed (AST.IndexedName (AST.NSimple resId) [genExprFCall (mkVHDLBasicId toIntegerId) (AST.PrimName $ AST.NSimple iPar)]) AST.:= AST.PrimName (AST.NSimple aPar)

     replaceRet =  AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple resId)
     vecSlice init last =  AST.PrimName (AST.NSlice 
                                         (AST.SliceName 
     replaceRet =  AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple resId)
     vecSlice init last =  AST.PrimName (AST.NSlice 
                                         (AST.SliceName 


@@ -1029,7 +1263,7 @@ genUnconsVectorFuns elemTM vectorTM  =
                                               (AST.ToRange init last)))
     lastSpec = AST.Function (mkVHDLExtId lastId) [AST.IfaceVarDec vecPar vectorTM] elemTM
        -- return vec(vec'length-1);
                                               (AST.ToRange init last)))
     lastSpec = AST.Function (mkVHDLExtId lastId) [AST.IfaceVarDec vecPar vectorTM] elemTM
        -- return vec(vec'length-1);

-    lastExpr = AST.ReturnSm (Just $ (AST.PrimName $ AST.NIndexed (AST.IndexedName 
+    lastExpr = AST.ReturnSm (Just (AST.PrimName $ AST.NIndexed (AST.IndexedName 

                     (AST.NSimple vecPar) 
                     [AST.PrimName (AST.NAttribute $ 
                                 AST.AttribName (AST.NSimple vecPar) (AST.NSimple $ mkVHDLBasicId lengthId) Nothing) 
                     (AST.NSimple vecPar) 
                     [AST.PrimName (AST.NAttribute $ 
                                 AST.AttribName (AST.NSimple vecPar) (AST.NSimple $ mkVHDLBasicId lengthId) Nothing) 


@@ -1163,7 +1397,7 @@ genUnconsVectorFuns elemTM vectorTM  =
     -- for i res'range loop
     --   res(i) := vec(f+i*s);
     -- end loop;
     -- for i res'range loop
     --   res(i) := vec(f+i*s);
     -- end loop;

-    selFor = AST.ForSM iId (AST.AttribRange $ AST.AttribName (AST.NSimple resId) (AST.NSimple $ rangeId) Nothing) [selAssign]
+    selFor = AST.ForSM iId (AST.AttribRange $ AST.AttribName (AST.NSimple resId) (AST.NSimple rangeId) Nothing) [selAssign]

     -- res(i) := vec(f+i*s);
     selAssign = let origExp = AST.PrimName (AST.NSimple fPar) AST.:+: 
                                 (AST.PrimName (AST.NSimple iId) AST.:*: 
     -- res(i) := vec(f+i*s);
     selAssign = let origExp = AST.PrimName (AST.NSimple fPar) AST.:+: 
                                 (AST.PrimName (AST.NSimple iId) AST.:*: 


@@ -1314,7 +1548,7 @@ genUnconsVectorFuns elemTM vectorTM  =
     --   res(vec'length-i-1) := vec(i);
     -- end loop;
     reverseFor = 
     --   res(vec'length-i-1) := vec(i);
     -- end loop;
     reverseFor = 

-       AST.ForSM iId (AST.AttribRange $ AST.AttribName (AST.NSimple resId) (AST.NSimple $ rangeId) Nothing) [reverseAssign]
+       AST.ForSM iId (AST.AttribRange $ AST.AttribName (AST.NSimple resId) (AST.NSimple rangeId) Nothing) [reverseAssign]

     -- res(vec'length-i-1) := vec(i);
     reverseAssign = AST.NIndexed (AST.IndexedName (AST.NSimple resId) [destExp]) AST.:=
       (AST.PrimName $ AST.NIndexed (AST.IndexedName (AST.NSimple vecPar) 
     -- res(vec'length-i-1) := vec(i);
     reverseAssign = AST.NIndexed (AST.IndexedName (AST.NSimple resId) [destExp]) AST.:=
       (AST.PrimName $ AST.NIndexed (AST.IndexedName (AST.NSimple vecPar) 


@@ -1345,7 +1579,8 @@ type BuiltinBuilder =
 type NameTable = Map.Map String (Int, BuiltinBuilder )
 
 -- | The builtin functions we support. Maps a name to an argument count and a
 type NameTable = Map.Map String (Int, BuiltinBuilder )
 
 -- | The builtin functions we support. Maps a name to an argument count and a

--- builder function.
+-- builder function. If you add a name to this map, don't forget to add
+-- it to VHDL.Constants/builtinIds as well.

 globalNameTable :: NameTable
 globalNameTable = Map.fromList
   [ (exId             , (2, genFCall True          ) )
 globalNameTable :: NameTable
 globalNameTable = Map.fromList
   [ (exId             , (2, genFCall True          ) )


@@ -1386,15 +1621,30 @@ 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    ) )

+  , (equalityId       , (2, genOperator2 (AST.:=:)  ) )
+  , (inEqualityId     , (2, genOperator2 (AST.:/=:) ) )
+  , (ltId             , (2, genOperator2 (AST.:<:)  ) )
+  , (lteqId           , (2, genOperator2 (AST.:<=:) ) )
+  , (gtId             , (2, genOperator2 (AST.:>:)  ) )
+  , (gteqId           , (2, genOperator2 (AST.:>=:) ) )
+  , (boolOrId         , (2, genOperator2 AST.Or     ) )
+  , (boolAndId        , (2, genOperator2 AST.And    ) )
+  , (boolNot          , (1, genOperator1 AST.Not    ) )

   , (plusId           , (2, genOperator2 (AST.:+:)  ) )
   , (plusId           , (2, genOperator2 (AST.:+:)  ) )

-  , (timesId          , (2, genOperator2 (AST.:*:)  ) )
+  , (timesId          , (2, genTimes                ) )

   , (negateId         , (1, genNegation             ) )
   , (minusId          , (2, genOperator2 (AST.:-:)  ) )
   , (fromSizedWordId  , (1, genFromSizedWord        ) )
   , (negateId         , (1, genNegation             ) )
   , (minusId          , (2, genOperator2 (AST.:-:)  ) )
   , (fromSizedWordId  , (1, genFromSizedWord        ) )

+  , (fromRangedWordId , (1, genFromRangedWord       ) )

   , (fromIntegerId    , (1, genFromInteger          ) )
   , (fromIntegerId    , (1, genFromInteger          ) )

-  , (resizeId         , (1, genResize               ) )
+  , (resizeWordId     , (1, genResize               ) )
+  , (resizeIntId      , (1, genResize               ) )

   , (sizedIntId       , (1, genSizedInt             ) )
   , (smallIntegerId   , (1, genFromInteger          ) )
   , (sizedIntId       , (1, genSizedInt             ) )
   , (smallIntegerId   , (1, genFromInteger          ) )

+  , (fstId            , (1, genFst                  ) )
+  , (sndId            , (1, genSnd                  ) )
+  , (blockRAMId       , (5, genBlockRAM             ) )
+  , (splitId          , (1, genSplit                ) )

   --, (tfvecId          , (1, genTFVec                ) )
   --, (tfvecId          , (1, genTFVec                ) )

-  , (minimumId        , (2, error $ "\nFunction name: \"minimum\" is used internally, use another name"))
+  , (minimumId        , (2, error "\nFunction name: \"minimum\" is used internally, use another name"))

   ]
   ]