Merge branch 'cλash' of http://git.stderr.nl/matthijs/projects/master-project
[matthijs/master-project/cλash.git] / cλash / CLasH / VHDL / Generate.hs
index 5386e7e61b698a0681830ffc9b4b14c2c9c1e67f..dee2a794694394b371f26129a1e79c54ae6c5da2 100644 (file)
@@ -44,15 +44,15 @@ getEntity ::
 
 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
-      -- Generate ports for all non-state types
+      -- Split the normalized expression
+      let (args, binds, res) = Normalize.splitNormalized expr
+      -- 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
-      Just res' <- mkMap res
-      let vhdl_id = mkVHDLBasicId $ varToString fname ++ "_" ++ varToStringUniq fname
+      res' <- mkMap res
+      count <- getA tsEntityCounter 
+      let vhdl_id = mkVHDLBasicId $ varToString fname ++ "Component_" ++ show count
+      putA tsEntityCounter (count + 1)
       let ent_decl = createEntityAST vhdl_id args' res'
       let signature = Entity vhdl_id args' res' ent_decl
       return signature
@@ -81,7 +81,7 @@ getEntity fname = Utils.makeCached fname tsEntities $ do
 createEntityAST ::
   AST.VHDLId                   -- ^ The name of the function
   -> [Port]                    -- ^ The entity's arguments
-  -> Port                      -- ^ The entity's result
+  -> Maybe Port                -- ^ The entity's result
   -> AST.EntityDec             -- ^ The entity with the ent_decl filled in as well
 
 createEntityAST vhdl_id args res =
@@ -89,15 +89,17 @@ createEntityAST vhdl_id args res =
   where
     -- Create a basic Id, since VHDL doesn't grok filenames with extended Ids.
     ports = map (mkIfaceSigDec AST.In) args
-              ++ [mkIfaceSigDec AST.Out res]
-              ++ [clk_port]
+              ++ (Maybe.maybeToList res_port)
+              ++ [clk_port,resetn_port]
     -- 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
 mkIfaceSigDec ::
   AST.Mode                         -- ^ The mode for the port (In / Out)
-  -> (AST.VHDLId, AST.TypeMark)    -- ^ The id and type for the port
+  -> Port                          -- ^ The id and type for the port
   -> AST.IfaceSigDec               -- ^ The resulting port declaration
 
 mkIfaceSigDec mode (id, ty) = AST.IfaceSigDec id mode ty
@@ -110,29 +112,74 @@ getArchitecture ::
 
 getArchitecture fname = Utils.makeCached fname tsArchitectures $ do
   expr <- Normalize.getNormalized 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
-  -- 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)
+  sig_dec_maybes <- mapM (mkSigDec . fst) (filter ((/=res).fst) binds)
   let sig_decs = Maybe.catMaybes $ sig_dec_maybes
-
-  (statementss, used_entitiess) <- Monad.mapAndUnzipM mkConcSm binds
-  let statements = concat statementss
+  -- 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
+  -- Create a state proc, if needed
+  state_proc <- case (Maybe.catMaybes in_state_maybes, Maybe.catMaybes out_state_maybes) of
+        ([in_state], [out_state]) -> mkStateProcSm (in_state, out_state)
+        ([], []) -> return []
+        (ins, outs) -> 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
   let used_entities = concat used_entitiess
-  let arch = AST.ArchBody (mkVHDLBasicId "structural") (AST.NSimple entity_id) (map AST.BDISD sig_decs) (statements ++ procs')
   return (arch, used_entities)
   where
-    procs = [] --map mkStateProcSm [] -- (makeStatePairs flatfunc)
-    procs' = map AST.CSPSm procs
-    -- mkSigDec only uses tsTypes from the state
-    mkSigDec' = mkSigDec
+    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, unpacked@(CoreSyn.Cast packed coercion)) 
+      | hasStateType packed && not (hasStateType unpacked)
+      = return ((Just bndr, Nothing), ([], []))
+    -- With simplCore, newtype packing is just a cast
+    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))) 
+      | isStateCon con
+      = return ((Nothing, Just state), ([], []))
+    -- Anything else is handled by mkConcSm
+    dobind bind = do
+      sms <- mkConcSm bind
+      return ((Nothing, Nothing), sms)
+
+mkStateProcSm :: 
+  (CoreSyn.CoreBndr, CoreSyn.CoreBndr) -- ^ The current and new state variables
+  -> TranslatorSession [AST.ConcSm] -- ^ The resulting statements
+mkStateProcSm (old, new) = do
+  nonempty <- hasNonEmptyType old 
+  if nonempty 
+    then return [AST.CSPSm $ AST.ProcSm label [clockId,resetId] [statement]]
+    else return []
+  where
+    label       = mkVHDLBasicId $ "state"
+    rising_edge = AST.NSimple $ mkVHDLBasicId "rising_edge"
+    wform       = AST.Wform [AST.WformElem (AST.PrimName $ varToVHDLName new) Nothing]
+    clk_assign      = AST.SigAssign (varToVHDLName old) wform
+    rising_edge_clk = AST.PrimFCall $ AST.FCall rising_edge [Nothing AST.:=>: (AST.ADName $ AST.NSimple clockId)]
+    resetn_is_low  = (AST.PrimName $ AST.NSimple resetId) AST.:=: (AST.PrimLit "'0'")
+    reset_statement = []
+    clk_statement = [AST.ElseIf rising_edge_clk [clk_assign]]
+    statement   = AST.IfSm resetn_is_low reset_statement clk_statement Nothing
+
 
 -- | Transforms a core binding into a VHDL concurrent statement
 mkConcSm ::
@@ -143,7 +190,10 @@ mkConcSm ::
 
 
 -- 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.
@@ -157,7 +207,7 @@ mkConcSm (bndr, app@(CoreSyn.App _ _))= do
   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])) 
@@ -242,14 +292,16 @@ genVarArgs wrap dst func args = wrap dst func args'
 -- | A function to wrap a builder-like function that expects its arguments to
 -- be Literals
 genLitArgs ::
-  (dst -> func -> [Literal.Literal] -> res)
-  -> (dst -> func -> [Either CoreSyn.CoreExpr AST.Expr] -> res)
-genLitArgs wrap dst func args = wrap dst func args'
-  where
-    args' = map exprToLit litargs
-    -- FIXME: Check if we were passed an CoreSyn.App
-    litargs = concat (map getLiterals exprargs)
-    (exprargs, []) = Either.partitionEithers args
+  (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
+  let (exprargs, []) = Either.partitionEithers args
+  -- FIXME: Check if we were passed an CoreSyn.App
+  let litargs = concat (map (getLiterals hscenv) exprargs)
+  let args' = map exprToLit litargs
+  concsms <- wrap dst func args'
+  return concsms    
 
 -- | A function to wrap a builder-like function that produces an expression
 -- and expects it to be assigned to the destination.
@@ -300,12 +352,13 @@ 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
-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] = do
+  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
 
 genResize :: BuiltinBuilder
@@ -334,17 +387,17 @@ genFromInteger' (Left res) f lits = do {
         ; (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
@@ -604,6 +657,34 @@ genZip' (Left res) f args@[arg1, arg2] = do {
     -- 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
@@ -767,6 +848,42 @@ genIterateOrGenerate'' len iter (Left res) f [app_f, start] = do
       -- Return the conditional generate part
       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 $ vhdl_ty "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
 
 -----------------------------------------------------------------------------
 -- Function to generate VHDL for applications
@@ -791,8 +908,8 @@ genApplication dst f args = do
           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
+          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.
@@ -801,7 +918,7 @@ genApplication dst f args = do
           -- assignment here.
           f' <- MonadState.lift tsType $ varToVHDLExpr f
           return $ ([mkUncondAssign dst f'], [])
-    True | not stateful -> 
+    True ->
       case Var.idDetails f of
         IdInfo.DataConWorkId dc -> case dst of
           -- It's a datacon. Create a record from its arguments.
@@ -838,8 +955,30 @@ genApplication dst f args = do
               if length args == arg_count then
                 builder dst f args
               else
-                error $ "\nGenerate.genApplication(VanillaGlobal): Incorrect number of arguments to builtin function: " ++ pprString f ++ " Args: " ++ show args
-            Nothing -> error $ ("\nGenerate.genApplication(VanillaGlobal): Using function from another module that is not a known builtin: " ++ (pprString f))
+                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.
@@ -851,16 +990,6 @@ genApplication dst f args = do
                 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
 
 -----------------------------------------------------------------------------
 -- Functions to generate functions dealing with vectors.
@@ -897,14 +1026,14 @@ genUnconsVectorFuns :: AST.TypeMark -- ^ type of the vector elements
                     -> [(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],[]))
   , (takeId, (AST.SubProgBody takeSpec    [AST.SPVD takeVar]  [takeExpr, takeRet],[minimumId]))
   , (dropId, (AST.SubProgBody dropSpec    [AST.SPVD dropVar]  [dropExpr, dropRet],[]))
   , (plusgtId, (AST.SubProgBody plusgtSpec  [AST.SPVD plusgtVar] [plusgtExpr, plusgtRet],[]))
-  , (emptyId, (AST.SubProgBody emptySpec   [AST.SPCD emptyVar] [emptyExpr],[]))
+  , (emptyId, (AST.SubProgBody emptySpec   [AST.SPVD emptyVar] [emptyExpr],[]))
   , (singletonId, (AST.SubProgBody singletonSpec [AST.SPVD singletonVar] [singletonRet],[]))
   , (copynId, (AST.SubProgBody copynSpec    [AST.SPVD copynVar]      [copynExpr],[]))
   , (selId, (AST.SubProgBody selSpec  [AST.SPVD selVar] [selFor, selRet],[]))
@@ -933,12 +1062,11 @@ genUnconsVectorFuns elemTM 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 
-              (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
-                                          , AST.IfaceVarDec iPar   naturalTM
+                                          , AST.IfaceVarDec iPar   unsignedTM
                                           , AST.IfaceVarDec aPar   elemTM
                                           ] vectorTM 
        -- variable res : fsvec_x (0 to vec'length-1);
@@ -952,13 +1080,8 @@ genUnconsVectorFuns elemTM vectorTM  =
                                 (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 
@@ -1052,9 +1175,11 @@ genUnconsVectorFuns elemTM vectorTM  =
     plusgtRet = AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple resId)
     emptySpec = AST.Function (mkVHDLExtId emptyId) [] vectorTM
     emptyVar = 
-          AST.ConstDec resId 
-              (AST.SubtypeIn vectorTM Nothing)
-              (Just $ AST.PrimLit "\"\"")
+          AST.VarDec resId
+            (AST.SubtypeIn vectorTM
+              (Just $ AST.ConstraintIndex $ AST.IndexConstraint 
+                [AST.ToRange (AST.PrimLit "0") (AST.PrimLit "-1")]))
+             Nothing
     emptyExpr = AST.ReturnSm (Just $ AST.PrimName (AST.NSimple resId))
     singletonSpec = AST.Function (mkVHDLExtId singletonId) [AST.IfaceVarDec aPar elemTM ] 
                                          vectorTM
@@ -1321,6 +1446,14 @@ globalNameTable = Map.fromList
   , (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    ) )
   , (plusId           , (2, genOperator2 (AST.:+:)  ) )
   , (timesId          , (2, genOperator2 (AST.:*:)  ) )
   , (negateId         , (1, genNegation             ) )
@@ -1329,6 +1462,10 @@ globalNameTable = Map.fromList
   , (fromIntegerId    , (1, genFromInteger          ) )
   , (resizeId         , (1, genResize               ) )
   , (sizedIntId       , (1, genSizedInt             ) )
+  , (smallIntegerId   , (1, genFromInteger          ) )
+  , (fstId            , (1, genFst                  ) )
+  , (sndId            , (1, genSnd                  ) )
+  , (blockRAMId       , (5, genBlockRAM             ) )
   --, (tfvecId          , (1, genTFVec                ) )
   , (minimumId        , (2, error $ "\nFunction name: \"minimum\" is used internally, use another name"))
   ]