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 7c604d6d732f0b7fc8e4997f67dd3fa68b08b059..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
+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
       -- TODO: Handle Nothing
       res' <- mkMap res
       -- Split the normalized expression
       let (args, binds, res) = Normalize.splitNormalized expr
       -- Generate ports for all non-empty types
       args' <- catMaybesM $ mapM mkMap args
       -- TODO: Handle Nothing
       res' <- mkMap res

-      count <- getA tsEntityCounter 
+      count <- MonadState.get tsEntityCounter 

       let vhdl_id = mkVHDLBasicId $ varToString fname ++ "Component_" ++ show count
       let vhdl_id = mkVHDLBasicId $ varToString fname ++ "Component_" ++ show count

-      putA tsEntityCounter (count + 1)
+      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


@@ -110,8 +108,8 @@ 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
   
   -- Split the normalized expression
   let (args, binds, res) = Normalize.splitNormalized expr
   


@@ -123,19 +121,27 @@ getArchitecture fname = Utils.makeCached fname tsArchitectures $ do
   -- 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)
   -- 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
   -- Get initial state, if it's there
   -- 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 <- getA tsInitStates
+  initSmap <- MonadState.get tsInitStates

   let init_state = Map.lookup fname initSmap
   -- Create a state proc, if needed
   (state_proc, resbndr) <- case (Maybe.catMaybes in_state_maybes, Maybe.catMaybes out_state_maybes, init_state) of
   let init_state = Map.lookup fname initSmap
   -- Create a state proc, if needed
   (state_proc, resbndr) <- case (Maybe.catMaybes in_state_maybes, Maybe.catMaybes out_state_maybes, init_state) of

-        ([in_state], [out_state], Nothing) -> error $ "No initial state defined for: " ++ show fname
-        ([in_state], [out_state], Just resetval) -> mkStateProcSm (in_state, out_state,resetval)
+        ([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
         ([], [], 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


@@ -170,41 +176,40 @@ mkStateProcSm ::
   (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
   (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

-  nonempty <- hasNonEmptyType old  
-  if nonempty 
-    then do
-      let error_msg = "\nVHDL.mkSigDec: Can not make signal declaration for type: \n" ++ pprString res 
-      type_mark_old_maybe <- MonadState.lift tsType $ vhdl_ty error_msg (Var.varType old)
-      let type_mark_old = Maybe.fromJust type_mark_old_maybe
-      type_mark_res_maybe <- MonadState.lift tsType $ vhdl_ty error_msg (Var.varType res)
-      let type_mark_res' = Maybe.fromJust 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  = mkVHDLBasicId $ 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] [statement]
-      let block = AST.CSBSm $ AST.BlockSm blocklabel [] (AST.PMapAspect []) [resvaldec] [reset_statement,stateupdate]
-      return ([block],[res])
-    else 
-      return ([],[])
+  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 ::


@@ -224,7 +229,7 @@ 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).
 -- 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


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


@@ -274,7 +299,7 @@ mkConcSm (bndr, (CoreSyn.Case (CoreSyn.Var scrut) _ _ (alt:alts))) = do --error
   exprs <- MonadState.lift tsType $ mapM (varToVHDLExpr . (\(_,_,CoreSyn.Var expr) -> expr)) (alts ++ [alt])
   return ([mkAltsAssign (Left bndr) cond_exprs exprs], [])
 
   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 has does not have a simple variable as scrutinee"
+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
 
 -----------------------------------------------------------------------------


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


@@ -317,11 +342,22 @@ 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
 
 -- | A function to wrap a builder-like function that expects its arguments to
 -- be Literals


@@ -329,13 +365,12 @@ genLitArgs ::
   (dst -> func -> [Literal.Literal] -> TranslatorSession [AST.ConcSm])
   -> (dst -> func -> [Either CoreSyn.CoreExpr AST.Expr] -> TranslatorSession [AST.ConcSm])
 genLitArgs wrap dst func args = do
   (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 $ getA tsHscEnv
+  hscenv <- MonadState.lift tsType $ MonadState.get tsHscEnv

   let (exprargs, []) = Either.partitionEithers args
   -- FIXME: Check if we were passed an CoreSyn.App
   let (exprargs, []) = Either.partitionEithers args
   -- FIXME: Check if we were passed an CoreSyn.App

-  let litargs = concat (map (getLiterals hscenv) exprargs)
+  let litargs = concatMap (getLiterals hscenv) exprargs

   let args' = map exprToLit litargs
   let args' = map exprToLit litargs

-  concsms <- wrap dst func args'
-  return concsms    
+  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.


@@ -344,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.


@@ -388,13 +423,27 @@ genFCall' _ (Right name) _ _ = error $ "\nGenerate.genFCall': Cannot generate bu
 genFromSizedWord :: BuiltinBuilder
 genFromSizedWord = genNoInsts $ genExprArgs genFromSizedWord'
 genFromSizedWord' :: Either CoreSyn.CoreBndr AST.VHDLName -> CoreSyn.CoreBndr -> [AST.Expr] -> TranslatorSession [AST.ConcSm]
 genFromSizedWord :: BuiltinBuilder
 genFromSizedWord = genNoInsts $ genExprArgs genFromSizedWord'
 genFromSizedWord' :: Either CoreSyn.CoreBndr AST.VHDLName -> CoreSyn.CoreBndr -> [AST.Expr] -> TranslatorSession [AST.ConcSm]

-genFromSizedWord' (Left res) f args@[arg] = do
-  return $ [mkUncondAssign (Left res) arg]
+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
 
   -- 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
 

+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


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


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


@@ -554,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)
   }


@@ -573,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])


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


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


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


@@ -724,41 +793,61 @@ genSnd' (Left res) f args@[arg] = do {
 genUnzip :: BuiltinBuilder
 genUnzip = genNoInsts $ genVarArgs genUnzip'
 genUnzip' :: (Either CoreSyn.CoreBndr AST.VHDLName) -> CoreSyn.CoreBndr -> [Var.Var] -> TranslatorSession [AST.ConcSm]
 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'


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


@@ -880,7 +969,7 @@ 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 :: BuiltinBuilder
 genBlockRAM = genNoInsts $ genExprArgs genBlockRAM'


@@ -892,13 +981,13 @@ genBlockRAM' (Left res) f args@[data_in,rdaddr,wraddr,wrenable] = do
   let (tup',ramvec) = Type.splitAppTy tup
   let Just realram = Type.coreView ramvec
   let Just (tycon, types) = Type.splitTyConApp_maybe realram
   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 $ vhdl_ty "wtf" (head types)
+  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
   -- 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)
+  -- 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 rdaddr_int = genExprFCall (mkVHDLBasicId toIntegerId) rdaddr
   let argexpr = vhdlNameToVHDLExpr $ mkIndexedName (AST.NSimple ram_id) rdaddr_int
   let assign = mkUncondAssign (Right resname) argexpr


@@ -955,101 +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 (prettyShow . varToVHDLName) prettyShow) dst
-          let 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 ->
-      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
-                  let 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
-
+              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.
 -----------------------------------------------------------------------------


@@ -1060,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 (StdType $ 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


@@ -1073,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 (StdType $ 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


@@ -1123,7 +1238,7 @@ genUnconsVectorFuns elemTM vectorTM  =
     exSpec = AST.Function (mkVHDLExtId exId) [AST.IfaceVarDec vecPar vectorTM,
                                AST.IfaceVarDec ixPar  unsignedTM] elemTM
     exExpr = AST.ReturnSm (Just $ AST.PrimName $ AST.NIndexed 
     exSpec = AST.Function (mkVHDLExtId exId) [AST.IfaceVarDec vecPar vectorTM,
                                AST.IfaceVarDec ixPar  unsignedTM] elemTM
     exExpr = AST.ReturnSm (Just $ AST.PrimName $ AST.NIndexed 

-              (AST.IndexedName (AST.NSimple vecPar) [genExprFCall (mkVHDLBasicId toIntegerId) (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
                                           , AST.IfaceVarDec iPar   unsignedTM
                                           , AST.IfaceVarDec aPar   elemTM
     replaceSpec = AST.Function (mkVHDLExtId replaceId)  [ AST.IfaceVarDec vecPar vectorTM
                                           , AST.IfaceVarDec iPar   unsignedTM
                                           , AST.IfaceVarDec aPar   elemTM


@@ -1140,7 +1255,7 @@ genUnconsVectorFuns elemTM vectorTM  =
                 Nothing
        --  res AST.:= vec(0 to i-1) & a & vec(i+1 to length'vec-1)
     replaceExpr1 = AST.NSimple resId AST.:= AST.PrimName (AST.NSimple vecPar)
                 Nothing
        --  res AST.:= vec(0 to i-1) & a & vec(i+1 to length'vec-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)
+    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 


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


@@ -1282,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.:*: 


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


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


@@ -1513,11 +1629,13 @@ globalNameTable = Map.fromList
   , (gteqId           , (2, genOperator2 (AST.:>=:) ) )
   , (boolOrId         , (2, genOperator2 AST.Or     ) )
   , (boolAndId        , (2, genOperator2 AST.And    ) )
   , (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          ) )
   , (resizeWordId     , (1, genResize               ) )
   , (resizeIntId      , (1, genResize               ) )
   , (fromIntegerId    , (1, genFromInteger          ) )
   , (resizeWordId     , (1, genResize               ) )
   , (resizeIntId      , (1, genResize               ) )


@@ -1528,5 +1646,5 @@ globalNameTable = Map.fromList
   , (blockRAMId       , (5, genBlockRAM             ) )
   , (splitId          , (1, genSplit                ) )
   --, (tfvecId          , (1, genTFVec                ) )
   , (blockRAMId       , (5, genBlockRAM             ) )
   , (splitId          , (1, genSplit                ) )
   --, (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"))

   ]
   ]