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