cλash/CLasH/VHDL/Generate.hs

   1 module CLasH.VHDL.Generate where
   2
   3 -- Standard modules
   4 import qualified Data.List as List
   5 import qualified Data.Map as Map
   6 import qualified Control.Monad as Monad
   7 import qualified Maybe
   8 import qualified Data.Either as Either
   9 import Data.Accessor.Monad.Trans.State as MonadState
  10 import Debug.Trace
  11
  12 -- ForSyDe
  13 import qualified Language.VHDL.AST as AST
  14
  15 -- GHC API
  16 import qualified CoreSyn
  17 import qualified Type
  18 import qualified Var
  19 import qualified Id
  20 import qualified IdInfo
  21 import qualified Literal
  22 import qualified Name
  23 import qualified TyCon
  24
  25 -- Local imports
  26 import CLasH.Translator.TranslatorTypes
  27 import CLasH.VHDL.Constants
  28 import CLasH.VHDL.VHDLTypes
  29 import CLasH.VHDL.VHDLTools
  30 import CLasH.Utils as Utils
  31 import CLasH.Utils.Core.CoreTools
  32 import CLasH.Utils.Pretty
  33 import qualified CLasH.Normalize as Normalize
  34
  35 -----------------------------------------------------------------------------
  36 -- Functions to generate VHDL for user-defined functions.
  37 -----------------------------------------------------------------------------
  38
  39 -- | Create an entity for a given function
  40 getEntity ::
  41   CoreSyn.CoreBndr
  42   -> TranslatorSession Entity -- ^ The resulting entity
  43
  44 getEntity fname = Utils.makeCached fname tsEntities $ do
  45       expr <- Normalize.getNormalized fname
  46       -- Split the normalized expression
  47       let (args, binds, res) = Normalize.splitNormalized expr
  48       -- Generate ports for all non-empty types
  49       args' <- catMaybesM $ mapM mkMap args
  50       -- TODO: Handle Nothing
  51       res' <- mkMap res
  52       count <- MonadState.get tsEntityCounter
  53       let vhdl_id = mkVHDLBasicId $ varToString fname ++ "Component_" ++ show count
  54       MonadState.set tsEntityCounter (count + 1)
  55       let ent_decl = createEntityAST vhdl_id args' res'
  56       let signature = Entity vhdl_id args' res' ent_decl
  57       return signature
  58   where
  59     mkMap ::
  60       --[(SignalId, SignalInfo)]
  61       CoreSyn.CoreBndr
  62       -> TranslatorSession (Maybe Port)
  63     mkMap = (\bndr ->
  64       let
  65         --info = Maybe.fromMaybe
  66         --  (error $ "Signal not found in the name map? This should not happen!")
  67         --  (lookup id sigmap)
  68         --  Assume the bndr has a valid VHDL id already
  69         id = varToVHDLId bndr
  70         ty = Var.varType bndr
  71         error_msg = "\nVHDL.createEntity.mkMap: Can not create entity: " ++ pprString fname ++ "\nbecause no type can be created for port: " ++ pprString bndr
  72       in do
  73         type_mark_maybe <- MonadState.lift tsType $ vhdlTy error_msg ty
  74         case type_mark_maybe of
  75           Just type_mark -> return $ Just (id, type_mark)
  76           Nothing -> return Nothing
  77      )
  78
  79 -- | Create the VHDL AST for an entity
  80 createEntityAST ::
  81   AST.VHDLId                   -- ^ The name of the function
  82   -> [Port]                    -- ^ The entity's arguments
  83   -> Maybe Port                -- ^ The entity's result
  84   -> AST.EntityDec             -- ^ The entity with the ent_decl filled in as well
  85
  86 createEntityAST vhdl_id args res =
  87   AST.EntityDec vhdl_id ports
  88   where
  89     -- Create a basic Id, since VHDL doesn't grok filenames with extended Ids.
  90     ports = map (mkIfaceSigDec AST.In) args
  91               ++ (Maybe.maybeToList res_port)
  92               ++ [clk_port,resetn_port]
  93     -- Add a clk port if we have state
  94     clk_port = AST.IfaceSigDec clockId AST.In std_logicTM
  95     resetn_port = AST.IfaceSigDec resetId AST.In std_logicTM
  96     res_port = fmap (mkIfaceSigDec AST.Out) res
  97
  98 -- | Create a port declaration
  99 mkIfaceSigDec ::
 100   AST.Mode                         -- ^ The mode for the port (In / Out)
 101   -> Port                          -- ^ The id and type for the port
 102   -> AST.IfaceSigDec               -- ^ The resulting port declaration
 103
 104 mkIfaceSigDec mode (id, ty) = AST.IfaceSigDec id mode ty
 105
 106 -- | Create an architecture for a given function
 107 getArchitecture ::
 108   CoreSyn.CoreBndr -- ^ The function to get an architecture for
 109   -> TranslatorSession (Architecture, [CoreSyn.CoreBndr])
 110   -- ^ The architecture for this function
 111
 112 getArchitecture fname = Utils.makeCached fname tsArchitectures $ do
 113   expr <- Normalize.getNormalized fname
 114   -- Split the normalized expression
 115   let (args, binds, res) = Normalize.splitNormalized expr
 116
 117   -- Get the entity for this function
 118   signature <- getEntity fname
 119   let entity_id = ent_id signature
 120
 121   -- Create signal declarations for all binders in the let expression, except
 122   -- for the output port (that will already have an output port declared in
 123   -- the entity).
 124   sig_dec_maybes <- mapM (mkSigDec . fst) (filter ((/=res).fst) binds)
 125   let sig_decs = Maybe.catMaybes $ sig_dec_maybes
 126   -- Process each bind, resulting in info about state variables and concurrent
 127   -- statements.
 128   (state_vars, sms) <- Monad.mapAndUnzipM dobind binds
 129   let (in_state_maybes, out_state_maybes) = unzip state_vars
 130   let (statementss, used_entitiess) = unzip sms
 131   -- Get initial state, if it's there
 132   initSmap <- MonadState.get tsInitStates
 133   let init_state = Map.lookup fname initSmap
 134   -- Create a state proc, if needed
 135   (state_proc, resbndr) <- case (Maybe.catMaybes in_state_maybes, Maybe.catMaybes out_state_maybes, init_state) of
 136         ([in_state], [out_state], Nothing) -> do
 137           nonEmpty <- hasNonEmptyType in_state
 138           if nonEmpty then error ("No initial state defined for: " ++ show fname) else return ([],[])
 139         ([in_state], [out_state], Just resetval) -> mkStateProcSm (in_state, out_state,resetval)
 140         ([], [], Just _) -> error $ "Initial state defined for state-less function: " ++ show fname
 141         ([], [], Nothing) -> return ([],[])
 142         (ins, outs, res) -> error $ "Weird use of state in " ++ show fname ++ ". In: " ++ show ins ++ " Out: " ++ show outs
 143   -- Join the create statements and the (optional) state_proc
 144   let statements = concat statementss ++ state_proc
 145   -- Create the architecture
 146   let arch = AST.ArchBody (mkVHDLBasicId "structural") (AST.NSimple entity_id) (map AST.BDISD sig_decs) statements
 147   let used_entities = (concat used_entitiess) ++ resbndr
 148   return (arch, used_entities)
 149   where
 150     dobind :: (CoreSyn.CoreBndr, CoreSyn.CoreExpr) -- ^ The bind to process
 151               -> TranslatorSession ((Maybe CoreSyn.CoreBndr, Maybe CoreSyn.CoreBndr), ([AST.ConcSm], [CoreSyn.CoreBndr]))
 152               -- ^ ((Input state variable, output state variable), (statements, used entities))
 153     -- newtype unpacking is just a cast
 154     dobind (bndr, unpacked@(CoreSyn.Cast packed coercion))
 155       | hasStateType packed && not (hasStateType unpacked)
 156       = return ((Just bndr, Nothing), ([], []))
 157     -- With simplCore, newtype packing is just a cast
 158     dobind (bndr, packed@(CoreSyn.Cast unpacked@(CoreSyn.Var state) coercion))
 159       | hasStateType packed && not (hasStateType unpacked)
 160       = return ((Nothing, Just state), ([], []))
 161     -- Without simplCore, newtype packing uses a data constructor
 162     dobind (bndr, (CoreSyn.App (CoreSyn.App (CoreSyn.Var con) (CoreSyn.Type _)) (CoreSyn.Var state)))
 163       | isStateCon con
 164       = return ((Nothing, Just state), ([], []))
 165     -- Anything else is handled by mkConcSm
 166     dobind bind = do
 167       sms <- mkConcSm bind
 168       return ((Nothing, Nothing), sms)
 169
 170 mkStateProcSm ::
 171   (CoreSyn.CoreBndr, CoreSyn.CoreBndr, CoreSyn.CoreBndr) -- ^ The current state, new state and reset variables
 172   -> TranslatorSession ([AST.ConcSm], [CoreSyn.CoreBndr]) -- ^ The resulting statements
 173 mkStateProcSm (old, new, res) = do
 174   let error_msg = "\nVHDL.mkSigDec: Can not make signal declaration for type: \n" ++ pprString res
 175   type_mark_old_maybe <- MonadState.lift tsType $ vhdlTy error_msg (Var.varType old)
 176   let type_mark_old = Maybe.fromJust type_mark_old_maybe
 177   type_mark_res_maybe <- MonadState.lift tsType $ vhdlTy error_msg (Var.varType res)
 178   let type_mark_res' = Maybe.fromJust type_mark_res_maybe
 179   let type_mark_res = if type_mark_old == type_mark_res' then
 180                         type_mark_res'
 181                       else
 182                         error $ "Initial state has different type than state type, state type: " ++ show type_mark_old ++ ", init type: "  ++ show type_mark_res'
 183   let resvalid  = mkVHDLExtId $ varToString res ++ "val"
 184   let resvaldec = AST.BDISD $ AST.SigDec resvalid type_mark_res Nothing
 185   let reswform  = AST.Wform [AST.WformElem (AST.PrimName $ AST.NSimple resvalid) Nothing]
 186   let res_assign = AST.SigAssign (varToVHDLName old) reswform
 187   let blocklabel       = mkVHDLBasicId $ "state"
 188   let statelabel  = mkVHDLBasicId $ "stateupdate"
 189   let rising_edge = AST.NSimple $ mkVHDLBasicId "rising_edge"
 190   let wform       = AST.Wform [AST.WformElem (AST.PrimName $ varToVHDLName new) Nothing]
 191   let clk_assign      = AST.SigAssign (varToVHDLName old) wform
 192   let rising_edge_clk = AST.PrimFCall $ AST.FCall rising_edge [Nothing AST.:=>: (AST.ADName $ AST.NSimple clockId)]
 193   let resetn_is_low  = (AST.PrimName $ AST.NSimple resetId) AST.:=: (AST.PrimLit "'0'")
 194   signature <- getEntity res
 195   let entity_id = ent_id signature
 196   let reslabel = "resetval_" ++ ((prettyShow . varToVHDLName) res)
 197   let portmaps = mkAssocElems [] (AST.NSimple resvalid) signature
 198   let reset_statement = mkComponentInst reslabel entity_id portmaps
 199   let clk_statement = [AST.ElseIf rising_edge_clk [clk_assign]]
 200   let statement   = AST.IfSm resetn_is_low [res_assign] clk_statement Nothing
 201   let stateupdate = AST.CSPSm $ AST.ProcSm statelabel [clockId,resetId,resvalid] [statement]
 202   let block = AST.CSBSm $ AST.BlockSm blocklabel [] (AST.PMapAspect []) [resvaldec] [reset_statement,stateupdate]
 203   return ([block],[res])
 204
 205 -- | Transforms a core binding into a VHDL concurrent statement
 206 mkConcSm ::
 207   (CoreSyn.CoreBndr, CoreSyn.CoreExpr) -- ^ The binding to process
 208   -> TranslatorSession ([AST.ConcSm], [CoreSyn.CoreBndr])
 209   -- ^ The corresponding VHDL concurrent statements and entities
 210   --   instantiated.
 211
 212
 213 -- Ignore Cast expressions, they should not longer have any meaning as long as
 214 -- the type works out. Throw away state repacking
 215 mkConcSm (bndr, to@(CoreSyn.Cast from ty))
 216   | hasStateType to && hasStateType from
 217   = return ([],[])
 218 mkConcSm (bndr, CoreSyn.Cast expr ty) = mkConcSm (bndr, expr)
 219
 220 -- Simple a = b assignments are just like applications, but without arguments.
 221 -- We can't just generate an unconditional assignment here, since b might be a
 222 -- top level binding (e.g., a function with no arguments).
 223 mkConcSm (bndr, CoreSyn.Var v) = do
 224   genApplication (Left bndr) v []
 225
 226 mkConcSm (bndr, app@(CoreSyn.App _ _))= do
 227   let (CoreSyn.Var f, args) = CoreSyn.collectArgs app
 228   let valargs = get_val_args (Var.varType f) args
 229   genApplication (Left bndr) f (map Left valargs)
 230
 231 -- A single alt case must be a selector. This means the scrutinee is a simple
 232 -- variable, the alternative is a dataalt with a single non-wild binder that
 233 -- is also returned.
 234 mkConcSm (bndr, expr@(CoreSyn.Case (CoreSyn.Var scrut) b ty [alt]))
 235                 -- Don't generate VHDL for substate extraction
 236                 | hasStateType bndr = return ([], [])
 237                 | otherwise =
 238   case alt of
 239     (CoreSyn.DataAlt dc, bndrs, (CoreSyn.Var sel_bndr)) -> do
 240       bndrs' <- Monad.filterM hasNonEmptyType bndrs
 241       case List.elemIndex sel_bndr bndrs' of
 242         Just i -> do
 243           htypeScrt <- MonadState.lift tsType $ mkHTypeEither (Var.varType scrut)
 244           htypeBndr <- MonadState.lift tsType $ mkHTypeEither (Var.varType bndr)
 245           case htypeScrt == htypeBndr of
 246             True -> do
 247               let sel_name = varToVHDLName scrut
 248               let sel_expr = AST.PrimName sel_name
 249               return ([mkUncondAssign (Left bndr) sel_expr], [])
 250             otherwise -> do
 251               case htypeScrt of
 252                 Right (AggrType _ _) -> do
 253                   labels <- MonadState.lift tsType $ getFieldLabels (Id.idType scrut)
 254                   let label = labels!!i
 255                   let sel_name = mkSelectedName (varToVHDLName scrut) label
 256                   let sel_expr = AST.PrimName sel_name
 257                   return ([mkUncondAssign (Left bndr) sel_expr], [])
 258                 _ -> do -- error $ "DIE!"
 259                   let sel_name = varToVHDLName scrut
 260                   let sel_expr = AST.PrimName sel_name
 261                   return ([mkUncondAssign (Left bndr) sel_expr], [])
 262         Nothing -> error $ "\nVHDL.mkConcSM: Not in normal form: Not a selector case:\n" ++ (pprString expr)
 263
 264     _ -> error $ "\nVHDL.mkConcSM: Not in normal form: Not a selector case:\n" ++ (pprString expr)
 265
 266 -- Multiple case alt are be conditional assignments and have only wild
 267 -- binders in the alts and only variables in the case values and a variable
 268 -- for a scrutinee. We check the constructor of the second alt, since the
 269 -- first is the default case, if there is any.
 270
 271 -- mkConcSm (bndr, (CoreSyn.Case (CoreSyn.Var scrut) b ty [(_, _, CoreSyn.Var false), (con, _, CoreSyn.Var true)])) = do
 272 --   scrut' <- MonadState.lift tsType $ varToVHDLExpr scrut
 273 --   altcon <- MonadState.lift tsType $ altconToVHDLExpr con
 274 --   let cond_expr = scrut' AST.:=: altcon
 275 --   true_expr <- MonadState.lift tsType $ varToVHDLExpr true
 276 --   false_expr <- MonadState.lift tsType $ varToVHDLExpr false
 277 --   return ([mkCondAssign (Left bndr) cond_expr true_expr false_expr], [])
 278 mkConcSm (bndr, (CoreSyn.Case (CoreSyn.Var scrut) _ _ (alt:alts))) = do --error "\nVHDL.mkConcSm: Not in normal form: Case statement with more than two alternatives"
 279   scrut' <- MonadState.lift tsType $ varToVHDLExpr scrut
 280   -- Omit first condition, which is the default
 281   altcons <- MonadState.lift tsType $ mapM (altconToVHDLExpr . (\(con,_,_) -> con)) alts
 282   let cond_exprs = map (\x -> scrut' AST.:=: x) altcons
 283   -- Rotate expressions to the left, so that the expression related to the default case is the last
 284   exprs <- MonadState.lift tsType $ mapM (varToVHDLExpr . (\(_,_,CoreSyn.Var expr) -> expr)) (alts ++ [alt])
 285   return ([mkAltsAssign (Left bndr) cond_exprs exprs], [])
 286
 287 mkConcSm (_, CoreSyn.Case _ _ _ _) = error "\nVHDL.mkConcSm: Not in normal form: Case statement has does not have a simple variable as scrutinee"
 288 mkConcSm (bndr, expr) = error $ "\nVHDL.mkConcSM: Unsupported binding in let expression: " ++ pprString bndr ++ " = " ++ pprString expr
 289
 290 -----------------------------------------------------------------------------
 291 -- Functions to generate VHDL for builtin functions
 292 -----------------------------------------------------------------------------
 293
 294 -- | A function to wrap a builder-like function that expects its arguments to
 295 -- be expressions.
 296 genExprArgs wrap dst func args = do
 297   args' <- argsToVHDLExprs args
 298   wrap dst func args'
 299
 300 -- | Turn the all lefts into VHDL Expressions.
 301 argsToVHDLExprs :: [Either CoreSyn.CoreExpr AST.Expr] -> TranslatorSession [AST.Expr]
 302 argsToVHDLExprs = catMaybesM . (mapM argToVHDLExpr)
 303
 304 argToVHDLExpr :: Either CoreSyn.CoreExpr AST.Expr -> TranslatorSession (Maybe AST.Expr)
 305 argToVHDLExpr (Left expr) = MonadState.lift tsType $ do
 306   let errmsg = "Generate.argToVHDLExpr: Using non-representable type? Should not happen!"
 307   ty_maybe <- vhdlTy errmsg expr
 308   case ty_maybe of
 309     Just _ -> do
 310       vhdl_expr <- varToVHDLExpr $ exprToVar expr
 311       return $ Just vhdl_expr
 312     Nothing -> return $ Nothing
 313
 314 argToVHDLExpr (Right expr) = return $ Just expr
 315
 316 -- A function to wrap a builder-like function that generates no component
 317 -- instantiations
 318 genNoInsts ::
 319   (dst -> func -> args -> TranslatorSession [AST.ConcSm])
 320   -> (dst -> func -> args -> TranslatorSession ([AST.ConcSm], [CoreSyn.CoreBndr]))
 321 genNoInsts wrap dst func args = do
 322   concsms <- wrap dst func args
 323   return (concsms, [])
 324
 325 -- | A function to wrap a builder-like function that expects its arguments to
 326 -- be variables.
 327 genVarArgs ::
 328   (dst -> func -> [Var.Var] -> res)
 329   -> (dst -> func -> [Either CoreSyn.CoreExpr AST.Expr] -> res)
 330 genVarArgs wrap dst func args = wrap dst func args'
 331   where
 332     args' = map exprToVar exprargs
 333     -- Check (rather crudely) that all arguments are CoreExprs
 334     (exprargs, []) = Either.partitionEithers args
 335
 336 -- | A function to wrap a builder-like function that expects its arguments to
 337 -- be Literals
 338 genLitArgs ::
 339   (dst -> func -> [Literal.Literal] -> TranslatorSession [AST.ConcSm])
 340   -> (dst -> func -> [Either CoreSyn.CoreExpr AST.Expr] -> TranslatorSession [AST.ConcSm])
 341 genLitArgs wrap dst func args = do
 342   hscenv <- MonadState.lift tsType $ MonadState.get tsHscEnv
 343   let (exprargs, []) = Either.partitionEithers args
 344   -- FIXME: Check if we were passed an CoreSyn.App
 345   let litargs = concat (map (getLiterals hscenv) exprargs)
 346   let args' = map exprToLit litargs
 347   concsms <- wrap dst func args'
 348   return concsms
 349
 350 -- | A function to wrap a builder-like function that produces an expression
 351 -- and expects it to be assigned to the destination.
 352 genExprRes ::
 353   ((Either CoreSyn.CoreBndr AST.VHDLName) -> func -> [arg] -> TranslatorSession AST.Expr)
 354   -> ((Either CoreSyn.CoreBndr AST.VHDLName) -> func -> [arg] -> TranslatorSession [AST.ConcSm])
 355 genExprRes wrap dst func args = do
 356   expr <- wrap dst func args
 357   return $ [mkUncondAssign dst expr]
 358
 359 -- | Generate a binary operator application. The first argument should be a
 360 -- constructor from the AST.Expr type, e.g. AST.And.
 361 genOperator2 :: (AST.Expr -> AST.Expr -> AST.Expr) -> BuiltinBuilder
 362 genOperator2 op = genNoInsts $ genExprArgs $ genExprRes (genOperator2' op)
 363 genOperator2' :: (AST.Expr -> AST.Expr -> AST.Expr) -> dst -> CoreSyn.CoreBndr -> [AST.Expr] -> TranslatorSession AST.Expr
 364 genOperator2' op _ f [arg1, arg2] = return $ op arg1 arg2
 365
 366 -- | Generate a unary operator application
 367 genOperator1 :: (AST.Expr -> AST.Expr) -> BuiltinBuilder
 368 genOperator1 op = genNoInsts $ genExprArgs $ genExprRes (genOperator1' op)
 369 genOperator1' :: (AST.Expr -> AST.Expr) -> dst -> CoreSyn.CoreBndr -> [AST.Expr] -> TranslatorSession AST.Expr
 370 genOperator1' op _ f [arg] = return $ op arg
 371
 372 -- | Generate a unary operator application
 373 genNegation :: BuiltinBuilder
 374 genNegation = genNoInsts $ genVarArgs $ genExprRes genNegation'
 375 genNegation' :: dst -> CoreSyn.CoreBndr -> [Var.Var] -> TranslatorSession AST.Expr
 376 genNegation' _ f [arg] = do
 377   arg1 <- MonadState.lift tsType $ varToVHDLExpr arg
 378   let ty = Var.varType arg
 379   let (tycon, args) = Type.splitTyConApp ty
 380   let name = Name.getOccString (TyCon.tyConName tycon)
 381   case name of
 382     "SizedInt" -> return $ AST.Neg arg1
 383     otherwise -> error $ "\nGenerate.genNegation': Negation not allowed for type: " ++ show name
 384
 385 -- | Generate a function call from the destination binder, function name and a
 386 -- list of expressions (its arguments)
 387 genFCall :: Bool -> BuiltinBuilder
 388 genFCall switch = genNoInsts $ genExprArgs $ genExprRes (genFCall' switch)
 389 genFCall' :: Bool -> Either CoreSyn.CoreBndr AST.VHDLName -> CoreSyn.CoreBndr -> [AST.Expr] -> TranslatorSession AST.Expr
 390 genFCall' switch (Left res) f args = do
 391   let fname = varToString f
 392   let el_ty = if switch then (Var.varType res) else ((tfvec_elem . Var.varType) res)
 393   id <- MonadState.lift tsType $ vectorFunId el_ty fname
 394   return $ AST.PrimFCall $ AST.FCall (AST.NSimple id)  $
 395              map (\exp -> Nothing AST.:=>: AST.ADExpr exp) args
 396 genFCall' _ (Right name) _ _ = error $ "\nGenerate.genFCall': Cannot generate builtin function call assigned to a VHDLName: " ++ show name
 397
 398 genFromSizedWord :: BuiltinBuilder
 399 genFromSizedWord = genNoInsts $ genExprArgs genFromSizedWord'
 400 genFromSizedWord' :: Either CoreSyn.CoreBndr AST.VHDLName -> CoreSyn.CoreBndr -> [AST.Expr] -> TranslatorSession [AST.ConcSm]
 401 genFromSizedWord' (Left res) f args@[arg] = do
 402   return $ [mkUncondAssign (Left res) arg]
 403   -- let fname = varToString f
 404   -- return $ AST.PrimFCall $ AST.FCall (AST.NSimple (mkVHDLBasicId toIntegerId))  $
 405   --            map (\exp -> Nothing AST.:=>: AST.ADExpr exp) args
 406 genFromSizedWord' (Right name) _ _ = error $ "\nGenerate.genFromSizedWord': Cannot generate builtin function call assigned to a VHDLName: " ++ show name
 407
 408 genResize :: BuiltinBuilder
 409 genResize = genNoInsts $ genExprArgs $ genExprRes genResize'
 410 genResize' :: Either CoreSyn.CoreBndr AST.VHDLName -> CoreSyn.CoreBndr -> [AST.Expr] -> TranslatorSession AST.Expr
 411 genResize' (Left res) f [arg] = do {
 412   ; let { ty = Var.varType res
 413         ; (tycon, args) = Type.splitTyConApp ty
 414         ; name = Name.getOccString (TyCon.tyConName tycon)
 415         } ;
 416   ; len <- case name of
 417       "SizedInt" -> MonadState.lift tsType $ tfp_to_int (sized_int_len_ty ty)
 418       "SizedWord" -> MonadState.lift tsType $ tfp_to_int (sized_word_len_ty ty)
 419   ; return $ AST.PrimFCall $ AST.FCall (AST.NSimple (mkVHDLBasicId resizeId))
 420              [Nothing AST.:=>: AST.ADExpr arg, Nothing AST.:=>: AST.ADExpr( AST.PrimLit (show len))]
 421   }
 422 genResize' (Right name) _ _ = error $ "\nGenerate.genFromSizedWord': Cannot generate builtin function call assigned to a VHDLName: " ++ show name
 423
 424 -- FIXME: I'm calling genLitArgs which is very specific function,
 425 -- which needs to be fixed as well
 426 genFromInteger :: BuiltinBuilder
 427 genFromInteger = genNoInsts $ genLitArgs $ genExprRes genFromInteger'
 428 genFromInteger' :: Either CoreSyn.CoreBndr AST.VHDLName -> CoreSyn.CoreBndr -> [Literal.Literal] -> TranslatorSession AST.Expr
 429 genFromInteger' (Left res) f lits = do {
 430   ; let { ty = Var.varType res
 431         ; (tycon, args) = Type.splitTyConApp ty
 432         ; name = Name.getOccString (TyCon.tyConName tycon)
 433         } ;
 434   ; len <- case name of
 435     "SizedInt" -> MonadState.lift tsType $ tfp_to_int (sized_int_len_ty ty)
 436     "SizedWord" -> MonadState.lift tsType $ tfp_to_int (sized_word_len_ty ty)
 437     "RangedWord" -> do {
 438       ; bound <- MonadState.lift tsType $ tfp_to_int (ranged_word_bound_ty ty)
 439       ; return $ floor (logBase 2 (fromInteger (toInteger (bound)))) + 1
 440       }
 441   ; let fname = case name of "SizedInt" -> toSignedId ; "SizedWord" -> toUnsignedId ; "RangedWord" -> toUnsignedId
 442   ; return $ AST.PrimFCall $ AST.FCall (AST.NSimple (mkVHDLBasicId fname))
 443             [Nothing AST.:=>: AST.ADExpr (AST.PrimLit (show (last lits))), Nothing AST.:=>: AST.ADExpr( AST.PrimLit (show len))]
 444
 445   }
 446
 447 genFromInteger' (Right name) _ _ = error $ "\nGenerate.genFromInteger': Cannot generate builtin function call assigned to a VHDLName: " ++ show name
 448
 449 genSizedInt :: BuiltinBuilder
 450 genSizedInt = genFromInteger
 451
 452 {-
 453 -- | Generate a Builder for the builtin datacon TFVec
 454 genTFVec :: BuiltinBuilder
 455 genTFVec (Left res) f [Left (CoreSyn.Let (CoreSyn.Rec letBinders) letRes)] = do {
 456   -- Generate Assignments for all the binders
 457   ; letAssigns <- mapM genBinderAssign letBinders
 458   -- Generate assignments for the result (which might be another let binding)
 459   ; (resBinders,resAssignments) <- genResAssign letRes
 460   -- Get all the Assigned binders
 461   ; let assignedBinders = Maybe.catMaybes (map fst letAssigns)
 462   -- Make signal names for all the assigned binders
 463   ; sigs <- mapM (\x -> MonadState.lift tsType $ varToVHDLExpr x) (assignedBinders ++ resBinders)
 464   -- Assign all the signals to the resulting vector
 465   ; let { vecsigns = mkAggregateSignal sigs
 466         ; vecassign = mkUncondAssign (Left res) vecsigns
 467         } ;
 468   -- Generate all the signal declaration for the assigned binders
 469   ; sig_dec_maybes <- mapM mkSigDec (assignedBinders ++ resBinders)
 470   ; let { sig_decs = map (AST.BDISD) (Maybe.catMaybes $ sig_dec_maybes)
 471   -- Setup the VHDL Block
 472         ; block_label = mkVHDLExtId ("TFVec_" ++ show (varToString res))
 473         ; block = AST.BlockSm block_label [] (AST.PMapAspect []) sig_decs ((concat (map snd letAssigns)) ++ resAssignments ++ [vecassign])
 474         } ;
 475   -- Return the block statement coressponding to the TFVec literal
 476   ; return $ [AST.CSBSm block]
 477   }
 478   where
 479     genBinderAssign :: (CoreSyn.CoreBndr, CoreSyn.CoreExpr) -> TranslatorSession (Maybe CoreSyn.CoreBndr, [AST.ConcSm])
 480     -- For now we only translate applications
 481     genBinderAssign (bndr, app@(CoreSyn.App _ _)) = do
 482       let (CoreSyn.Var f, args) = CoreSyn.collectArgs app
 483       let valargs = get_val_args (Var.varType f) args
 484       apps <- genApplication (Left bndr) f (map Left valargs)
 485       return (Just bndr, apps)
 486     genBinderAssign _ = return (Nothing,[])
 487     genResAssign :: CoreSyn.CoreExpr -> TranslatorSession ([CoreSyn.CoreBndr], [AST.ConcSm])
 488     genResAssign app@(CoreSyn.App _ letexpr) = do
 489       case letexpr of
 490         (CoreSyn.Let (CoreSyn.Rec letbndrs) letres) -> do
 491           letapps <- mapM genBinderAssign letbndrs
 492           let bndrs = Maybe.catMaybes (map fst letapps)
 493           let app = (map snd letapps)
 494           (vars, apps) <- genResAssign letres
 495           return ((bndrs ++ vars),((concat app) ++ apps))
 496         otherwise -> return ([],[])
 497     genResAssign _ = return ([],[])
 498
 499 genTFVec (Left res) f [Left app@(CoreSyn.App _ _)] = do {
 500   ; let { elems = reduceCoreListToHsList app
 501   -- Make signal names for all the binders
 502         ; binders = map (\expr -> case expr of
 503                           (CoreSyn.Var b) -> b
 504                           otherwise -> error $ "\nGenerate.genTFVec: Cannot generate TFVec: "
 505                             ++ show res ++ ", with elems:\n" ++ show elems ++ "\n" ++ pprString elems) elems
 506         } ;
 507   ; sigs <- mapM (\x -> MonadState.lift tsType $ varToVHDLExpr x) binders
 508   -- Assign all the signals to the resulting vector
 509   ; let { vecsigns = mkAggregateSignal sigs
 510         ; vecassign = mkUncondAssign (Left res) vecsigns
 511   -- Setup the VHDL Block
 512         ; block_label = mkVHDLExtId ("TFVec_" ++ show (varToString res))
 513         ; block = AST.BlockSm block_label [] (AST.PMapAspect []) [] [vecassign]
 514         } ;
 515   -- Return the block statement coressponding to the TFVec literal
 516   ; return $ [AST.CSBSm block]
 517   }
 518
 519 genTFVec (Left name) _ [Left xs] = error $ "\nGenerate.genTFVec: Cannot generate TFVec: " ++ show name ++ ", with elems:\n" ++ show xs ++ "\n" ++ pprString xs
 520
 521 genTFVec (Right name) _ _ = error $ "\nGenerate.genTFVec: Cannot generate TFVec assigned to VHDLName: " ++ show name
 522 -}
 523 -- | Generate a generate statement for the builtin function "map"
 524 genMap :: BuiltinBuilder
 525 genMap (Left res) f [Left mapped_f, Left (CoreSyn.Var arg)] = do {
 526   -- mapped_f must be a CoreExpr (since we can't represent functions as VHDL
 527   -- expressions). arg must be a CoreExpr (and should be a CoreSyn.Var), since
 528   -- we must index it (which we couldn't if it was a VHDL Expr, since only
 529   -- VHDLNames can be indexed).
 530   -- Setup the generate scheme
 531   ; len <- MonadState.lift tsType $ tfp_to_int $ (tfvec_len_ty . Var.varType) res
 532           -- TODO: Use something better than varToString
 533   ; let { label       = mkVHDLExtId ("mapVector" ++ (varToString res))
 534         ; n_id        = mkVHDLBasicId "n"
 535         ; n_expr      = idToVHDLExpr n_id
 536         ; range       = AST.ToRange (AST.PrimLit "0") (AST.PrimLit $ show (len-1))
 537         ; genScheme   = AST.ForGn n_id range
 538           -- Create the content of the generate statement: Applying the mapped_f to
 539           -- each of the elements in arg, storing to each element in res
 540         ; resname     = mkIndexedName (varToVHDLName res) n_expr
 541         ; argexpr     = vhdlNameToVHDLExpr $ mkIndexedName (varToVHDLName arg) n_expr
 542         ; (CoreSyn.Var real_f, already_mapped_args) = CoreSyn.collectArgs mapped_f
 543         ; valargs = get_val_args (Var.varType real_f) already_mapped_args
 544         } ;
 545   ; (app_concsms, used) <- genApplication (Right resname) real_f (map Left valargs ++ [Right argexpr])
 546     -- Return the generate statement
 547   ; return ([AST.CSGSm $ AST.GenerateSm label genScheme [] app_concsms], used)
 548   }
 549
 550 genMap' (Right name) _ _ = error $ "\nGenerate.genMap': Cannot generate map function call assigned to a VHDLName: " ++ show name
 551
 552 genZipWith :: BuiltinBuilder
 553 genZipWith = genVarArgs genZipWith'
 554 genZipWith' :: (Either CoreSyn.CoreBndr AST.VHDLName) -> CoreSyn.CoreBndr -> [Var.Var] -> TranslatorSession ([AST.ConcSm], [CoreSyn.CoreBndr])
 555 genZipWith' (Left res) f args@[zipped_f, arg1, arg2] = do {
 556   -- Setup the generate scheme
 557   ; len <- MonadState.lift tsType $ tfp_to_int $ (tfvec_len_ty . Var.varType) res
 558           -- TODO: Use something better than varToString
 559   ; let { label       = mkVHDLExtId ("zipWithVector" ++ (varToString res))
 560         ; n_id        = mkVHDLBasicId "n"
 561         ; n_expr      = idToVHDLExpr n_id
 562         ; range       = AST.ToRange (AST.PrimLit "0") (AST.PrimLit $ show (len-1))
 563         ; genScheme   = AST.ForGn n_id range
 564           -- Create the content of the generate statement: Applying the zipped_f to
 565           -- each of the elements in arg1 and arg2, storing to each element in res
 566         ; resname     = mkIndexedName (varToVHDLName res) n_expr
 567         ; argexpr1    = vhdlNameToVHDLExpr $ mkIndexedName (varToVHDLName arg1) n_expr
 568         ; argexpr2    = vhdlNameToVHDLExpr $ mkIndexedName (varToVHDLName arg2) n_expr
 569         } ;
 570   ; (app_concsms, used) <- genApplication (Right resname) zipped_f [Right argexpr1, Right argexpr2]
 571     -- Return the generate functions
 572   ; return ([AST.CSGSm $ AST.GenerateSm label genScheme [] app_concsms], used)
 573   }
 574
 575 genFoldl :: BuiltinBuilder
 576 genFoldl = genFold True
 577
 578 genFoldr :: BuiltinBuilder
 579 genFoldr = genFold False
 580
 581 genFold :: Bool -> BuiltinBuilder
 582 genFold left = genVarArgs (genFold' left)
 583
 584 genFold' :: Bool -> (Either CoreSyn.CoreBndr AST.VHDLName) -> CoreSyn.CoreBndr -> [Var.Var] -> TranslatorSession ([AST.ConcSm], [CoreSyn.CoreBndr])
 585 genFold' left res f args@[folded_f , start ,vec]= do
 586   len <- MonadState.lift tsType $ tfp_to_int $ (tfvec_len_ty (Var.varType vec))
 587   genFold'' len left res f args
 588
 589 genFold'' :: Int -> Bool -> (Either CoreSyn.CoreBndr AST.VHDLName) -> CoreSyn.CoreBndr -> [Var.Var] -> TranslatorSession ([AST.ConcSm], [CoreSyn.CoreBndr])
 590 -- Special case for an empty input vector, just assign start to res
 591 genFold'' len left (Left res) _ [_, start, vec] | len == 0 = do
 592   arg <- MonadState.lift tsType $ varToVHDLExpr start
 593   return ([mkUncondAssign (Left res) arg], [])
 594
 595 genFold'' len left (Left res) f [folded_f, start, vec] = do
 596   -- The vector length
 597   --len <- MonadState.lift tsType $ tfp_to_int $ (tfvec_len_ty . Var.varType) vec
 598   -- An expression for len-1
 599   let len_min_expr = (AST.PrimLit $ show (len-1))
 600   -- evec is (TFVec n), so it still needs an element type
 601   let (nvec, _) = Type.splitAppTy (Var.varType vec)
 602   -- Put the type of the start value in nvec, this will be the type of our
 603   -- temporary vector
 604   let tmp_ty = Type.mkAppTy nvec (Var.varType start)
 605   let error_msg = "\nGenerate.genFold': Can not construct temp vector for element type: " ++ pprString tmp_ty
 606   -- TODO: Handle Nothing
 607   Just tmp_vhdl_ty <- MonadState.lift tsType $ vhdlTy error_msg tmp_ty
 608   -- Setup the generate scheme
 609   let gen_label = mkVHDLExtId ("foldlVector" ++ (varToString vec))
 610   let block_label = mkVHDLExtId ("foldlVector" ++ (varToString res))
 611   let gen_range = if left then AST.ToRange (AST.PrimLit "0") len_min_expr
 612                   else AST.DownRange len_min_expr (AST.PrimLit "0")
 613   let gen_scheme   = AST.ForGn n_id gen_range
 614   -- Make the intermediate vector
 615   let  tmp_dec     = AST.BDISD $ AST.SigDec tmp_id tmp_vhdl_ty Nothing
 616   -- Create the generate statement
 617   cells' <- sequence [genFirstCell, genOtherCell]
 618   let (cells, useds) = unzip cells'
 619   let gen_sm = AST.GenerateSm gen_label gen_scheme [] (map AST.CSGSm cells)
 620   -- Assign tmp[len-1] or tmp[0] to res
 621   let out_assign = mkUncondAssign (Left res) $ vhdlNameToVHDLExpr (if left then
 622                     (mkIndexedName tmp_name (AST.PrimLit $ show (len-1))) else
 623                     (mkIndexedName tmp_name (AST.PrimLit "0")))
 624   let block = AST.BlockSm block_label [] (AST.PMapAspect []) [tmp_dec] [AST.CSGSm gen_sm, out_assign]
 625   return ([AST.CSBSm block], concat useds)
 626   where
 627     -- An id for the counter
 628     n_id = mkVHDLBasicId "n"
 629     n_cur = idToVHDLExpr n_id
 630     -- An expression for previous n
 631     n_prev = if left then (n_cur AST.:-: (AST.PrimLit "1"))
 632                      else (n_cur AST.:+: (AST.PrimLit "1"))
 633     -- An id for the tmp result vector
 634     tmp_id = mkVHDLBasicId "tmp"
 635     tmp_name = AST.NSimple tmp_id
 636     -- Generate parts of the fold
 637     genFirstCell, genOtherCell :: TranslatorSession (AST.GenerateSm, [CoreSyn.CoreBndr])
 638     genFirstCell = do
 639       len <- MonadState.lift tsType $ tfp_to_int $ (tfvec_len_ty . Var.varType) vec
 640       let cond_label = mkVHDLExtId "firstcell"
 641       -- if n == 0 or n == len-1
 642       let cond_scheme = AST.IfGn $ n_cur AST.:=: (if left then (AST.PrimLit "0")
 643                                                   else (AST.PrimLit $ show (len-1)))
 644       -- Output to tmp[current n]
 645       let resname = mkIndexedName tmp_name n_cur
 646       -- Input from start
 647       argexpr1 <- MonadState.lift tsType $ varToVHDLExpr start
 648       -- Input from vec[current n]
 649       let argexpr2 = vhdlNameToVHDLExpr $ mkIndexedName (varToVHDLName vec) n_cur
 650       (app_concsms, used) <- genApplication (Right resname) folded_f  ( if left then
 651                                                                   [Right argexpr1, Right argexpr2]
 652                                                                 else
 653                                                                   [Right argexpr2, Right argexpr1]
 654                                                               )
 655       -- Return the conditional generate part
 656       return $ (AST.GenerateSm cond_label cond_scheme [] app_concsms, used)
 657
 658     genOtherCell = do
 659       len <- MonadState.lift tsType $ tfp_to_int $ (tfvec_len_ty . Var.varType) vec
 660       let cond_label = mkVHDLExtId "othercell"
 661       -- if n > 0 or n < len-1
 662       let cond_scheme = AST.IfGn $ n_cur AST.:/=: (if left then (AST.PrimLit "0")
 663                                                    else (AST.PrimLit $ show (len-1)))
 664       -- Output to tmp[current n]
 665       let resname = mkIndexedName tmp_name n_cur
 666       -- Input from tmp[previous n]
 667       let argexpr1 = vhdlNameToVHDLExpr $ mkIndexedName tmp_name n_prev
 668       -- Input from vec[current n]
 669       let argexpr2 = vhdlNameToVHDLExpr $ mkIndexedName (varToVHDLName vec) n_cur
 670       (app_concsms, used) <- genApplication (Right resname) folded_f  ( if left then
 671                                                                   [Right argexpr1, Right argexpr2]
 672                                                                 else
 673                                                                   [Right argexpr2, Right argexpr1]
 674                                                               )
 675       -- Return the conditional generate part
 676       return $ (AST.GenerateSm cond_label cond_scheme [] app_concsms, used)
 677
 678 -- | Generate a generate statement for the builtin function "zip"
 679 genZip :: BuiltinBuilder
 680 genZip = genNoInsts $ genVarArgs genZip'
 681 genZip' :: (Either CoreSyn.CoreBndr AST.VHDLName) -> CoreSyn.CoreBndr -> [Var.Var] -> TranslatorSession [AST.ConcSm]
 682 genZip' (Left res) f args@[arg1, arg2] = do {
 683     -- Setup the generate scheme
 684   ; len <- MonadState.lift tsType $ tfp_to_int $ (tfvec_len_ty . Var.varType) res
 685           -- TODO: Use something better than varToString
 686   ; let { label           = mkVHDLExtId ("zipVector" ++ (varToString res))
 687         ; n_id            = mkVHDLBasicId "n"
 688         ; n_expr          = idToVHDLExpr n_id
 689         ; range           = AST.ToRange (AST.PrimLit "0") (AST.PrimLit $ show (len-1))
 690         ; genScheme       = AST.ForGn n_id range
 691         ; resname'        = mkIndexedName (varToVHDLName res) n_expr
 692         ; argexpr1        = vhdlNameToVHDLExpr $ mkIndexedName (varToVHDLName arg1) n_expr
 693         ; argexpr2        = vhdlNameToVHDLExpr $ mkIndexedName (varToVHDLName arg2) n_expr
 694         } ;
 695   ; labels <- MonadState.lift tsType $ getFieldLabels (tfvec_elem (Var.varType res))
 696   ; let { resnameA    = mkSelectedName resname' (labels!!0)
 697         ; resnameB    = mkSelectedName resname' (labels!!1)
 698         ; resA_assign = mkUncondAssign (Right resnameA) argexpr1
 699         ; resB_assign = mkUncondAssign (Right resnameB) argexpr2
 700         } ;
 701     -- Return the generate functions
 702   ; return [AST.CSGSm $ AST.GenerateSm label genScheme [] [resA_assign,resB_assign]]
 703   }
 704
 705 -- | Generate a generate statement for the builtin function "fst"
 706 genFst :: BuiltinBuilder
 707 genFst = genNoInsts $ genVarArgs genFst'
 708 genFst' :: (Either CoreSyn.CoreBndr AST.VHDLName) -> CoreSyn.CoreBndr -> [Var.Var] -> TranslatorSession [AST.ConcSm]
 709 genFst' (Left res) f args@[arg] = do {
 710   ; labels <- MonadState.lift tsType $ getFieldLabels (Var.varType arg)
 711   ; let { argexpr'    = varToVHDLName arg
 712         ; argexprA    = vhdlNameToVHDLExpr $ mkSelectedName argexpr' (labels!!0)
 713         ; assign      = mkUncondAssign (Left res) argexprA
 714         } ;
 715     -- Return the generate functions
 716   ; return [assign]
 717   }
 718
 719 -- | Generate a generate statement for the builtin function "snd"
 720 genSnd :: BuiltinBuilder
 721 genSnd = genNoInsts $ genVarArgs genSnd'
 722 genSnd' :: (Either CoreSyn.CoreBndr AST.VHDLName) -> CoreSyn.CoreBndr -> [Var.Var] -> TranslatorSession [AST.ConcSm]
 723 genSnd' (Left res) f args@[arg] = do {
 724   ; labels <- MonadState.lift tsType $ getFieldLabels (Var.varType arg)
 725   ; let { argexpr'    = varToVHDLName arg
 726         ; argexprB    = vhdlNameToVHDLExpr $ mkSelectedName argexpr' (labels!!1)
 727         ; assign      = mkUncondAssign (Left res) argexprB
 728         } ;
 729     -- Return the generate functions
 730   ; return [assign]
 731   }
 732
 733 -- | Generate a generate statement for the builtin function "unzip"
 734 genUnzip :: BuiltinBuilder
 735 genUnzip = genNoInsts $ genVarArgs genUnzip'
 736 genUnzip' :: (Either CoreSyn.CoreBndr AST.VHDLName) -> CoreSyn.CoreBndr -> [Var.Var] -> TranslatorSession [AST.ConcSm]
 737 genUnzip' (Left res) f args@[arg] = do {
 738     -- Setup the generate scheme
 739   ; len <- MonadState.lift tsType $ tfp_to_int $ (tfvec_len_ty . Var.varType) arg
 740     -- TODO: Use something better than varToString
 741   ; let { label           = mkVHDLExtId ("unzipVector" ++ (varToString res))
 742         ; n_id            = mkVHDLBasicId "n"
 743         ; n_expr          = idToVHDLExpr n_id
 744         ; range           = AST.ToRange (AST.PrimLit "0") (AST.PrimLit $ show (len-1))
 745         ; genScheme       = AST.ForGn n_id range
 746         ; resname'        = varToVHDLName res
 747         ; argexpr'        = mkIndexedName (varToVHDLName arg) n_expr
 748         } ;
 749   ; reslabels <- MonadState.lift tsType $ getFieldLabels (Var.varType res)
 750   ; arglabels <- MonadState.lift tsType $ getFieldLabels (tfvec_elem (Var.varType arg))
 751   ; let { resnameA    = mkIndexedName (mkSelectedName resname' (reslabels!!0)) n_expr
 752         ; resnameB    = mkIndexedName (mkSelectedName resname' (reslabels!!1)) n_expr
 753         ; argexprA    = vhdlNameToVHDLExpr $ mkSelectedName argexpr' (arglabels!!0)
 754         ; argexprB    = vhdlNameToVHDLExpr $ mkSelectedName argexpr' (arglabels!!1)
 755         ; resA_assign = mkUncondAssign (Right resnameA) argexprA
 756         ; resB_assign = mkUncondAssign (Right resnameB) argexprB
 757         } ;
 758     -- Return the generate functions
 759   ; return [AST.CSGSm $ AST.GenerateSm label genScheme [] [resA_assign,resB_assign]]
 760   }
 761
 762 genCopy :: BuiltinBuilder
 763 genCopy = genNoInsts $ genVarArgs genCopy'
 764 genCopy' :: (Either CoreSyn.CoreBndr AST.VHDLName ) -> CoreSyn.CoreBndr -> [Var.Var] -> TranslatorSession [AST.ConcSm]
 765 genCopy' (Left res) f args@[arg] =
 766   let
 767     resExpr = AST.Aggregate [AST.ElemAssoc (Just AST.Others)
 768                 (AST.PrimName $ (varToVHDLName arg))]
 769     out_assign = mkUncondAssign (Left res) resExpr
 770   in
 771     return [out_assign]
 772
 773 genConcat :: BuiltinBuilder
 774 genConcat = genNoInsts $ genVarArgs genConcat'
 775 genConcat' :: (Either CoreSyn.CoreBndr AST.VHDLName) -> CoreSyn.CoreBndr -> [Var.Var] -> TranslatorSession [AST.ConcSm]
 776 genConcat' (Left res) f args@[arg] = do {
 777     -- Setup the generate scheme
 778   ; len1 <- MonadState.lift tsType $ tfp_to_int $ (tfvec_len_ty . Var.varType) arg
 779   ; let (_, nvec) = Type.splitAppTy (Var.varType arg)
 780   ; len2 <- MonadState.lift tsType $ tfp_to_int $ tfvec_len_ty nvec
 781           -- TODO: Use something better than varToString
 782   ; let { label       = mkVHDLExtId ("concatVector" ++ (varToString res))
 783         ; n_id        = mkVHDLBasicId "n"
 784         ; n_expr      = idToVHDLExpr n_id
 785         ; fromRange   = n_expr AST.:*: (AST.PrimLit $ show len2)
 786         ; genScheme   = AST.ForGn n_id range
 787           -- Create the content of the generate statement: Applying the mapped_f to
 788           -- each of the elements in arg, storing to each element in res
 789         ; toRange     = (n_expr AST.:*: (AST.PrimLit $ show len2)) AST.:+: (AST.PrimLit $ show (len2-1))
 790         ; range       = AST.ToRange (AST.PrimLit "0") (AST.PrimLit $ show (len1-1))
 791         ; resname     = vecSlice fromRange toRange
 792         ; argexpr     = vhdlNameToVHDLExpr $ mkIndexedName (varToVHDLName arg) n_expr
 793         ; out_assign  = mkUncondAssign (Right resname) argexpr
 794         } ;
 795     -- Return the generate statement
 796   ; return [AST.CSGSm $ AST.GenerateSm label genScheme [] [out_assign]]
 797   }
 798   where
 799     vecSlice init last =  AST.NSlice (AST.SliceName (varToVHDLName res)
 800                             (AST.ToRange init last))
 801
 802 genIteraten :: BuiltinBuilder
 803 genIteraten dst f args = genIterate dst f (tail args)
 804
 805 genIterate :: BuiltinBuilder
 806 genIterate = genIterateOrGenerate True
 807
 808 genGeneraten :: BuiltinBuilder
 809 genGeneraten dst f args = genGenerate dst f (tail args)
 810
 811 genGenerate :: BuiltinBuilder
 812 genGenerate = genIterateOrGenerate False
 813
 814 genIterateOrGenerate :: Bool -> BuiltinBuilder
 815 genIterateOrGenerate iter = genVarArgs (genIterateOrGenerate' iter)
 816
 817 genIterateOrGenerate' :: Bool -> (Either CoreSyn.CoreBndr AST.VHDLName) -> CoreSyn.CoreBndr -> [Var.Var] -> TranslatorSession ([AST.ConcSm], [CoreSyn.CoreBndr])
 818 genIterateOrGenerate' iter (Left res) f args = do
 819   len <- MonadState.lift tsType $ tfp_to_int ((tfvec_len_ty . Var.varType) res)
 820   genIterateOrGenerate'' len iter (Left res) f args
 821
 822 genIterateOrGenerate'' :: Int -> Bool -> (Either CoreSyn.CoreBndr AST.VHDLName) -> CoreSyn.CoreBndr -> [Var.Var] -> TranslatorSession ([AST.ConcSm], [CoreSyn.CoreBndr])
 823 -- Special case for an empty input vector, just assign start to res
 824 genIterateOrGenerate'' len iter (Left res) _ [app_f, start] | len == 0 = return ([mkUncondAssign (Left res) (AST.PrimLit "\"\"")], [])
 825
 826 genIterateOrGenerate'' len iter (Left res) f [app_f, start] = do
 827   -- The vector length
 828   -- len <- MonadState.lift tsType $ tfp_to_int ((tfvec_len_ty . Var.varType) res)
 829   -- An expression for len-1
 830   let len_min_expr = (AST.PrimLit $ show (len-1))
 831   -- -- evec is (TFVec n), so it still needs an element type
 832   -- let (nvec, _) = splitAppTy (Var.varType vec)
 833   -- -- Put the type of the start value in nvec, this will be the type of our
 834   -- -- temporary vector
 835   let tmp_ty = Var.varType res
 836   let error_msg = "\nGenerate.genFold': Can not construct temp vector for element type: " ++ pprString tmp_ty
 837   -- TODO: Handle Nothing
 838   Just tmp_vhdl_ty <- MonadState.lift tsType $ vhdlTy error_msg tmp_ty
 839   -- Setup the generate scheme
 840   let gen_label = mkVHDLExtId ("iterateVector" ++ (varToString start))
 841   let block_label = mkVHDLExtId ("iterateVector" ++ (varToString res))
 842   let gen_range = AST.ToRange (AST.PrimLit "0") len_min_expr
 843   let gen_scheme   = AST.ForGn n_id gen_range
 844   -- Make the intermediate vector
 845   let  tmp_dec     = AST.BDISD $ AST.SigDec tmp_id tmp_vhdl_ty Nothing
 846   -- Create the generate statement
 847   cells' <- sequence [genFirstCell, genOtherCell]
 848   let (cells, useds) = unzip cells'
 849   let gen_sm = AST.GenerateSm gen_label gen_scheme [] (map AST.CSGSm cells)
 850   -- Assign tmp[len-1] or tmp[0] to res
 851   let out_assign = mkUncondAssign (Left res) $ vhdlNameToVHDLExpr tmp_name
 852   let block = AST.BlockSm block_label [] (AST.PMapAspect []) [tmp_dec] [AST.CSGSm gen_sm, out_assign]
 853   return ([AST.CSBSm block], concat useds)
 854   where
 855     -- An id for the counter
 856     n_id = mkVHDLBasicId "n"
 857     n_cur = idToVHDLExpr n_id
 858     -- An expression for previous n
 859     n_prev = n_cur AST.:-: (AST.PrimLit "1")
 860     -- An id for the tmp result vector
 861     tmp_id = mkVHDLBasicId "tmp"
 862     tmp_name = AST.NSimple tmp_id
 863     -- Generate parts of the fold
 864     genFirstCell, genOtherCell :: TranslatorSession (AST.GenerateSm, [CoreSyn.CoreBndr])
 865     genFirstCell = do
 866       let cond_label = mkVHDLExtId "firstcell"
 867       -- if n == 0 or n == len-1
 868       let cond_scheme = AST.IfGn $ n_cur AST.:=: (AST.PrimLit "0")
 869       -- Output to tmp[current n]
 870       let resname = mkIndexedName tmp_name n_cur
 871       -- Input from start
 872       argexpr <- MonadState.lift tsType $ varToVHDLExpr start
 873       let startassign = mkUncondAssign (Right resname) argexpr
 874       (app_concsms, used) <- genApplication (Right resname) app_f  [Right argexpr]
 875       -- Return the conditional generate part
 876       let gensm = AST.GenerateSm cond_label cond_scheme [] (if iter then
 877                                                           [startassign]
 878                                                          else
 879                                                           app_concsms
 880                                                         )
 881       return (gensm, used)
 882
 883     genOtherCell = do
 884       let cond_label = mkVHDLExtId "othercell"
 885       -- if n > 0 or n < len-1
 886       let cond_scheme = AST.IfGn $ n_cur AST.:/=: (AST.PrimLit "0")
 887       -- Output to tmp[current n]
 888       let resname = mkIndexedName tmp_name n_cur
 889       -- Input from tmp[previous n]
 890       let argexpr = vhdlNameToVHDLExpr $ mkIndexedName tmp_name n_prev
 891       (app_concsms, used) <- genApplication (Right resname) app_f [Right argexpr]
 892       -- Return the conditional generate part
 893       return $ (AST.GenerateSm cond_label cond_scheme [] app_concsms, used)
 894
 895 genBlockRAM :: BuiltinBuilder
 896 genBlockRAM = genNoInsts $ genExprArgs genBlockRAM'
 897
 898 genBlockRAM' :: (Either CoreSyn.CoreBndr AST.VHDLName) -> CoreSyn.CoreBndr -> [AST.Expr] -> TranslatorSession [AST.ConcSm]
 899 genBlockRAM' (Left res) f args@[data_in,rdaddr,wraddr,wrenable] = do
 900   -- Get the ram type
 901   let (tup,data_out) = Type.splitAppTy (Var.varType res)
 902   let (tup',ramvec) = Type.splitAppTy tup
 903   let Just realram = Type.coreView ramvec
 904   let Just (tycon, types) = Type.splitTyConApp_maybe realram
 905   Just ram_vhdl_ty <- MonadState.lift tsType $ vhdlTy "wtf" (head types)
 906   -- Make the intermediate vector
 907   let ram_dec = AST.BDISD $ AST.SigDec ram_id ram_vhdl_ty Nothing
 908   -- Get the data_out name
 909   -- reslabels <- MonadState.lift tsType $ getFieldLabels (Var.varType res)
 910   let resname = varToVHDLName res
 911   -- let resname = mkSelectedName resname' (reslabels!!0)
 912   let rdaddr_int = genExprFCall (mkVHDLBasicId toIntegerId) rdaddr
 913   let argexpr = vhdlNameToVHDLExpr $ mkIndexedName (AST.NSimple ram_id) rdaddr_int
 914   let assign = mkUncondAssign (Right resname) argexpr
 915   let block_label = mkVHDLExtId ("blockRAM" ++ (varToString res))
 916   let block = AST.BlockSm block_label [] (AST.PMapAspect []) [ram_dec] [assign, mkUpdateProcSm]
 917   return [AST.CSBSm block]
 918   where
 919     ram_id = mkVHDLBasicId "ram"
 920     mkUpdateProcSm :: AST.ConcSm
 921     mkUpdateProcSm = AST.CSPSm $ AST.ProcSm proclabel [clockId] [statement]
 922       where
 923         proclabel   = mkVHDLBasicId "updateRAM"
 924         rising_edge = mkVHDLBasicId "rising_edge"
 925         wraddr_int  = genExprFCall (mkVHDLBasicId toIntegerId) wraddr
 926         ramloc      = mkIndexedName (AST.NSimple ram_id) wraddr_int
 927         wform       = AST.Wform [AST.WformElem data_in Nothing]
 928         ramassign      = AST.SigAssign ramloc wform
 929         rising_edge_clk = genExprFCall rising_edge (AST.PrimName $ AST.NSimple clockId)
 930         statement   = AST.IfSm (AST.And rising_edge_clk wrenable) [ramassign] [] Nothing
 931
 932 genSplit :: BuiltinBuilder
 933 genSplit = genNoInsts $ genVarArgs genSplit'
 934
 935 genSplit' :: (Either CoreSyn.CoreBndr AST.VHDLName) -> CoreSyn.CoreBndr -> [Var.Var] -> TranslatorSession [AST.ConcSm]
 936 genSplit' (Left res) f args@[vecIn] = do {
 937   ; labels <- MonadState.lift tsType $ getFieldLabels (Var.varType res)
 938   ; len <- MonadState.lift tsType $ tfp_to_int $ (tfvec_len_ty . Var.varType) vecIn
 939   ; let { block_label = mkVHDLExtId ("split" ++ (varToString vecIn))
 940         ; halflen   = round ((fromIntegral len) / 2)
 941         ; rangeL    = vecSlice (AST.PrimLit "0") (AST.PrimLit $ show (halflen - 1))
 942         ; rangeR    = vecSlice (AST.PrimLit $ show halflen) (AST.PrimLit $ show (len - 1))
 943         ; resname   = varToVHDLName res
 944         ; resnameL  = mkSelectedName resname (labels!!0)
 945         ; resnameR  = mkSelectedName resname (labels!!1)
 946         ; argexprL  = vhdlNameToVHDLExpr rangeL
 947         ; argexprR  = vhdlNameToVHDLExpr rangeR
 948         ; out_assignL = mkUncondAssign (Right resnameL) argexprL
 949         ; out_assignR = mkUncondAssign (Right resnameR) argexprR
 950         ; block = AST.BlockSm block_label [] (AST.PMapAspect []) [] [out_assignL, out_assignR]
 951         }
 952   ; return [AST.CSBSm block]
 953   }
 954   where
 955     vecSlice init last =  AST.NSlice (AST.SliceName (varToVHDLName res)
 956                             (AST.ToRange init last))
 957 -----------------------------------------------------------------------------
 958 -- Function to generate VHDL for applications
 959 -----------------------------------------------------------------------------
 960 genApplication ::
 961   (Either CoreSyn.CoreBndr AST.VHDLName) -- ^ Where to store the result?
 962   -> CoreSyn.CoreBndr -- ^ The function to apply
 963   -> [Either CoreSyn.CoreExpr AST.Expr] -- ^ The arguments to apply
 964   -> TranslatorSession ([AST.ConcSm], [CoreSyn.CoreBndr])
 965   -- ^ The corresponding VHDL concurrent statements and entities
 966   --   instantiated.
 967 genApplication dst f args = do
 968   case Var.isGlobalId f of
 969     False -> do
 970       top <- isTopLevelBinder f
 971       case top of
 972         True -> do
 973           -- Local binder that references a top level binding.  Generate a
 974           -- component instantiation.
 975           signature <- getEntity f
 976           args' <- argsToVHDLExprs args
 977           let entity_id = ent_id signature
 978           -- TODO: Using show here isn't really pretty, but we'll need some
 979           -- unique-ish value...
 980           let label = "comp_ins_" ++ (either (prettyShow . varToVHDLName) prettyShow) dst
 981           let portmaps = mkAssocElems args' ((either varToVHDLName id) dst) signature
 982           return ([mkComponentInst label entity_id portmaps], [f])
 983         False -> do
 984           -- Not a top level binder, so this must be a local variable reference.
 985           -- It should have a representable type (and thus, no arguments) and a
 986           -- signal should be generated for it. Just generate an unconditional
 987           -- assignment here.
 988           f' <- MonadState.lift tsType $ varToVHDLExpr f
 989           return $ ([mkUncondAssign dst f'], [])
 990     True ->
 991       case Var.idDetails f of
 992         IdInfo.DataConWorkId dc -> case dst of
 993           -- It's a datacon. Create a record from its arguments.
 994           Left bndr -> do
 995             -- We have the bndr, so we can get at the type
 996             htype <- MonadState.lift tsType $ mkHTypeEither (Var.varType bndr)
 997             let argsNostate = filter (\x -> not (either hasStateType (\x -> False) x)) args
 998             case argsNostate of
 999               [arg] -> do
1000                 [arg'] <- argsToVHDLExprs [arg]
1001                 return $ ([mkUncondAssign dst arg'], [])
1002               otherwise -> do
1003                 case htype of
1004                   Right (AggrType _ _) -> do
1005                     labels <- MonadState.lift tsType $ getFieldLabels (Var.varType bndr)
1006                     args' <- argsToVHDLExprs argsNostate
1007                     return $ (zipWith mkassign labels $ args', [])
1008                     where
1009                       mkassign :: AST.VHDLId -> AST.Expr -> AST.ConcSm
1010                       mkassign label arg =
1011                         let sel_name = mkSelectedName ((either varToVHDLName id) dst) label in
1012                         mkUncondAssign (Right sel_name) arg
1013                   _ -> do -- error $ "DIE!"
1014                     args' <- argsToVHDLExprs argsNostate
1015                     return $ ([mkUncondAssign dst (head args')], [])
1016           Right _ -> error $ "\nGenerate.genApplication: Can't generate dataconstructor application without an original binder"
1017         IdInfo.DataConWrapId dc -> case dst of
1018           -- It's a datacon. Create a record from its arguments.
1019           Left bndr -> do
1020             case (Map.lookup (varToString f) globalNameTable) of
1021              Just (arg_count, builder) ->
1022               if length args == arg_count then
1023                 builder dst f args
1024               else
1025                 error $ "\nGenerate.genApplication(DataConWrapId): Incorrect number of arguments to builtin function: " ++ pprString f ++ " Args: " ++ show args
1026              Nothing -> error $ "\nGenerate.genApplication: Can't generate dataconwrapper: " ++ (show dc)
1027           Right _ -> error $ "\nGenerate.genApplication: Can't generate dataconwrapper application without an original binder"
1028         IdInfo.VanillaId -> do
1029           -- It's a global value imported from elsewhere. These can be builtin
1030           -- functions. Look up the function name in the name table and execute
1031           -- the associated builder if there is any and the argument count matches
1032           -- (this should always be the case if it typechecks, but just to be
1033           -- sure...).
1034           case (Map.lookup (varToString f) globalNameTable) of
1035             Just (arg_count, builder) ->
1036               if length args == arg_count then
1037                 builder dst f args
1038               else
1039                 error $ "\nGenerate.genApplication(VanillaId): Incorrect number of arguments to builtin function: " ++ pprString f ++ " Args: " ++ show args
1040             Nothing -> do
1041               top <- isTopLevelBinder f
1042               case top of
1043                 True -> do
1044                   -- Local binder that references a top level binding.  Generate a
1045                   -- component instantiation.
1046                   signature <- getEntity f
1047                   args' <- argsToVHDLExprs args
1048                   let entity_id = ent_id signature
1049                   -- TODO: Using show here isn't really pretty, but we'll need some
1050                   -- unique-ish value...
1051                   let label = "comp_ins_" ++ (either show prettyShow) dst
1052                   let portmaps = mkAssocElems args' ((either varToVHDLName id) dst) signature
1053                   return ([mkComponentInst label entity_id portmaps], [f])
1054                 False -> do
1055                   -- Not a top level binder, so this must be a local variable reference.
1056                   -- It should have a representable type (and thus, no arguments) and a
1057                   -- signal should be generated for it. Just generate an unconditional
1058                   -- assignment here.
1059                   -- FIXME : I DONT KNOW IF THE ABOVE COMMENT HOLDS HERE, SO FOR NOW JUST ERROR!
1060                   -- f' <- MonadState.lift tsType $ varToVHDLExpr f
1061                   --                   return $ ([mkUncondAssign dst f'], [])
1062                   errtype <- case dst of
1063                     Left bndr -> do
1064                       htype <- MonadState.lift tsType $ mkHTypeEither (Var.varType bndr)
1065                       return (show htype)
1066                     Right vhd -> return $ show vhd
1067                   error $ ("\nGenerate.genApplication(VanillaId): Using function from another module that is not a known builtin: " ++ (pprString f) ++ "::" ++ errtype)
1068         IdInfo.ClassOpId cls -> do
1069           -- FIXME: Not looking for what instance this class op is called for
1070           -- Is quite stupid of course.
1071           case (Map.lookup (varToString f) globalNameTable) of
1072             Just (arg_count, builder) ->
1073               if length args == arg_count then
1074                 builder dst f args
1075               else
1076                 error $ "\nGenerate.genApplication(ClassOpId): Incorrect number of arguments to builtin function: " ++ pprString f ++ " Args: " ++ show args
1077             Nothing -> error $ "\nGenerate.genApplication(ClassOpId): Using function from another module that is not a known builtin: " ++ pprString f
1078         details -> error $ "\nGenerate.genApplication: Calling unsupported function " ++ pprString f ++ " with GlobalIdDetails " ++ pprString details
1079
1080 -----------------------------------------------------------------------------
1081 -- Functions to generate functions dealing with vectors.
1082 -----------------------------------------------------------------------------
1083
1084 -- Returns the VHDLId of the vector function with the given name for the given
1085 -- element type. Generates -- this function if needed.
1086 vectorFunId :: Type.Type -> String -> TypeSession AST.VHDLId
1087 vectorFunId el_ty fname = do
1088   let error_msg = "\nGenerate.vectorFunId: Can not construct vector function for element: " ++ pprString el_ty
1089   -- TODO: Handle the Nothing case?
1090   Just elemTM <- vhdlTy error_msg el_ty
1091   -- TODO: This should not be duplicated from mk_vector_ty. Probably but it in
1092   -- the VHDLState or something.
1093   let vectorTM = mkVHDLExtId $ "vector_" ++ (AST.fromVHDLId elemTM)
1094   typefuns <- MonadState.get tsTypeFuns
1095   el_htype <- mkHType error_msg el_ty
1096   case Map.lookup (UVecType el_htype, fname) typefuns of
1097     -- Function already generated, just return it
1098     Just (id, _) -> return id
1099     -- Function not generated yet, generate it
1100     Nothing -> do
1101       let functions = genUnconsVectorFuns elemTM vectorTM
1102       case lookup fname functions of
1103         Just body -> do
1104           MonadState.modify tsTypeFuns $ Map.insert (UVecType el_htype, fname) (function_id, (fst body))
1105           mapM_ (vectorFunId el_ty) (snd body)
1106           return function_id
1107         Nothing -> error $ "\nGenerate.vectorFunId: I don't know how to generate vector function " ++ fname
1108   where
1109     function_id = mkVHDLExtId fname
1110
1111 genUnconsVectorFuns :: AST.TypeMark -- ^ type of the vector elements
1112                     -> AST.TypeMark -- ^ type of the vector
1113                     -> [(String, (AST.SubProgBody, [String]))]
1114 genUnconsVectorFuns elemTM vectorTM  =
1115   [ (exId, (AST.SubProgBody exSpec      []                  [exExpr],[]))
1116   , (replaceId, (AST.SubProgBody replaceSpec [AST.SPVD replaceVar] [replaceExpr1,replaceExpr2,replaceRet],[]))
1117   , (lastId, (AST.SubProgBody lastSpec    []                  [lastExpr],[]))
1118   , (initId, (AST.SubProgBody initSpec    [AST.SPVD initVar]  [initExpr, initRet],[]))
1119   , (minimumId, (AST.SubProgBody minimumSpec [] [minimumExpr],[]))
1120   , (takeId, (AST.SubProgBody takeSpec    [AST.SPVD takeVar]  [takeExpr, takeRet],[minimumId]))
1121   , (dropId, (AST.SubProgBody dropSpec    [AST.SPVD dropVar]  [dropExpr, dropRet],[]))
1122   , (plusgtId, (AST.SubProgBody plusgtSpec  [AST.SPVD plusgtVar] [plusgtExpr, plusgtRet],[]))
1123   , (emptyId, (AST.SubProgBody emptySpec   [AST.SPVD emptyVar] [emptyExpr],[]))
1124   , (singletonId, (AST.SubProgBody singletonSpec [AST.SPVD singletonVar] [singletonRet],[]))
1125   , (copynId, (AST.SubProgBody copynSpec    [AST.SPVD copynVar]      [copynExpr],[]))
1126   , (selId, (AST.SubProgBody selSpec  [AST.SPVD selVar] [selFor, selRet],[]))
1127   , (ltplusId, (AST.SubProgBody ltplusSpec [AST.SPVD ltplusVar] [ltplusExpr, ltplusRet],[]))
1128   , (plusplusId, (AST.SubProgBody plusplusSpec [AST.SPVD plusplusVar] [plusplusExpr, plusplusRet],[]))
1129   , (lengthTId, (AST.SubProgBody lengthTSpec [] [lengthTExpr],[]))
1130   , (shiftlId, (AST.SubProgBody shiftlSpec [AST.SPVD shiftlVar] [shiftlExpr, shiftlRet], [initId]))
1131   , (shiftrId, (AST.SubProgBody shiftrSpec [AST.SPVD shiftrVar] [shiftrExpr, shiftrRet], [tailId]))
1132   , (nullId, (AST.SubProgBody nullSpec [] [nullExpr], []))
1133   , (rotlId, (AST.SubProgBody rotlSpec [AST.SPVD rotlVar] [rotlExpr, rotlRet], [nullId, lastId, initId]))
1134   , (rotrId, (AST.SubProgBody rotrSpec [AST.SPVD rotrVar] [rotrExpr, rotrRet], [nullId, tailId, headId]))
1135   , (reverseId, (AST.SubProgBody reverseSpec [AST.SPVD reverseVar] [reverseFor, reverseRet], []))
1136   ]
1137   where
1138     ixPar   = AST.unsafeVHDLBasicId "ix"
1139     vecPar  = AST.unsafeVHDLBasicId "vec"
1140     vec1Par = AST.unsafeVHDLBasicId "vec1"
1141     vec2Par = AST.unsafeVHDLBasicId "vec2"
1142     nPar    = AST.unsafeVHDLBasicId "n"
1143     leftPar = AST.unsafeVHDLBasicId "nLeft"
1144     rightPar = AST.unsafeVHDLBasicId "nRight"
1145     iId     = AST.unsafeVHDLBasicId "i"
1146     iPar    = iId
1147     aPar    = AST.unsafeVHDLBasicId "a"
1148     fPar = AST.unsafeVHDLBasicId "f"
1149     sPar = AST.unsafeVHDLBasicId "s"
1150     resId   = AST.unsafeVHDLBasicId "res"
1151     exSpec = AST.Function (mkVHDLExtId exId) [AST.IfaceVarDec vecPar vectorTM,
1152                                AST.IfaceVarDec ixPar  unsignedTM] elemTM
1153     exExpr = AST.ReturnSm (Just $ AST.PrimName $ AST.NIndexed
1154               (AST.IndexedName (AST.NSimple vecPar) [genExprFCall (mkVHDLBasicId toIntegerId) (AST.PrimName $ AST.NSimple $ ixPar)]))
1155     replaceSpec = AST.Function (mkVHDLExtId replaceId)  [ AST.IfaceVarDec vecPar vectorTM
1156                                           , AST.IfaceVarDec iPar   unsignedTM
1157                                           , AST.IfaceVarDec aPar   elemTM
1158                                           ] vectorTM
1159        -- variable res : fsvec_x (0 to vec'length-1);
1160     replaceVar =
1161          AST.VarDec resId
1162                 (AST.SubtypeIn vectorTM
1163                   (Just $ AST.ConstraintIndex $ AST.IndexConstraint
1164                    [AST.ToRange (AST.PrimLit "0")
1165                             (AST.PrimName (AST.NAttribute $
1166                               AST.AttribName (AST.NSimple vecPar) (AST.NSimple $ mkVHDLBasicId lengthId) Nothing) AST.:-:
1167                                 (AST.PrimLit "1"))   ]))
1168                 Nothing
1169        --  res AST.:= vec(0 to i-1) & a & vec(i+1 to length'vec-1)
1170     replaceExpr1 = AST.NSimple resId AST.:= AST.PrimName (AST.NSimple vecPar)
1171     replaceExpr2 = AST.NIndexed (AST.IndexedName (AST.NSimple resId) [genExprFCall (mkVHDLBasicId toIntegerId) (AST.PrimName $ AST.NSimple $ iPar)]) AST.:= AST.PrimName (AST.NSimple aPar)
1172     replaceRet =  AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple resId)
1173     vecSlice init last =  AST.PrimName (AST.NSlice
1174                                         (AST.SliceName
1175                                               (AST.NSimple vecPar)
1176                                               (AST.ToRange init last)))
1177     lastSpec = AST.Function (mkVHDLExtId lastId) [AST.IfaceVarDec vecPar vectorTM] elemTM
1178        -- return vec(vec'length-1);
1179     lastExpr = AST.ReturnSm (Just $ (AST.PrimName $ AST.NIndexed (AST.IndexedName
1180                     (AST.NSimple vecPar)
1181                     [AST.PrimName (AST.NAttribute $
1182                                 AST.AttribName (AST.NSimple vecPar) (AST.NSimple $ mkVHDLBasicId lengthId) Nothing)
1183                                                              AST.:-: AST.PrimLit "1"])))
1184     initSpec = AST.Function (mkVHDLExtId initId) [AST.IfaceVarDec vecPar vectorTM] vectorTM
1185        -- variable res : fsvec_x (0 to vec'length-2);
1186     initVar =
1187          AST.VarDec resId
1188                 (AST.SubtypeIn vectorTM
1189                   (Just $ AST.ConstraintIndex $ AST.IndexConstraint
1190                    [AST.ToRange (AST.PrimLit "0")
1191                             (AST.PrimName (AST.NAttribute $
1192                               AST.AttribName (AST.NSimple vecPar) (AST.NSimple $ mkVHDLBasicId lengthId) Nothing) AST.:-:
1193                                 (AST.PrimLit "2"))   ]))
1194                 Nothing
1195        -- resAST.:= vec(0 to vec'length-2)
1196     initExpr = AST.NSimple resId AST.:= (vecSlice
1197                                (AST.PrimLit "0")
1198                                (AST.PrimName (AST.NAttribute $
1199                                   AST.AttribName (AST.NSimple vecPar) (AST.NSimple $ mkVHDLBasicId lengthId) Nothing)
1200                                                              AST.:-: AST.PrimLit "2"))
1201     initRet =  AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple resId)
1202     minimumSpec = AST.Function (mkVHDLExtId minimumId) [AST.IfaceVarDec leftPar   naturalTM,
1203                                    AST.IfaceVarDec rightPar naturalTM ] naturalTM
1204     minimumExpr = AST.IfSm ((AST.PrimName $ AST.NSimple leftPar) AST.:<: (AST.PrimName $ AST.NSimple rightPar))
1205                         [AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple leftPar)]
1206                         []
1207                         (Just $ AST.Else [minimumExprRet])
1208       where minimumExprRet = AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple rightPar)
1209     takeSpec = AST.Function (mkVHDLExtId takeId) [AST.IfaceVarDec nPar   naturalTM,
1210                                    AST.IfaceVarDec vecPar vectorTM ] vectorTM
1211        -- variable res : fsvec_x (0 to (minimum (n,vec'length))-1);
1212     minLength = AST.PrimFCall $ AST.FCall (AST.NSimple (mkVHDLExtId minimumId))
1213                               [Nothing AST.:=>: AST.ADExpr (AST.PrimName $ AST.NSimple nPar)
1214                               ,Nothing AST.:=>: AST.ADExpr (AST.PrimName (AST.NAttribute $
1215                                 AST.AttribName (AST.NSimple vecPar) (AST.NSimple $ mkVHDLBasicId lengthId) Nothing))]
1216     takeVar =
1217          AST.VarDec resId
1218                 (AST.SubtypeIn vectorTM
1219                   (Just $ AST.ConstraintIndex $ AST.IndexConstraint
1220                    [AST.ToRange (AST.PrimLit "0")
1221                                (minLength AST.:-:
1222                                 (AST.PrimLit "1"))   ]))
1223                 Nothing
1224        -- res AST.:= vec(0 to n-1)
1225     takeExpr = AST.NSimple resId AST.:=
1226                     (vecSlice (AST.PrimLit "0")
1227                               (minLength AST.:-: AST.PrimLit "1"))
1228     takeRet =  AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple resId)
1229     dropSpec = AST.Function (mkVHDLExtId dropId) [AST.IfaceVarDec nPar   naturalTM,
1230                                    AST.IfaceVarDec vecPar vectorTM ] vectorTM
1231        -- variable res : fsvec_x (0 to vec'length-n-1);
1232     dropVar =
1233          AST.VarDec resId
1234                 (AST.SubtypeIn vectorTM
1235                   (Just $ AST.ConstraintIndex $ AST.IndexConstraint
1236                    [AST.ToRange (AST.PrimLit "0")
1237                             (AST.PrimName (AST.NAttribute $
1238                               AST.AttribName (AST.NSimple vecPar) (AST.NSimple $ mkVHDLBasicId lengthId) Nothing) AST.:-:
1239                                (AST.PrimName $ AST.NSimple nPar)AST.:-: (AST.PrimLit "1")) ]))
1240                Nothing
1241        -- res AST.:= vec(n to vec'length-1)
1242     dropExpr = AST.NSimple resId AST.:= (vecSlice
1243                                (AST.PrimName $ AST.NSimple nPar)
1244                                (AST.PrimName (AST.NAttribute $
1245                                   AST.AttribName (AST.NSimple vecPar) (AST.NSimple $ mkVHDLBasicId lengthId) Nothing)
1246                                                              AST.:-: AST.PrimLit "1"))
1247     dropRet =  AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple resId)
1248     plusgtSpec = AST.Function (mkVHDLExtId plusgtId) [AST.IfaceVarDec aPar   elemTM,
1249                                        AST.IfaceVarDec vecPar vectorTM] vectorTM
1250     -- variable res : fsvec_x (0 to vec'length);
1251     plusgtVar =
1252       AST.VarDec resId
1253              (AST.SubtypeIn vectorTM
1254                (Just $ AST.ConstraintIndex $ AST.IndexConstraint
1255                 [AST.ToRange (AST.PrimLit "0")
1256                         (AST.PrimName (AST.NAttribute $
1257                           AST.AttribName (AST.NSimple vecPar) (AST.NSimple $ mkVHDLBasicId lengthId) Nothing))]))
1258              Nothing
1259     plusgtExpr = AST.NSimple resId AST.:=
1260                    ((AST.PrimName $ AST.NSimple aPar) AST.:&:
1261                     (AST.PrimName $ AST.NSimple vecPar))
1262     plusgtRet = AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple resId)
1263     emptySpec = AST.Function (mkVHDLExtId emptyId) [] vectorTM
1264     emptyVar =
1265           AST.VarDec resId
1266             (AST.SubtypeIn vectorTM
1267               (Just $ AST.ConstraintIndex $ AST.IndexConstraint
1268                 [AST.ToRange (AST.PrimLit "0") (AST.PrimLit "-1")]))
1269              Nothing
1270     emptyExpr = AST.ReturnSm (Just $ AST.PrimName (AST.NSimple resId))
1271     singletonSpec = AST.Function (mkVHDLExtId singletonId) [AST.IfaceVarDec aPar elemTM ]
1272                                          vectorTM
1273     -- variable res : fsvec_x (0 to 0) := (others => a);
1274     singletonVar =
1275       AST.VarDec resId
1276              (AST.SubtypeIn vectorTM
1277                (Just $ AST.ConstraintIndex $ AST.IndexConstraint
1278                 [AST.ToRange (AST.PrimLit "0") (AST.PrimLit "0")]))
1279              (Just $ AST.Aggregate [AST.ElemAssoc (Just AST.Others)
1280                                           (AST.PrimName $ AST.NSimple aPar)])
1281     singletonRet = AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple resId)
1282     copynSpec = AST.Function (mkVHDLExtId copynId) [AST.IfaceVarDec nPar   naturalTM,
1283                                    AST.IfaceVarDec aPar   elemTM   ] vectorTM
1284     -- variable res : fsvec_x (0 to n-1) := (others => a);
1285     copynVar =
1286       AST.VarDec resId
1287              (AST.SubtypeIn vectorTM
1288                (Just $ AST.ConstraintIndex $ AST.IndexConstraint
1289                 [AST.ToRange (AST.PrimLit "0")
1290                             ((AST.PrimName (AST.NSimple nPar)) AST.:-:
1291                              (AST.PrimLit "1"))   ]))
1292              (Just $ AST.Aggregate [AST.ElemAssoc (Just AST.Others)
1293                                           (AST.PrimName $ AST.NSimple aPar)])
1294     -- return res
1295     copynExpr = AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple resId)
1296     selSpec = AST.Function (mkVHDLExtId selId) [AST.IfaceVarDec fPar   naturalTM,
1297                                AST.IfaceVarDec sPar   naturalTM,
1298                                AST.IfaceVarDec nPar   naturalTM,
1299                                AST.IfaceVarDec vecPar vectorTM ] vectorTM
1300     -- variable res : fsvec_x (0 to n-1);
1301     selVar =
1302       AST.VarDec resId
1303                 (AST.SubtypeIn vectorTM
1304                   (Just $ AST.ConstraintIndex $ AST.IndexConstraint
1305                     [AST.ToRange (AST.PrimLit "0")
1306                       ((AST.PrimName (AST.NSimple nPar)) AST.:-:
1307                       (AST.PrimLit "1"))   ])
1308                 )
1309                 Nothing
1310     -- for i res'range loop
1311     --   res(i) := vec(f+i*s);
1312     -- end loop;
1313     selFor = AST.ForSM iId (AST.AttribRange $ AST.AttribName (AST.NSimple resId) (AST.NSimple $ rangeId) Nothing) [selAssign]
1314     -- res(i) := vec(f+i*s);
1315     selAssign = let origExp = AST.PrimName (AST.NSimple fPar) AST.:+:
1316                                 (AST.PrimName (AST.NSimple iId) AST.:*:
1317                                   AST.PrimName (AST.NSimple sPar)) in
1318                                   AST.NIndexed (AST.IndexedName (AST.NSimple resId) [AST.PrimName (AST.NSimple iId)]) AST.:=
1319                                     (AST.PrimName $ AST.NIndexed (AST.IndexedName (AST.NSimple vecPar) [origExp]))
1320     -- return res;
1321     selRet =  AST.ReturnSm (Just $ AST.PrimName (AST.NSimple resId))
1322     ltplusSpec = AST.Function (mkVHDLExtId ltplusId) [AST.IfaceVarDec vecPar vectorTM,
1323                                         AST.IfaceVarDec aPar   elemTM] vectorTM
1324      -- variable res : fsvec_x (0 to vec'length);
1325     ltplusVar =
1326       AST.VarDec resId
1327         (AST.SubtypeIn vectorTM
1328           (Just $ AST.ConstraintIndex $ AST.IndexConstraint
1329             [AST.ToRange (AST.PrimLit "0")
1330               (AST.PrimName (AST.NAttribute $
1331                 AST.AttribName (AST.NSimple vecPar) (AST.NSimple $ mkVHDLBasicId lengthId) Nothing))]))
1332         Nothing
1333     ltplusExpr = AST.NSimple resId AST.:=
1334                      ((AST.PrimName $ AST.NSimple vecPar) AST.:&:
1335                       (AST.PrimName $ AST.NSimple aPar))
1336     ltplusRet = AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple resId)
1337     plusplusSpec = AST.Function (mkVHDLExtId plusplusId) [AST.IfaceVarDec vec1Par vectorTM,
1338                                              AST.IfaceVarDec vec2Par vectorTM]
1339                                              vectorTM
1340     -- variable res : fsvec_x (0 to vec1'length + vec2'length -1);
1341     plusplusVar =
1342       AST.VarDec resId
1343         (AST.SubtypeIn vectorTM
1344           (Just $ AST.ConstraintIndex $ AST.IndexConstraint
1345             [AST.ToRange (AST.PrimLit "0")
1346               (AST.PrimName (AST.NAttribute $
1347                 AST.AttribName (AST.NSimple vec1Par) (AST.NSimple $ mkVHDLBasicId lengthId) Nothing) AST.:+:
1348                   AST.PrimName (AST.NAttribute $
1349                 AST.AttribName (AST.NSimple vec2Par) (AST.NSimple $ mkVHDLBasicId lengthId) Nothing) AST.:-:
1350                   AST.PrimLit "1")]))
1351        Nothing
1352     plusplusExpr = AST.NSimple resId AST.:=
1353                      ((AST.PrimName $ AST.NSimple vec1Par) AST.:&:
1354                       (AST.PrimName $ AST.NSimple vec2Par))
1355     plusplusRet = AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple resId)
1356     lengthTSpec = AST.Function (mkVHDLExtId lengthTId) [AST.IfaceVarDec vecPar vectorTM] naturalTM
1357     lengthTExpr = AST.ReturnSm (Just $ AST.PrimName (AST.NAttribute $
1358                                 AST.AttribName (AST.NSimple vecPar) (AST.NSimple $ mkVHDLBasicId lengthId) Nothing))
1359     shiftlSpec = AST.Function (mkVHDLExtId shiftlId) [AST.IfaceVarDec vecPar vectorTM,
1360                                    AST.IfaceVarDec aPar   elemTM  ] vectorTM
1361     -- variable res : fsvec_x (0 to vec'length-1);
1362     shiftlVar =
1363      AST.VarDec resId
1364             (AST.SubtypeIn vectorTM
1365               (Just $ AST.ConstraintIndex $ AST.IndexConstraint
1366                [AST.ToRange (AST.PrimLit "0")
1367                         (AST.PrimName (AST.NAttribute $
1368                           AST.AttribName (AST.NSimple vecPar) (AST.NSimple $ mkVHDLBasicId lengthId) Nothing) AST.:-:
1369                            (AST.PrimLit "1")) ]))
1370             Nothing
1371     -- res := a & init(vec)
1372     shiftlExpr = AST.NSimple resId AST.:=
1373                     (AST.PrimName (AST.NSimple aPar) AST.:&:
1374                      (AST.PrimFCall $ AST.FCall (AST.NSimple (mkVHDLExtId initId))
1375                        [Nothing AST.:=>: AST.ADExpr (AST.PrimName $ AST.NSimple vecPar)]))
1376     shiftlRet = AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple resId)
1377     shiftrSpec = AST.Function (mkVHDLExtId shiftrId) [AST.IfaceVarDec vecPar vectorTM,
1378                                        AST.IfaceVarDec aPar   elemTM  ] vectorTM
1379     -- variable res : fsvec_x (0 to vec'length-1);
1380     shiftrVar =
1381      AST.VarDec resId
1382             (AST.SubtypeIn vectorTM
1383               (Just $ AST.ConstraintIndex $ AST.IndexConstraint
1384                [AST.ToRange (AST.PrimLit "0")
1385                         (AST.PrimName (AST.NAttribute $
1386                           AST.AttribName (AST.NSimple vecPar) (AST.NSimple $ mkVHDLBasicId lengthId) Nothing) AST.:-:
1387                            (AST.PrimLit "1")) ]))
1388             Nothing
1389     -- res := tail(vec) & a
1390     shiftrExpr = AST.NSimple resId AST.:=
1391                   ((AST.PrimFCall $ AST.FCall (AST.NSimple (mkVHDLExtId tailId))
1392                     [Nothing AST.:=>: AST.ADExpr (AST.PrimName $ AST.NSimple vecPar)]) AST.:&:
1393                   (AST.PrimName (AST.NSimple aPar)))
1394
1395     shiftrRet = AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple resId)
1396     nullSpec = AST.Function (mkVHDLExtId nullId) [AST.IfaceVarDec vecPar vectorTM] booleanTM
1397     -- return vec'length = 0
1398     nullExpr = AST.ReturnSm (Just $
1399                 AST.PrimName (AST.NAttribute $
1400                   AST.AttribName (AST.NSimple vecPar) (AST.NSimple $ mkVHDLBasicId lengthId) Nothing) AST.:=:
1401                     AST.PrimLit "0")
1402     rotlSpec = AST.Function (mkVHDLExtId rotlId) [AST.IfaceVarDec vecPar vectorTM] vectorTM
1403     -- variable res : fsvec_x (0 to vec'length-1);
1404     rotlVar =
1405      AST.VarDec resId
1406             (AST.SubtypeIn vectorTM
1407               (Just $ AST.ConstraintIndex $ AST.IndexConstraint
1408                [AST.ToRange (AST.PrimLit "0")
1409                         (AST.PrimName (AST.NAttribute $
1410                           AST.AttribName (AST.NSimple vecPar) (AST.NSimple $ mkVHDLBasicId lengthId) Nothing) AST.:-:
1411                            (AST.PrimLit "1")) ]))
1412             Nothing
1413     -- if null(vec) then res := vec else res := last(vec) & init(vec)
1414     rotlExpr = AST.IfSm (AST.PrimFCall $ AST.FCall (AST.NSimple (mkVHDLExtId nullId))
1415                           [Nothing AST.:=>: AST.ADExpr (AST.PrimName $ AST.NSimple vecPar)])
1416                         [AST.NSimple resId AST.:= (AST.PrimName $ AST.NSimple vecPar)]
1417                         []
1418                         (Just $ AST.Else [rotlExprRet])
1419       where rotlExprRet =
1420                 AST.NSimple resId AST.:=
1421                       ((AST.PrimFCall $ AST.FCall (AST.NSimple (mkVHDLExtId lastId))
1422                         [Nothing AST.:=>: AST.ADExpr (AST.PrimName $ AST.NSimple vecPar)]) AST.:&:
1423                       (AST.PrimFCall $ AST.FCall (AST.NSimple (mkVHDLExtId initId))
1424                         [Nothing AST.:=>: AST.ADExpr (AST.PrimName $ AST.NSimple vecPar)]))
1425     rotlRet =  AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple resId)
1426     rotrSpec = AST.Function (mkVHDLExtId rotrId) [AST.IfaceVarDec vecPar vectorTM] vectorTM
1427     -- variable res : fsvec_x (0 to vec'length-1);
1428     rotrVar =
1429      AST.VarDec resId
1430             (AST.SubtypeIn vectorTM
1431               (Just $ AST.ConstraintIndex $ AST.IndexConstraint
1432                [AST.ToRange (AST.PrimLit "0")
1433                         (AST.PrimName (AST.NAttribute $
1434                           AST.AttribName (AST.NSimple vecPar) (AST.NSimple $ mkVHDLBasicId lengthId) Nothing) AST.:-:
1435                            (AST.PrimLit "1")) ]))
1436             Nothing
1437     -- if null(vec) then res := vec else res := tail(vec) & head(vec)
1438     rotrExpr = AST.IfSm (AST.PrimFCall $ AST.FCall (AST.NSimple (mkVHDLExtId nullId))
1439                           [Nothing AST.:=>: AST.ADExpr (AST.PrimName $ AST.NSimple vecPar)])
1440                         [AST.NSimple resId AST.:= (AST.PrimName $ AST.NSimple vecPar)]
1441                         []
1442                         (Just $ AST.Else [rotrExprRet])
1443       where rotrExprRet =
1444                 AST.NSimple resId AST.:=
1445                       ((AST.PrimFCall $ AST.FCall (AST.NSimple (mkVHDLExtId tailId))
1446                         [Nothing AST.:=>: AST.ADExpr (AST.PrimName $ AST.NSimple vecPar)]) AST.:&:
1447                       (AST.PrimFCall $ AST.FCall (AST.NSimple (mkVHDLExtId headId))
1448                         [Nothing AST.:=>: AST.ADExpr (AST.PrimName $ AST.NSimple vecPar)]))
1449     rotrRet =  AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple resId)
1450     reverseSpec = AST.Function (mkVHDLExtId reverseId) [AST.IfaceVarDec vecPar vectorTM] vectorTM
1451     reverseVar =
1452       AST.VarDec resId
1453              (AST.SubtypeIn vectorTM
1454                (Just $ AST.ConstraintIndex $ AST.IndexConstraint
1455                 [AST.ToRange (AST.PrimLit "0")
1456                          (AST.PrimName (AST.NAttribute $
1457                            AST.AttribName (AST.NSimple vecPar) (AST.NSimple $ mkVHDLBasicId lengthId) Nothing) AST.:-:
1458                             (AST.PrimLit "1")) ]))
1459              Nothing
1460     -- for i in 0 to res'range loop
1461     --   res(vec'length-i-1) := vec(i);
1462     -- end loop;
1463     reverseFor =
1464        AST.ForSM iId (AST.AttribRange $ AST.AttribName (AST.NSimple resId) (AST.NSimple $ rangeId) Nothing) [reverseAssign]
1465     -- res(vec'length-i-1) := vec(i);
1466     reverseAssign = AST.NIndexed (AST.IndexedName (AST.NSimple resId) [destExp]) AST.:=
1467       (AST.PrimName $ AST.NIndexed (AST.IndexedName (AST.NSimple vecPar)
1468                            [AST.PrimName $ AST.NSimple iId]))
1469         where destExp = AST.PrimName (AST.NAttribute $ AST.AttribName (AST.NSimple vecPar)
1470                                    (AST.NSimple $ mkVHDLBasicId lengthId) Nothing) AST.:-:
1471                         AST.PrimName (AST.NSimple iId) AST.:-:
1472                         (AST.PrimLit "1")
1473     -- return res;
1474     reverseRet = AST.ReturnSm (Just $ AST.PrimName (AST.NSimple resId))
1475
1476
1477 -----------------------------------------------------------------------------
1478 -- A table of builtin functions
1479 -----------------------------------------------------------------------------
1480
1481 -- A function that generates VHDL for a builtin function
1482 type BuiltinBuilder =
1483   (Either CoreSyn.CoreBndr AST.VHDLName) -- ^ The destination signal and it's original type
1484   -> CoreSyn.CoreBndr -- ^ The function called
1485   -> [Either CoreSyn.CoreExpr AST.Expr] -- ^ The value arguments passed (excluding type and
1486                     --   dictionary arguments).
1487   -> TranslatorSession ([AST.ConcSm], [CoreSyn.CoreBndr])
1488   -- ^ The corresponding VHDL concurrent statements and entities
1489   --   instantiated.
1490
1491 -- A map of a builtin function to VHDL function builder
1492 type NameTable = Map.Map String (Int, BuiltinBuilder )
1493
1494 -- | The builtin functions we support. Maps a name to an argument count and a
1495 -- builder function.
1496 globalNameTable :: NameTable
1497 globalNameTable = Map.fromList
1498   [ (exId             , (2, genFCall True          ) )
1499   , (replaceId        , (3, genFCall False          ) )
1500   , (headId           , (1, genFCall True           ) )
1501   , (lastId           , (1, genFCall True           ) )
1502   , (tailId           , (1, genFCall False          ) )
1503   , (initId           , (1, genFCall False          ) )
1504   , (takeId           , (2, genFCall False          ) )
1505   , (dropId           , (2, genFCall False          ) )
1506   , (selId            , (4, genFCall False          ) )
1507   , (plusgtId         , (2, genFCall False          ) )
1508   , (ltplusId         , (2, genFCall False          ) )
1509   , (plusplusId       , (2, genFCall False          ) )
1510   , (mapId            , (2, genMap                  ) )
1511   , (zipWithId        , (3, genZipWith              ) )
1512   , (foldlId          , (3, genFoldl                ) )
1513   , (foldrId          , (3, genFoldr                ) )
1514   , (zipId            , (2, genZip                  ) )
1515   , (unzipId          , (1, genUnzip                ) )
1516   , (shiftlId         , (2, genFCall False          ) )
1517   , (shiftrId         , (2, genFCall False          ) )
1518   , (rotlId           , (1, genFCall False          ) )
1519   , (rotrId           , (1, genFCall False          ) )
1520   , (concatId         , (1, genConcat               ) )
1521   , (reverseId        , (1, genFCall False          ) )
1522   , (iteratenId       , (3, genIteraten             ) )
1523   , (iterateId        , (2, genIterate              ) )
1524   , (generatenId      , (3, genGeneraten            ) )
1525   , (generateId       , (2, genGenerate             ) )
1526   , (emptyId          , (0, genFCall False          ) )
1527   , (singletonId      , (1, genFCall False          ) )
1528   , (copynId          , (2, genFCall False          ) )
1529   , (copyId           , (1, genCopy                 ) )
1530   , (lengthTId        , (1, genFCall False          ) )
1531   , (nullId           , (1, genFCall False          ) )
1532   , (hwxorId          , (2, genOperator2 AST.Xor    ) )
1533   , (hwandId          , (2, genOperator2 AST.And    ) )
1534   , (hworId           , (2, genOperator2 AST.Or     ) )
1535   , (hwnotId          , (1, genOperator1 AST.Not    ) )
1536   , (equalityId       , (2, genOperator2 (AST.:=:)  ) )
1537   , (inEqualityId     , (2, genOperator2 (AST.:/=:) ) )
1538   , (ltId             , (2, genOperator2 (AST.:<:)  ) )
1539   , (lteqId           , (2, genOperator2 (AST.:<=:) ) )
1540   , (gtId             , (2, genOperator2 (AST.:>:)  ) )
1541   , (gteqId           , (2, genOperator2 (AST.:>=:) ) )
1542   , (boolOrId         , (2, genOperator2 AST.Or     ) )
1543   , (boolAndId        , (2, genOperator2 AST.And    ) )
1544   , (plusId           , (2, genOperator2 (AST.:+:)  ) )
1545   , (timesId          , (2, genOperator2 (AST.:*:)  ) )
1546   , (negateId         , (1, genNegation             ) )
1547   , (minusId          , (2, genOperator2 (AST.:-:)  ) )
1548   , (fromSizedWordId  , (1, genFromSizedWord        ) )
1549   , (fromIntegerId    , (1, genFromInteger          ) )
1550   , (resizeWordId     , (1, genResize               ) )
1551   , (resizeIntId      , (1, genResize               ) )
1552   , (sizedIntId       , (1, genSizedInt             ) )
1553   , (smallIntegerId   , (1, genFromInteger          ) )
1554   , (fstId            , (1, genFst                  ) )
1555   , (sndId            , (1, genSnd                  ) )
1556   , (blockRAMId       , (5, genBlockRAM             ) )
1557   , (splitId          , (1, genSplit                ) )
1558   --, (tfvecId          , (1, genTFVec                ) )
1559   , (minimumId        , (2, error $ "\nFunction name: \"minimum\" is used internally, use another name"))
1560   ]