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
10 import Data.Accessor.MonadState as MonadState
14 import qualified Language.VHDL.AST as AST
17 import qualified CoreSyn
21 import qualified IdInfo
22 import qualified Literal
24 import qualified TyCon
27 import CLasH.Translator.TranslatorTypes
28 import CLasH.VHDL.Constants
29 import CLasH.VHDL.VHDLTypes
30 import CLasH.VHDL.VHDLTools
31 import CLasH.Utils as Utils
32 import CLasH.Utils.Core.CoreTools
33 import CLasH.Utils.Pretty
34 import qualified CLasH.Normalize as Normalize
36 -----------------------------------------------------------------------------
37 -- Functions to generate VHDL for user-defined functions.
38 -----------------------------------------------------------------------------
40 -- | Create an entity for a given function
43 -> TranslatorSession Entity -- ^ The resulting entity
45 getEntity fname = Utils.makeCached fname tsEntities $ do
46 expr <- Normalize.getNormalized fname
47 -- Strip off lambda's, these will be arguments
48 let (args, letexpr) = CoreSyn.collectBinders expr
49 -- Generate ports for all non-state types
50 args' <- catMaybesM $ mapM mkMap args
51 -- There must be a let at top level
52 let (CoreSyn.Let binds (CoreSyn.Var res)) = letexpr
53 -- TODO: Handle Nothing
54 Just res' <- mkMap res
55 let vhdl_id = mkVHDLBasicId $ varToString fname ++ "_" ++ varToStringUniq fname
56 let ent_decl = createEntityAST vhdl_id args' res'
57 let signature = Entity vhdl_id args' res' ent_decl
61 --[(SignalId, SignalInfo)]
63 -> TranslatorSession (Maybe Port)
66 --info = Maybe.fromMaybe
67 -- (error $ "Signal not found in the name map? This should not happen!")
69 -- Assume the bndr has a valid VHDL id already
72 error_msg = "\nVHDL.createEntity.mkMap: Can not create entity: " ++ pprString fname ++ "\nbecause no type can be created for port: " ++ pprString bndr
74 type_mark_maybe <- MonadState.lift tsType $ vhdl_ty error_msg ty
75 case type_mark_maybe of
76 Just type_mark -> return $ Just (id, type_mark)
77 Nothing -> return Nothing
80 -- | Create the VHDL AST for an entity
82 AST.VHDLId -- ^ The name of the function
83 -> [Port] -- ^ The entity's arguments
84 -> Port -- ^ The entity's result
85 -> AST.EntityDec -- ^ The entity with the ent_decl filled in as well
87 createEntityAST vhdl_id args res =
88 AST.EntityDec vhdl_id ports
90 -- Create a basic Id, since VHDL doesn't grok filenames with extended Ids.
91 ports = map (mkIfaceSigDec AST.In) args
92 ++ [mkIfaceSigDec AST.Out res]
94 -- Add a clk port if we have state
95 clk_port = AST.IfaceSigDec clockId AST.In std_logicTM
97 -- | Create a port declaration
99 AST.Mode -- ^ The mode for the port (In / Out)
100 -> (AST.VHDLId, AST.TypeMark) -- ^ 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 = Utils.makeCached fname tsArchitectures $ do
112 expr <- Normalize.getNormalized fname
113 signature <- getEntity fname
114 let entity_id = ent_id signature
115 -- Strip off lambda's, these will be arguments
116 let (args, letexpr) = CoreSyn.collectBinders expr
117 -- There must be a let at top level
118 let (CoreSyn.Let (CoreSyn.Rec binds) (CoreSyn.Var res)) = letexpr
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
126 (statementss, used_entitiess) <- Monad.mapAndUnzipM mkConcSm binds
127 let statements = concat statementss
128 let used_entities = concat used_entitiess
129 let arch = AST.ArchBody (mkVHDLBasicId "structural") (AST.NSimple entity_id) (map AST.BDISD sig_decs) (statements ++ procs')
130 return (arch, used_entities)
132 procs = [] --map mkStateProcSm [] -- (makeStatePairs flatfunc)
133 procs' = map AST.CSPSm procs
134 -- mkSigDec only uses tsTypes from the state
137 -- | Transforms a core binding into a VHDL concurrent statement
139 (CoreSyn.CoreBndr, CoreSyn.CoreExpr) -- ^ The binding to process
140 -> TranslatorSession ([AST.ConcSm], [CoreSyn.CoreBndr])
141 -- ^ The corresponding VHDL concurrent statements and entities
145 -- Ignore Cast expressions, they should not longer have any meaning as long as
146 -- the type works out.
147 mkConcSm (bndr, CoreSyn.Cast expr ty) = mkConcSm (bndr, expr)
149 -- Simple a = b assignments are just like applications, but without arguments.
150 -- We can't just generate an unconditional assignment here, since b might be a
151 -- top level binding (e.g., a function with no arguments).
152 mkConcSm (bndr, CoreSyn.Var v) = do
153 genApplication (Left bndr) v []
155 mkConcSm (bndr, app@(CoreSyn.App _ _))= do
156 let (CoreSyn.Var f, args) = CoreSyn.collectArgs app
157 let valargs = get_val_args (Var.varType f) args
158 genApplication (Left bndr) f (map Left valargs)
160 -- A single alt case must be a selector. This means thee scrutinee is a simple
161 -- variable, the alternative is a dataalt with a single non-wild binder that
163 mkConcSm (bndr, expr@(CoreSyn.Case (CoreSyn.Var scrut) b ty [alt]))
164 -- Don't generate VHDL for substate extraction
165 | hasStateType bndr = return ([], [])
168 (CoreSyn.DataAlt dc, bndrs, (CoreSyn.Var sel_bndr)) -> do
169 case List.elemIndex sel_bndr bndrs of
171 labels <- MonadState.lift tsType $ getFieldLabels (Id.idType scrut)
172 let label = labels!!i
173 let sel_name = mkSelectedName (varToVHDLName scrut) label
174 let sel_expr = AST.PrimName sel_name
175 return ([mkUncondAssign (Left bndr) sel_expr], [])
176 Nothing -> error $ "\nVHDL.mkConcSM: Not in normal form: Not a selector case:\n" ++ (pprString expr)
178 _ -> error $ "\nVHDL.mkConcSM: Not in normal form: Not a selector case:\n" ++ (pprString expr)
180 -- Multiple case alt are be conditional assignments and have only wild
181 -- binders in the alts and only variables in the case values and a variable
182 -- for a scrutinee. We check the constructor of the second alt, since the
183 -- first is the default case, if there is any.
184 mkConcSm (bndr, (CoreSyn.Case (CoreSyn.Var scrut) b ty [(_, _, CoreSyn.Var false), (con, _, CoreSyn.Var true)])) = do
185 scrut' <- MonadState.lift tsType $ varToVHDLExpr scrut
186 let cond_expr = scrut' AST.:=: (altconToVHDLExpr con)
187 true_expr <- MonadState.lift tsType $ varToVHDLExpr true
188 false_expr <- MonadState.lift tsType $ varToVHDLExpr false
189 return ([mkCondAssign (Left bndr) cond_expr true_expr false_expr], [])
191 mkConcSm (_, (CoreSyn.Case (CoreSyn.Var _) _ _ alts)) = error "\nVHDL.mkConcSm: Not in normal form: Case statement with more than two alternatives"
192 mkConcSm (_, CoreSyn.Case _ _ _ _) = error "\nVHDL.mkConcSm: Not in normal form: Case statement has does not have a simple variable as scrutinee"
193 mkConcSm (bndr, expr) = error $ "\nVHDL.mkConcSM: Unsupported binding in let expression: " ++ pprString bndr ++ " = " ++ pprString expr
195 -----------------------------------------------------------------------------
196 -- Functions to generate VHDL for builtin functions
197 -----------------------------------------------------------------------------
199 -- | A function to wrap a builder-like function that expects its arguments to
201 genExprArgs wrap dst func args = do
202 args' <- argsToVHDLExprs args
205 -- | Turn the all lefts into VHDL Expressions.
206 argsToVHDLExprs :: [Either CoreSyn.CoreExpr AST.Expr] -> TranslatorSession [AST.Expr]
207 argsToVHDLExprs = mapM argToVHDLExpr
209 argToVHDLExpr :: Either CoreSyn.CoreExpr AST.Expr -> TranslatorSession AST.Expr
210 argToVHDLExpr (Left expr) = MonadState.lift tsType $ varToVHDLExpr (exprToVar expr)
211 argToVHDLExpr (Right expr) = return expr
213 -- A function to wrap a builder-like function that generates no component
216 (dst -> func -> args -> TranslatorSession [AST.ConcSm])
217 -> (dst -> func -> args -> TranslatorSession ([AST.ConcSm], [CoreSyn.CoreBndr]))
218 genNoInsts wrap dst func args = do
219 concsms <- wrap dst func args
222 -- | A function to wrap a builder-like function that expects its arguments to
225 (dst -> func -> [Var.Var] -> res)
226 -> (dst -> func -> [Either CoreSyn.CoreExpr AST.Expr] -> res)
227 genVarArgs wrap dst func args = wrap dst func args'
229 args' = map exprToVar exprargs
230 -- Check (rather crudely) that all arguments are CoreExprs
231 (exprargs, []) = Either.partitionEithers args
233 -- | A function to wrap a builder-like function that expects its arguments to
236 (dst -> func -> [Literal.Literal] -> res)
237 -> (dst -> func -> [Either CoreSyn.CoreExpr AST.Expr] -> res)
238 genLitArgs wrap dst func args = wrap dst func args'
240 args' = map exprToLit litargs
241 -- FIXME: Check if we were passed an CoreSyn.App
242 litargs = concat (map getLiterals exprargs)
243 (exprargs, []) = Either.partitionEithers args
245 -- | A function to wrap a builder-like function that produces an expression
246 -- and expects it to be assigned to the destination.
248 ((Either CoreSyn.CoreBndr AST.VHDLName) -> func -> [arg] -> TranslatorSession AST.Expr)
249 -> ((Either CoreSyn.CoreBndr AST.VHDLName) -> func -> [arg] -> TranslatorSession [AST.ConcSm])
250 genExprRes wrap dst func args = do
251 expr <- wrap dst func args
252 return $ [mkUncondAssign dst expr]
254 -- | Generate a binary operator application. The first argument should be a
255 -- constructor from the AST.Expr type, e.g. AST.And.
256 genOperator2 :: (AST.Expr -> AST.Expr -> AST.Expr) -> BuiltinBuilder
257 genOperator2 op = genNoInsts $ genExprArgs $ genExprRes (genOperator2' op)
258 genOperator2' :: (AST.Expr -> AST.Expr -> AST.Expr) -> dst -> CoreSyn.CoreBndr -> [AST.Expr] -> TranslatorSession AST.Expr
259 genOperator2' op _ f [arg1, arg2] = return $ op arg1 arg2
261 -- | Generate a unary operator application
262 genOperator1 :: (AST.Expr -> AST.Expr) -> BuiltinBuilder
263 genOperator1 op = genNoInsts $ genExprArgs $ genExprRes (genOperator1' op)
264 genOperator1' :: (AST.Expr -> AST.Expr) -> dst -> CoreSyn.CoreBndr -> [AST.Expr] -> TranslatorSession AST.Expr
265 genOperator1' op _ f [arg] = return $ op arg
267 -- | Generate a unary operator application
268 genNegation :: BuiltinBuilder
269 genNegation = genNoInsts $ genVarArgs $ genExprRes genNegation'
270 genNegation' :: dst -> CoreSyn.CoreBndr -> [Var.Var] -> TranslatorSession AST.Expr
271 genNegation' _ f [arg] = do
272 arg1 <- MonadState.lift tsType $ varToVHDLExpr arg
273 let ty = Var.varType arg
274 let (tycon, args) = Type.splitTyConApp ty
275 let name = Name.getOccString (TyCon.tyConName tycon)
277 "SizedInt" -> return $ AST.Neg arg1
278 otherwise -> error $ "\nGenerate.genNegation': Negation allowed for type: " ++ show name
280 -- | Generate a function call from the destination binder, function name and a
281 -- list of expressions (its arguments)
282 genFCall :: Bool -> BuiltinBuilder
283 genFCall switch = genNoInsts $ genExprArgs $ genExprRes (genFCall' switch)
284 genFCall' :: Bool -> Either CoreSyn.CoreBndr AST.VHDLName -> CoreSyn.CoreBndr -> [AST.Expr] -> TranslatorSession AST.Expr
285 genFCall' switch (Left res) f args = do
286 let fname = varToString f
287 let el_ty = if switch then (Var.varType res) else ((tfvec_elem . Var.varType) res)
288 id <- MonadState.lift tsType $ vectorFunId el_ty fname
289 return $ AST.PrimFCall $ AST.FCall (AST.NSimple id) $
290 map (\exp -> Nothing AST.:=>: AST.ADExpr exp) args
291 genFCall' _ (Right name) _ _ = error $ "\nGenerate.genFCall': Cannot generate builtin function call assigned to a VHDLName: " ++ show name
293 genFromSizedWord :: BuiltinBuilder
294 genFromSizedWord = genNoInsts $ genExprArgs $ genExprRes genFromSizedWord'
295 genFromSizedWord' :: Either CoreSyn.CoreBndr AST.VHDLName -> CoreSyn.CoreBndr -> [AST.Expr] -> TranslatorSession AST.Expr
296 genFromSizedWord' (Left res) f args = do
297 let fname = varToString f
298 return $ AST.PrimFCall $ AST.FCall (AST.NSimple (mkVHDLBasicId toIntegerId)) $
299 map (\exp -> Nothing AST.:=>: AST.ADExpr exp) args
300 genFromSizedWord' (Right name) _ _ = error $ "\nGenerate.genFromSizedWord': Cannot generate builtin function call assigned to a VHDLName: " ++ show name
302 genResize :: BuiltinBuilder
303 genResize = genNoInsts $ genExprArgs $ genExprRes genResize'
304 genResize' :: Either CoreSyn.CoreBndr AST.VHDLName -> CoreSyn.CoreBndr -> [AST.Expr] -> TranslatorSession AST.Expr
305 genResize' (Left res) f [arg] = do {
306 ; let { ty = Var.varType res
307 ; (tycon, args) = Type.splitTyConApp ty
308 ; name = Name.getOccString (TyCon.tyConName tycon)
310 ; len <- case name of
311 "SizedInt" -> MonadState.lift tsType $ tfp_to_int (sized_int_len_ty ty)
312 "SizedWord" -> MonadState.lift tsType $ tfp_to_int (sized_word_len_ty ty)
313 ; return $ AST.PrimFCall $ AST.FCall (AST.NSimple (mkVHDLBasicId resizeId))
314 [Nothing AST.:=>: AST.ADExpr arg, Nothing AST.:=>: AST.ADExpr( AST.PrimLit (show len))]
316 genResize' (Right name) _ _ = error $ "\nGenerate.genFromSizedWord': Cannot generate builtin function call assigned to a VHDLName: " ++ show name
318 -- FIXME: I'm calling genLitArgs which is very specific function,
319 -- which needs to be fixed as well
320 genFromInteger :: BuiltinBuilder
321 genFromInteger = genNoInsts $ genLitArgs $ genExprRes genFromInteger'
322 genFromInteger' :: Either CoreSyn.CoreBndr AST.VHDLName -> CoreSyn.CoreBndr -> [Literal.Literal] -> TranslatorSession AST.Expr
323 genFromInteger' (Left res) f lits = do {
324 ; let { ty = Var.varType res
325 ; (tycon, args) = Type.splitTyConApp ty
326 ; name = Name.getOccString (TyCon.tyConName tycon)
329 "RangedWord" -> return $ AST.PrimLit (show (last lits))
331 ; len <- case name of
332 "SizedInt" -> MonadState.lift tsType $ tfp_to_int (sized_int_len_ty ty)
333 "SizedWord" -> MonadState.lift tsType $ tfp_to_int (sized_word_len_ty ty)
334 "RangedWord" -> MonadState.lift tsType $ tfp_to_int (ranged_word_bound_ty ty)
335 ; let fname = case name of "SizedInt" -> toSignedId ; "SizedWord" -> toUnsignedId
336 ; return $ AST.PrimFCall $ AST.FCall (AST.NSimple (mkVHDLBasicId fname))
337 [Nothing AST.:=>: AST.ADExpr (AST.PrimLit (show (last lits))), Nothing AST.:=>: AST.ADExpr( AST.PrimLit (show len))]
341 genFromInteger' (Right name) _ _ = error $ "\nGenerate.genFromInteger': Cannot generate builtin function call assigned to a VHDLName: " ++ show name
343 genSizedInt :: BuiltinBuilder
344 genSizedInt = genFromInteger
347 -- | Generate a Builder for the builtin datacon TFVec
348 genTFVec :: BuiltinBuilder
349 genTFVec (Left res) f [Left (CoreSyn.Let (CoreSyn.Rec letBinders) letRes)] = do {
350 -- Generate Assignments for all the binders
351 ; letAssigns <- mapM genBinderAssign letBinders
352 -- Generate assignments for the result (which might be another let binding)
353 ; (resBinders,resAssignments) <- genResAssign letRes
354 -- Get all the Assigned binders
355 ; let assignedBinders = Maybe.catMaybes (map fst letAssigns)
356 -- Make signal names for all the assigned binders
357 ; sigs <- mapM (\x -> MonadState.lift tsType $ varToVHDLExpr x) (assignedBinders ++ resBinders)
358 -- Assign all the signals to the resulting vector
359 ; let { vecsigns = mkAggregateSignal sigs
360 ; vecassign = mkUncondAssign (Left res) vecsigns
362 -- Generate all the signal declaration for the assigned binders
363 ; sig_dec_maybes <- mapM mkSigDec (assignedBinders ++ resBinders)
364 ; let { sig_decs = map (AST.BDISD) (Maybe.catMaybes $ sig_dec_maybes)
365 -- Setup the VHDL Block
366 ; block_label = mkVHDLExtId ("TFVec_" ++ show (varToString res))
367 ; block = AST.BlockSm block_label [] (AST.PMapAspect []) sig_decs ((concat (map snd letAssigns)) ++ resAssignments ++ [vecassign])
369 -- Return the block statement coressponding to the TFVec literal
370 ; return $ [AST.CSBSm block]
373 genBinderAssign :: (CoreSyn.CoreBndr, CoreSyn.CoreExpr) -> TranslatorSession (Maybe CoreSyn.CoreBndr, [AST.ConcSm])
374 -- For now we only translate applications
375 genBinderAssign (bndr, app@(CoreSyn.App _ _)) = do
376 let (CoreSyn.Var f, args) = CoreSyn.collectArgs app
377 let valargs = get_val_args (Var.varType f) args
378 apps <- genApplication (Left bndr) f (map Left valargs)
379 return (Just bndr, apps)
380 genBinderAssign _ = return (Nothing,[])
381 genResAssign :: CoreSyn.CoreExpr -> TranslatorSession ([CoreSyn.CoreBndr], [AST.ConcSm])
382 genResAssign app@(CoreSyn.App _ letexpr) = do
384 (CoreSyn.Let (CoreSyn.Rec letbndrs) letres) -> do
385 letapps <- mapM genBinderAssign letbndrs
386 let bndrs = Maybe.catMaybes (map fst letapps)
387 let app = (map snd letapps)
388 (vars, apps) <- genResAssign letres
389 return ((bndrs ++ vars),((concat app) ++ apps))
390 otherwise -> return ([],[])
391 genResAssign _ = return ([],[])
393 genTFVec (Left res) f [Left app@(CoreSyn.App _ _)] = do {
394 ; let { elems = reduceCoreListToHsList app
395 -- Make signal names for all the binders
396 ; binders = map (\expr -> case expr of
398 otherwise -> error $ "\nGenerate.genTFVec: Cannot generate TFVec: "
399 ++ show res ++ ", with elems:\n" ++ show elems ++ "\n" ++ pprString elems) elems
401 ; sigs <- mapM (\x -> MonadState.lift tsType $ varToVHDLExpr x) binders
402 -- Assign all the signals to the resulting vector
403 ; let { vecsigns = mkAggregateSignal sigs
404 ; vecassign = mkUncondAssign (Left res) vecsigns
405 -- Setup the VHDL Block
406 ; block_label = mkVHDLExtId ("TFVec_" ++ show (varToString res))
407 ; block = AST.BlockSm block_label [] (AST.PMapAspect []) [] [vecassign]
409 -- Return the block statement coressponding to the TFVec literal
410 ; return $ [AST.CSBSm block]
413 genTFVec (Left name) _ [Left xs] = error $ "\nGenerate.genTFVec: Cannot generate TFVec: " ++ show name ++ ", with elems:\n" ++ show xs ++ "\n" ++ pprString xs
415 genTFVec (Right name) _ _ = error $ "\nGenerate.genTFVec: Cannot generate TFVec assigned to VHDLName: " ++ show name
417 -- | Generate a generate statement for the builtin function "map"
418 genMap :: BuiltinBuilder
419 genMap (Left res) f [Left mapped_f, Left (CoreSyn.Var arg)] = do {
420 -- mapped_f must be a CoreExpr (since we can't represent functions as VHDL
421 -- expressions). arg must be a CoreExpr (and should be a CoreSyn.Var), since
422 -- we must index it (which we couldn't if it was a VHDL Expr, since only
423 -- VHDLNames can be indexed).
424 -- Setup the generate scheme
425 ; len <- MonadState.lift tsType $ tfp_to_int $ (tfvec_len_ty . Var.varType) res
426 -- TODO: Use something better than varToString
427 ; let { label = mkVHDLExtId ("mapVector" ++ (varToString res))
428 ; n_id = mkVHDLBasicId "n"
429 ; n_expr = idToVHDLExpr n_id
430 ; range = AST.ToRange (AST.PrimLit "0") (AST.PrimLit $ show (len-1))
431 ; genScheme = AST.ForGn n_id range
432 -- Create the content of the generate statement: Applying the mapped_f to
433 -- each of the elements in arg, storing to each element in res
434 ; resname = mkIndexedName (varToVHDLName res) n_expr
435 ; argexpr = vhdlNameToVHDLExpr $ mkIndexedName (varToVHDLName arg) n_expr
436 ; (CoreSyn.Var real_f, already_mapped_args) = CoreSyn.collectArgs mapped_f
437 ; valargs = get_val_args (Var.varType real_f) already_mapped_args
439 ; (app_concsms, used) <- genApplication (Right resname) real_f (map Left valargs ++ [Right argexpr])
440 -- Return the generate statement
441 ; return ([AST.CSGSm $ AST.GenerateSm label genScheme [] app_concsms], used)
444 genMap' (Right name) _ _ = error $ "\nGenerate.genMap': Cannot generate map function call assigned to a VHDLName: " ++ show name
446 genZipWith :: BuiltinBuilder
447 genZipWith = genVarArgs genZipWith'
448 genZipWith' :: (Either CoreSyn.CoreBndr AST.VHDLName) -> CoreSyn.CoreBndr -> [Var.Var] -> TranslatorSession ([AST.ConcSm], [CoreSyn.CoreBndr])
449 genZipWith' (Left res) f args@[zipped_f, arg1, arg2] = do {
450 -- Setup the generate scheme
451 ; len <- MonadState.lift tsType $ tfp_to_int $ (tfvec_len_ty . Var.varType) res
452 -- TODO: Use something better than varToString
453 ; let { label = mkVHDLExtId ("zipWithVector" ++ (varToString res))
454 ; n_id = mkVHDLBasicId "n"
455 ; n_expr = idToVHDLExpr n_id
456 ; range = AST.ToRange (AST.PrimLit "0") (AST.PrimLit $ show (len-1))
457 ; genScheme = AST.ForGn n_id range
458 -- Create the content of the generate statement: Applying the zipped_f to
459 -- each of the elements in arg1 and arg2, storing to each element in res
460 ; resname = mkIndexedName (varToVHDLName res) n_expr
461 ; argexpr1 = vhdlNameToVHDLExpr $ mkIndexedName (varToVHDLName arg1) n_expr
462 ; argexpr2 = vhdlNameToVHDLExpr $ mkIndexedName (varToVHDLName arg2) n_expr
464 ; (app_concsms, used) <- genApplication (Right resname) zipped_f [Right argexpr1, Right argexpr2]
465 -- Return the generate functions
466 ; return ([AST.CSGSm $ AST.GenerateSm label genScheme [] app_concsms], used)
469 genFoldl :: BuiltinBuilder
470 genFoldl = genFold True
472 genFoldr :: BuiltinBuilder
473 genFoldr = genFold False
475 genFold :: Bool -> BuiltinBuilder
476 genFold left = genVarArgs (genFold' left)
478 genFold' :: Bool -> (Either CoreSyn.CoreBndr AST.VHDLName) -> CoreSyn.CoreBndr -> [Var.Var] -> TranslatorSession ([AST.ConcSm], [CoreSyn.CoreBndr])
479 genFold' left res f args@[folded_f , start ,vec]= do
480 len <- MonadState.lift tsType $ tfp_to_int $ (tfvec_len_ty (Var.varType vec))
481 genFold'' len left res f args
483 genFold'' :: Int -> Bool -> (Either CoreSyn.CoreBndr AST.VHDLName) -> CoreSyn.CoreBndr -> [Var.Var] -> TranslatorSession ([AST.ConcSm], [CoreSyn.CoreBndr])
484 -- Special case for an empty input vector, just assign start to res
485 genFold'' len left (Left res) _ [_, start, vec] | len == 0 = do
486 arg <- MonadState.lift tsType $ varToVHDLExpr start
487 return ([mkUncondAssign (Left res) arg], [])
489 genFold'' len left (Left res) f [folded_f, start, vec] = do
491 --len <- MonadState.lift tsType $ tfp_to_int $ (tfvec_len_ty . Var.varType) vec
492 -- An expression for len-1
493 let len_min_expr = (AST.PrimLit $ show (len-1))
494 -- evec is (TFVec n), so it still needs an element type
495 let (nvec, _) = Type.splitAppTy (Var.varType vec)
496 -- Put the type of the start value in nvec, this will be the type of our
498 let tmp_ty = Type.mkAppTy nvec (Var.varType start)
499 let error_msg = "\nGenerate.genFold': Can not construct temp vector for element type: " ++ pprString tmp_ty
500 -- TODO: Handle Nothing
501 Just tmp_vhdl_ty <- MonadState.lift tsType $ vhdl_ty error_msg tmp_ty
502 -- Setup the generate scheme
503 let gen_label = mkVHDLExtId ("foldlVector" ++ (varToString vec))
504 let block_label = mkVHDLExtId ("foldlVector" ++ (varToString res))
505 let gen_range = if left then AST.ToRange (AST.PrimLit "0") len_min_expr
506 else AST.DownRange len_min_expr (AST.PrimLit "0")
507 let gen_scheme = AST.ForGn n_id gen_range
508 -- Make the intermediate vector
509 let tmp_dec = AST.BDISD $ AST.SigDec tmp_id tmp_vhdl_ty Nothing
510 -- Create the generate statement
511 cells' <- sequence [genFirstCell, genOtherCell]
512 let (cells, useds) = unzip cells'
513 let gen_sm = AST.GenerateSm gen_label gen_scheme [] (map AST.CSGSm cells)
514 -- Assign tmp[len-1] or tmp[0] to res
515 let out_assign = mkUncondAssign (Left res) $ vhdlNameToVHDLExpr (if left then
516 (mkIndexedName tmp_name (AST.PrimLit $ show (len-1))) else
517 (mkIndexedName tmp_name (AST.PrimLit "0")))
518 let block = AST.BlockSm block_label [] (AST.PMapAspect []) [tmp_dec] [AST.CSGSm gen_sm, out_assign]
519 return ([AST.CSBSm block], concat useds)
521 -- An id for the counter
522 n_id = mkVHDLBasicId "n"
523 n_cur = idToVHDLExpr n_id
524 -- An expression for previous n
525 n_prev = if left then (n_cur AST.:-: (AST.PrimLit "1"))
526 else (n_cur AST.:+: (AST.PrimLit "1"))
527 -- An id for the tmp result vector
528 tmp_id = mkVHDLBasicId "tmp"
529 tmp_name = AST.NSimple tmp_id
530 -- Generate parts of the fold
531 genFirstCell, genOtherCell :: TranslatorSession (AST.GenerateSm, [CoreSyn.CoreBndr])
533 len <- MonadState.lift tsType $ tfp_to_int $ (tfvec_len_ty . Var.varType) vec
534 let cond_label = mkVHDLExtId "firstcell"
535 -- if n == 0 or n == len-1
536 let cond_scheme = AST.IfGn $ n_cur AST.:=: (if left then (AST.PrimLit "0")
537 else (AST.PrimLit $ show (len-1)))
538 -- Output to tmp[current n]
539 let resname = mkIndexedName tmp_name n_cur
541 argexpr1 <- MonadState.lift tsType $ varToVHDLExpr start
542 -- Input from vec[current n]
543 let argexpr2 = vhdlNameToVHDLExpr $ mkIndexedName (varToVHDLName vec) n_cur
544 (app_concsms, used) <- genApplication (Right resname) folded_f ( if left then
545 [Right argexpr1, Right argexpr2]
547 [Right argexpr2, Right argexpr1]
549 -- Return the conditional generate part
550 return $ (AST.GenerateSm cond_label cond_scheme [] app_concsms, used)
553 len <- MonadState.lift tsType $ tfp_to_int $ (tfvec_len_ty . Var.varType) vec
554 let cond_label = mkVHDLExtId "othercell"
555 -- if n > 0 or n < len-1
556 let cond_scheme = AST.IfGn $ n_cur AST.:/=: (if left then (AST.PrimLit "0")
557 else (AST.PrimLit $ show (len-1)))
558 -- Output to tmp[current n]
559 let resname = mkIndexedName tmp_name n_cur
560 -- Input from tmp[previous n]
561 let argexpr1 = vhdlNameToVHDLExpr $ mkIndexedName tmp_name n_prev
562 -- Input from vec[current n]
563 let argexpr2 = vhdlNameToVHDLExpr $ mkIndexedName (varToVHDLName vec) n_cur
564 (app_concsms, used) <- genApplication (Right resname) folded_f ( if left then
565 [Right argexpr1, Right argexpr2]
567 [Right argexpr2, Right argexpr1]
569 -- Return the conditional generate part
570 return $ (AST.GenerateSm cond_label cond_scheme [] app_concsms, used)
572 -- | Generate a generate statement for the builtin function "zip"
573 genZip :: BuiltinBuilder
574 genZip = genNoInsts $ genVarArgs genZip'
575 genZip' :: (Either CoreSyn.CoreBndr AST.VHDLName) -> CoreSyn.CoreBndr -> [Var.Var] -> TranslatorSession [AST.ConcSm]
576 genZip' (Left res) f args@[arg1, arg2] = do {
577 -- Setup the generate scheme
578 ; len <- MonadState.lift tsType $ tfp_to_int $ (tfvec_len_ty . Var.varType) res
579 -- TODO: Use something better than varToString
580 ; let { label = mkVHDLExtId ("zipVector" ++ (varToString res))
581 ; n_id = mkVHDLBasicId "n"
582 ; n_expr = idToVHDLExpr n_id
583 ; range = AST.ToRange (AST.PrimLit "0") (AST.PrimLit $ show (len-1))
584 ; genScheme = AST.ForGn n_id range
585 ; resname' = mkIndexedName (varToVHDLName res) n_expr
586 ; argexpr1 = vhdlNameToVHDLExpr $ mkIndexedName (varToVHDLName arg1) n_expr
587 ; argexpr2 = vhdlNameToVHDLExpr $ mkIndexedName (varToVHDLName arg2) n_expr
589 ; labels <- MonadState.lift tsType $ getFieldLabels (tfvec_elem (Var.varType res))
590 ; let { resnameA = mkSelectedName resname' (labels!!0)
591 ; resnameB = mkSelectedName resname' (labels!!1)
592 ; resA_assign = mkUncondAssign (Right resnameA) argexpr1
593 ; resB_assign = mkUncondAssign (Right resnameB) argexpr2
595 -- Return the generate functions
596 ; return [AST.CSGSm $ AST.GenerateSm label genScheme [] [resA_assign,resB_assign]]
599 -- | Generate a generate statement for the builtin function "unzip"
600 genUnzip :: BuiltinBuilder
601 genUnzip = genNoInsts $ genVarArgs genUnzip'
602 genUnzip' :: (Either CoreSyn.CoreBndr AST.VHDLName) -> CoreSyn.CoreBndr -> [Var.Var] -> TranslatorSession [AST.ConcSm]
603 genUnzip' (Left res) f args@[arg] = do {
604 -- Setup the generate scheme
605 ; len <- MonadState.lift tsType $ tfp_to_int $ (tfvec_len_ty . Var.varType) arg
606 -- TODO: Use something better than varToString
607 ; let { label = mkVHDLExtId ("unzipVector" ++ (varToString res))
608 ; n_id = mkVHDLBasicId "n"
609 ; n_expr = idToVHDLExpr n_id
610 ; range = AST.ToRange (AST.PrimLit "0") (AST.PrimLit $ show (len-1))
611 ; genScheme = AST.ForGn n_id range
612 ; resname' = varToVHDLName res
613 ; argexpr' = mkIndexedName (varToVHDLName arg) n_expr
615 ; reslabels <- MonadState.lift tsType $ getFieldLabels (Var.varType res)
616 ; arglabels <- MonadState.lift tsType $ getFieldLabels (tfvec_elem (Var.varType arg))
617 ; let { resnameA = mkIndexedName (mkSelectedName resname' (reslabels!!0)) n_expr
618 ; resnameB = mkIndexedName (mkSelectedName resname' (reslabels!!1)) n_expr
619 ; argexprA = vhdlNameToVHDLExpr $ mkSelectedName argexpr' (arglabels!!0)
620 ; argexprB = vhdlNameToVHDLExpr $ mkSelectedName argexpr' (arglabels!!1)
621 ; resA_assign = mkUncondAssign (Right resnameA) argexprA
622 ; resB_assign = mkUncondAssign (Right resnameB) argexprB
624 -- Return the generate functions
625 ; return [AST.CSGSm $ AST.GenerateSm label genScheme [] [resA_assign,resB_assign]]
628 genCopy :: BuiltinBuilder
629 genCopy = genNoInsts $ genVarArgs genCopy'
630 genCopy' :: (Either CoreSyn.CoreBndr AST.VHDLName ) -> CoreSyn.CoreBndr -> [Var.Var] -> TranslatorSession [AST.ConcSm]
631 genCopy' (Left res) f args@[arg] =
633 resExpr = AST.Aggregate [AST.ElemAssoc (Just AST.Others)
634 (AST.PrimName $ (varToVHDLName arg))]
635 out_assign = mkUncondAssign (Left res) resExpr
639 genConcat :: BuiltinBuilder
640 genConcat = genNoInsts $ genVarArgs genConcat'
641 genConcat' :: (Either CoreSyn.CoreBndr AST.VHDLName) -> CoreSyn.CoreBndr -> [Var.Var] -> TranslatorSession [AST.ConcSm]
642 genConcat' (Left res) f args@[arg] = do {
643 -- Setup the generate scheme
644 ; len1 <- MonadState.lift tsType $ tfp_to_int $ (tfvec_len_ty . Var.varType) arg
645 ; let (_, nvec) = Type.splitAppTy (Var.varType arg)
646 ; len2 <- MonadState.lift tsType $ tfp_to_int $ tfvec_len_ty nvec
647 -- TODO: Use something better than varToString
648 ; let { label = mkVHDLExtId ("concatVector" ++ (varToString res))
649 ; n_id = mkVHDLBasicId "n"
650 ; n_expr = idToVHDLExpr n_id
651 ; fromRange = n_expr AST.:*: (AST.PrimLit $ show len2)
652 ; genScheme = AST.ForGn n_id range
653 -- Create the content of the generate statement: Applying the mapped_f to
654 -- each of the elements in arg, storing to each element in res
655 ; toRange = (n_expr AST.:*: (AST.PrimLit $ show len2)) AST.:+: (AST.PrimLit $ show (len2-1))
656 ; range = AST.ToRange (AST.PrimLit "0") (AST.PrimLit $ show (len1-1))
657 ; resname = vecSlice fromRange toRange
658 ; argexpr = vhdlNameToVHDLExpr $ mkIndexedName (varToVHDLName arg) n_expr
659 ; out_assign = mkUncondAssign (Right resname) argexpr
661 -- Return the generate statement
662 ; return [AST.CSGSm $ AST.GenerateSm label genScheme [] [out_assign]]
665 vecSlice init last = AST.NSlice (AST.SliceName (varToVHDLName res)
666 (AST.ToRange init last))
668 genIteraten :: BuiltinBuilder
669 genIteraten dst f args = genIterate dst f (tail args)
671 genIterate :: BuiltinBuilder
672 genIterate = genIterateOrGenerate True
674 genGeneraten :: BuiltinBuilder
675 genGeneraten dst f args = genGenerate dst f (tail args)
677 genGenerate :: BuiltinBuilder
678 genGenerate = genIterateOrGenerate False
680 genIterateOrGenerate :: Bool -> BuiltinBuilder
681 genIterateOrGenerate iter = genVarArgs (genIterateOrGenerate' iter)
683 genIterateOrGenerate' :: Bool -> (Either CoreSyn.CoreBndr AST.VHDLName) -> CoreSyn.CoreBndr -> [Var.Var] -> TranslatorSession ([AST.ConcSm], [CoreSyn.CoreBndr])
684 genIterateOrGenerate' iter (Left res) f args = do
685 len <- MonadState.lift tsType $ tfp_to_int ((tfvec_len_ty . Var.varType) res)
686 genIterateOrGenerate'' len iter (Left res) f args
688 genIterateOrGenerate'' :: Int -> Bool -> (Either CoreSyn.CoreBndr AST.VHDLName) -> CoreSyn.CoreBndr -> [Var.Var] -> TranslatorSession ([AST.ConcSm], [CoreSyn.CoreBndr])
689 -- Special case for an empty input vector, just assign start to res
690 genIterateOrGenerate'' len iter (Left res) _ [app_f, start] | len == 0 = return ([mkUncondAssign (Left res) (AST.PrimLit "\"\"")], [])
692 genIterateOrGenerate'' len iter (Left res) f [app_f, start] = do
694 -- len <- MonadState.lift tsType $ tfp_to_int ((tfvec_len_ty . Var.varType) res)
695 -- An expression for len-1
696 let len_min_expr = (AST.PrimLit $ show (len-1))
697 -- -- evec is (TFVec n), so it still needs an element type
698 -- let (nvec, _) = splitAppTy (Var.varType vec)
699 -- -- Put the type of the start value in nvec, this will be the type of our
700 -- -- temporary vector
701 let tmp_ty = Var.varType res
702 let error_msg = "\nGenerate.genFold': Can not construct temp vector for element type: " ++ pprString tmp_ty
703 -- TODO: Handle Nothing
704 Just tmp_vhdl_ty <- MonadState.lift tsType $ vhdl_ty error_msg tmp_ty
705 -- Setup the generate scheme
706 let gen_label = mkVHDLExtId ("iterateVector" ++ (varToString start))
707 let block_label = mkVHDLExtId ("iterateVector" ++ (varToString res))
708 let gen_range = AST.ToRange (AST.PrimLit "0") len_min_expr
709 let gen_scheme = AST.ForGn n_id gen_range
710 -- Make the intermediate vector
711 let tmp_dec = AST.BDISD $ AST.SigDec tmp_id tmp_vhdl_ty Nothing
712 -- Create the generate statement
713 cells' <- sequence [genFirstCell, genOtherCell]
714 let (cells, useds) = unzip cells'
715 let gen_sm = AST.GenerateSm gen_label gen_scheme [] (map AST.CSGSm cells)
716 -- Assign tmp[len-1] or tmp[0] to res
717 let out_assign = mkUncondAssign (Left res) $ vhdlNameToVHDLExpr tmp_name
718 let block = AST.BlockSm block_label [] (AST.PMapAspect []) [tmp_dec] [AST.CSGSm gen_sm, out_assign]
719 return ([AST.CSBSm block], concat useds)
721 -- An id for the counter
722 n_id = mkVHDLBasicId "n"
723 n_cur = idToVHDLExpr n_id
724 -- An expression for previous n
725 n_prev = n_cur AST.:-: (AST.PrimLit "1")
726 -- An id for the tmp result vector
727 tmp_id = mkVHDLBasicId "tmp"
728 tmp_name = AST.NSimple tmp_id
729 -- Generate parts of the fold
730 genFirstCell, genOtherCell :: TranslatorSession (AST.GenerateSm, [CoreSyn.CoreBndr])
732 let cond_label = mkVHDLExtId "firstcell"
733 -- if n == 0 or n == len-1
734 let cond_scheme = AST.IfGn $ n_cur AST.:=: (AST.PrimLit "0")
735 -- Output to tmp[current n]
736 let resname = mkIndexedName tmp_name n_cur
738 argexpr <- MonadState.lift tsType $ varToVHDLExpr start
739 let startassign = mkUncondAssign (Right resname) argexpr
740 (app_concsms, used) <- genApplication (Right resname) app_f [Right argexpr]
741 -- Return the conditional generate part
742 let gensm = AST.GenerateSm cond_label cond_scheme [] (if iter then
750 let cond_label = mkVHDLExtId "othercell"
751 -- if n > 0 or n < len-1
752 let cond_scheme = AST.IfGn $ n_cur AST.:/=: (AST.PrimLit "0")
753 -- Output to tmp[current n]
754 let resname = mkIndexedName tmp_name n_cur
755 -- Input from tmp[previous n]
756 let argexpr = vhdlNameToVHDLExpr $ mkIndexedName tmp_name n_prev
757 (app_concsms, used) <- genApplication (Right resname) app_f [Right argexpr]
758 -- Return the conditional generate part
759 return $ (AST.GenerateSm cond_label cond_scheme [] app_concsms, used)
762 -----------------------------------------------------------------------------
763 -- Function to generate VHDL for applications
764 -----------------------------------------------------------------------------
766 (Either CoreSyn.CoreBndr AST.VHDLName) -- ^ Where to store the result?
767 -> CoreSyn.CoreBndr -- ^ The function to apply
768 -> [Either CoreSyn.CoreExpr AST.Expr] -- ^ The arguments to apply
769 -> TranslatorSession ([AST.ConcSm], [CoreSyn.CoreBndr])
770 -- ^ The corresponding VHDL concurrent statements and entities
772 genApplication dst f args = do
773 case Var.isGlobalId f of
775 top <- isTopLevelBinder f
778 -- Local binder that references a top level binding. Generate a
779 -- component instantiation.
780 signature <- getEntity f
781 args' <- argsToVHDLExprs args
782 let entity_id = ent_id signature
783 -- TODO: Using show here isn't really pretty, but we'll need some
784 -- unique-ish value...
785 let label = "comp_ins_" ++ (either show prettyShow) dst
786 portmaps <- mkAssocElems args' ((either varToVHDLName id) dst) signature
787 return ([mkComponentInst label entity_id portmaps], [f])
789 -- Not a top level binder, so this must be a local variable reference.
790 -- It should have a representable type (and thus, no arguments) and a
791 -- signal should be generated for it. Just generate an unconditional
793 f' <- MonadState.lift tsType $ varToVHDLExpr f
794 return $ ([mkUncondAssign dst f'], [])
795 True | not stateful ->
796 case Var.idDetails f of
797 IdInfo.DataConWorkId dc -> case dst of
798 -- It's a datacon. Create a record from its arguments.
800 -- We have the bndr, so we can get at the type
801 labels <- MonadState.lift tsType $ getFieldLabels (Var.varType bndr)
802 args' <- argsToVHDLExprs args
803 return $ (zipWith mkassign labels $ args', [])
805 mkassign :: AST.VHDLId -> AST.Expr -> AST.ConcSm
807 let sel_name = mkSelectedName ((either varToVHDLName id) dst) label in
808 mkUncondAssign (Right sel_name) arg
809 Right _ -> error $ "\nGenerate.genApplication: Can't generate dataconstructor application without an original binder"
810 IdInfo.DataConWrapId dc -> case dst of
811 -- It's a datacon. Create a record from its arguments.
813 case (Map.lookup (varToString f) globalNameTable) of
814 Just (arg_count, builder) ->
815 if length args == arg_count then
818 error $ "\nGenerate.genApplication(DataConWrapId): Incorrect number of arguments to builtin function: " ++ pprString f ++ " Args: " ++ show args
819 Nothing -> error $ "\nGenerate.genApplication: Can't generate dataconwrapper: " ++ (show dc)
820 Right _ -> error $ "\nGenerate.genApplication: Can't generate dataconwrapper application without an original binder"
821 IdInfo.VanillaId -> do
822 -- It's a global value imported from elsewhere. These can be builtin
823 -- functions. Look up the function name in the name table and execute
824 -- the associated builder if there is any and the argument count matches
825 -- (this should always be the case if it typechecks, but just to be
827 case (Map.lookup (varToString f) globalNameTable) of
828 Just (arg_count, builder) ->
829 if length args == arg_count then
832 error $ "\nGenerate.genApplication(VanillaGlobal): Incorrect number of arguments to builtin function: " ++ pprString f ++ " Args: " ++ show args
833 Nothing -> error $ ("\nGenerate.genApplication(VanillaGlobal): Using function from another module that is not a known builtin: " ++ (pprString f))
834 IdInfo.ClassOpId cls -> do
835 -- FIXME: Not looking for what instance this class op is called for
836 -- Is quite stupid of course.
837 case (Map.lookup (varToString f) globalNameTable) of
838 Just (arg_count, builder) ->
839 if length args == arg_count then
842 error $ "\nGenerate.genApplication(ClassOpId): Incorrect number of arguments to builtin function: " ++ pprString f ++ " Args: " ++ show args
843 Nothing -> error $ "\nGenerate.genApplication(ClassOpId): Using function from another module that is not a known builtin: " ++ pprString f
844 details -> error $ "\nGenerate.genApplication: Calling unsupported function " ++ pprString f ++ " with GlobalIdDetails " ++ pprString details
845 -- If we can't generate a component instantiation, and the destination is
846 -- a state type, don't generate anything.
849 -- Is our destination a state value?
850 stateful = case dst of
851 -- When our destination is a VHDL name, it won't have had a state type
853 -- Otherwise check its type
854 Left bndr -> hasStateType bndr
856 -----------------------------------------------------------------------------
857 -- Functions to generate functions dealing with vectors.
858 -----------------------------------------------------------------------------
860 -- Returns the VHDLId of the vector function with the given name for the given
861 -- element type. Generates -- this function if needed.
862 vectorFunId :: Type.Type -> String -> TypeSession AST.VHDLId
863 vectorFunId el_ty fname = do
864 let error_msg = "\nGenerate.vectorFunId: Can not construct vector function for element: " ++ pprString el_ty
865 -- TODO: Handle the Nothing case?
866 Just elemTM <- vhdl_ty error_msg el_ty
867 -- TODO: This should not be duplicated from mk_vector_ty. Probably but it in
868 -- the VHDLState or something.
869 let vectorTM = mkVHDLExtId $ "vector_" ++ (AST.fromVHDLId elemTM)
870 typefuns <- getA tsTypeFuns
871 case Map.lookup (OrdType el_ty, fname) typefuns of
872 -- Function already generated, just return it
873 Just (id, _) -> return id
874 -- Function not generated yet, generate it
876 let functions = genUnconsVectorFuns elemTM vectorTM
877 case lookup fname functions of
879 modA tsTypeFuns $ Map.insert (OrdType el_ty, fname) (function_id, (fst body))
880 mapM_ (vectorFunId el_ty) (snd body)
882 Nothing -> error $ "\nGenerate.vectorFunId: I don't know how to generate vector function " ++ fname
884 function_id = mkVHDLExtId fname
886 genUnconsVectorFuns :: AST.TypeMark -- ^ type of the vector elements
887 -> AST.TypeMark -- ^ type of the vector
888 -> [(String, (AST.SubProgBody, [String]))]
889 genUnconsVectorFuns elemTM vectorTM =
890 [ (exId, (AST.SubProgBody exSpec [] [exExpr],[]))
891 , (replaceId, (AST.SubProgBody replaceSpec [AST.SPVD replaceVar] [replaceExpr,replaceRet],[]))
892 , (lastId, (AST.SubProgBody lastSpec [] [lastExpr],[]))
893 , (initId, (AST.SubProgBody initSpec [AST.SPVD initVar] [initExpr, initRet],[]))
894 , (minimumId, (AST.SubProgBody minimumSpec [] [minimumExpr],[]))
895 , (takeId, (AST.SubProgBody takeSpec [AST.SPVD takeVar] [takeExpr, takeRet],[minimumId]))
896 , (dropId, (AST.SubProgBody dropSpec [AST.SPVD dropVar] [dropExpr, dropRet],[]))
897 , (plusgtId, (AST.SubProgBody plusgtSpec [AST.SPVD plusgtVar] [plusgtExpr, plusgtRet],[]))
898 , (emptyId, (AST.SubProgBody emptySpec [AST.SPCD emptyVar] [emptyExpr],[]))
899 , (singletonId, (AST.SubProgBody singletonSpec [AST.SPVD singletonVar] [singletonRet],[]))
900 , (copynId, (AST.SubProgBody copynSpec [AST.SPVD copynVar] [copynExpr],[]))
901 , (selId, (AST.SubProgBody selSpec [AST.SPVD selVar] [selFor, selRet],[]))
902 , (ltplusId, (AST.SubProgBody ltplusSpec [AST.SPVD ltplusVar] [ltplusExpr, ltplusRet],[]))
903 , (plusplusId, (AST.SubProgBody plusplusSpec [AST.SPVD plusplusVar] [plusplusExpr, plusplusRet],[]))
904 , (lengthTId, (AST.SubProgBody lengthTSpec [] [lengthTExpr],[]))
905 , (shiftlId, (AST.SubProgBody shiftlSpec [AST.SPVD shiftlVar] [shiftlExpr, shiftlRet], [initId]))
906 , (shiftrId, (AST.SubProgBody shiftrSpec [AST.SPVD shiftrVar] [shiftrExpr, shiftrRet], [tailId]))
907 , (nullId, (AST.SubProgBody nullSpec [] [nullExpr], []))
908 , (rotlId, (AST.SubProgBody rotlSpec [AST.SPVD rotlVar] [rotlExpr, rotlRet], [nullId, lastId, initId]))
909 , (rotrId, (AST.SubProgBody rotrSpec [AST.SPVD rotrVar] [rotrExpr, rotrRet], [nullId, tailId, headId]))
910 , (reverseId, (AST.SubProgBody reverseSpec [AST.SPVD reverseVar] [reverseFor, reverseRet], []))
913 ixPar = AST.unsafeVHDLBasicId "ix"
914 vecPar = AST.unsafeVHDLBasicId "vec"
915 vec1Par = AST.unsafeVHDLBasicId "vec1"
916 vec2Par = AST.unsafeVHDLBasicId "vec2"
917 nPar = AST.unsafeVHDLBasicId "n"
918 leftPar = AST.unsafeVHDLBasicId "nLeft"
919 rightPar = AST.unsafeVHDLBasicId "nRight"
920 iId = AST.unsafeVHDLBasicId "i"
922 aPar = AST.unsafeVHDLBasicId "a"
923 fPar = AST.unsafeVHDLBasicId "f"
924 sPar = AST.unsafeVHDLBasicId "s"
925 resId = AST.unsafeVHDLBasicId "res"
926 exSpec = AST.Function (mkVHDLExtId exId) [AST.IfaceVarDec vecPar vectorTM,
927 AST.IfaceVarDec ixPar naturalTM] elemTM
928 exExpr = AST.ReturnSm (Just $ AST.PrimName $ AST.NIndexed
929 (AST.IndexedName (AST.NSimple vecPar) [AST.PrimName $
931 replaceSpec = AST.Function (mkVHDLExtId replaceId) [ AST.IfaceVarDec vecPar vectorTM
932 , AST.IfaceVarDec iPar naturalTM
933 , AST.IfaceVarDec aPar elemTM
935 -- variable res : fsvec_x (0 to vec'length-1);
938 (AST.SubtypeIn vectorTM
939 (Just $ AST.ConstraintIndex $ AST.IndexConstraint
940 [AST.ToRange (AST.PrimLit "0")
941 (AST.PrimName (AST.NAttribute $
942 AST.AttribName (AST.NSimple vecPar) (AST.NSimple $ mkVHDLBasicId lengthId) Nothing) AST.:-:
943 (AST.PrimLit "1")) ]))
945 -- res AST.:= vec(0 to i-1) & a & vec(i+1 to length'vec-1)
946 replaceExpr = AST.NSimple resId AST.:=
947 (vecSlice (AST.PrimLit "0") (AST.PrimName (AST.NSimple iPar) AST.:-: AST.PrimLit "1") AST.:&:
948 AST.PrimName (AST.NSimple aPar) AST.:&:
949 vecSlice (AST.PrimName (AST.NSimple iPar) AST.:+: AST.PrimLit "1")
950 ((AST.PrimName (AST.NAttribute $
951 AST.AttribName (AST.NSimple vecPar) (AST.NSimple $ mkVHDLBasicId lengthId) Nothing))
952 AST.:-: AST.PrimLit "1"))
953 replaceRet = AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple resId)
954 vecSlice init last = AST.PrimName (AST.NSlice
957 (AST.ToRange init last)))
958 lastSpec = AST.Function (mkVHDLExtId lastId) [AST.IfaceVarDec vecPar vectorTM] elemTM
959 -- return vec(vec'length-1);
960 lastExpr = AST.ReturnSm (Just $ (AST.PrimName $ AST.NIndexed (AST.IndexedName
962 [AST.PrimName (AST.NAttribute $
963 AST.AttribName (AST.NSimple vecPar) (AST.NSimple $ mkVHDLBasicId lengthId) Nothing)
964 AST.:-: AST.PrimLit "1"])))
965 initSpec = AST.Function (mkVHDLExtId initId) [AST.IfaceVarDec vecPar vectorTM] vectorTM
966 -- variable res : fsvec_x (0 to vec'length-2);
969 (AST.SubtypeIn vectorTM
970 (Just $ AST.ConstraintIndex $ AST.IndexConstraint
971 [AST.ToRange (AST.PrimLit "0")
972 (AST.PrimName (AST.NAttribute $
973 AST.AttribName (AST.NSimple vecPar) (AST.NSimple $ mkVHDLBasicId lengthId) Nothing) AST.:-:
974 (AST.PrimLit "2")) ]))
976 -- resAST.:= vec(0 to vec'length-2)
977 initExpr = AST.NSimple resId AST.:= (vecSlice
979 (AST.PrimName (AST.NAttribute $
980 AST.AttribName (AST.NSimple vecPar) (AST.NSimple $ mkVHDLBasicId lengthId) Nothing)
981 AST.:-: AST.PrimLit "2"))
982 initRet = AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple resId)
983 minimumSpec = AST.Function (mkVHDLExtId minimumId) [AST.IfaceVarDec leftPar naturalTM,
984 AST.IfaceVarDec rightPar naturalTM ] naturalTM
985 minimumExpr = AST.IfSm ((AST.PrimName $ AST.NSimple leftPar) AST.:<: (AST.PrimName $ AST.NSimple rightPar))
986 [AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple leftPar)]
988 (Just $ AST.Else [minimumExprRet])
989 where minimumExprRet = AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple rightPar)
990 takeSpec = AST.Function (mkVHDLExtId takeId) [AST.IfaceVarDec nPar naturalTM,
991 AST.IfaceVarDec vecPar vectorTM ] vectorTM
992 -- variable res : fsvec_x (0 to (minimum (n,vec'length))-1);
993 minLength = AST.PrimFCall $ AST.FCall (AST.NSimple (mkVHDLExtId minimumId))
994 [Nothing AST.:=>: AST.ADExpr (AST.PrimName $ AST.NSimple nPar)
995 ,Nothing AST.:=>: AST.ADExpr (AST.PrimName (AST.NAttribute $
996 AST.AttribName (AST.NSimple vecPar) (AST.NSimple $ mkVHDLBasicId lengthId) Nothing))]
999 (AST.SubtypeIn vectorTM
1000 (Just $ AST.ConstraintIndex $ AST.IndexConstraint
1001 [AST.ToRange (AST.PrimLit "0")
1003 (AST.PrimLit "1")) ]))
1005 -- res AST.:= vec(0 to n-1)
1006 takeExpr = AST.NSimple resId AST.:=
1007 (vecSlice (AST.PrimLit "0")
1008 (minLength AST.:-: AST.PrimLit "1"))
1009 takeRet = AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple resId)
1010 dropSpec = AST.Function (mkVHDLExtId dropId) [AST.IfaceVarDec nPar naturalTM,
1011 AST.IfaceVarDec vecPar vectorTM ] vectorTM
1012 -- variable res : fsvec_x (0 to vec'length-n-1);
1015 (AST.SubtypeIn vectorTM
1016 (Just $ AST.ConstraintIndex $ AST.IndexConstraint
1017 [AST.ToRange (AST.PrimLit "0")
1018 (AST.PrimName (AST.NAttribute $
1019 AST.AttribName (AST.NSimple vecPar) (AST.NSimple $ mkVHDLBasicId lengthId) Nothing) AST.:-:
1020 (AST.PrimName $ AST.NSimple nPar)AST.:-: (AST.PrimLit "1")) ]))
1022 -- res AST.:= vec(n to vec'length-1)
1023 dropExpr = AST.NSimple resId AST.:= (vecSlice
1024 (AST.PrimName $ AST.NSimple nPar)
1025 (AST.PrimName (AST.NAttribute $
1026 AST.AttribName (AST.NSimple vecPar) (AST.NSimple $ mkVHDLBasicId lengthId) Nothing)
1027 AST.:-: AST.PrimLit "1"))
1028 dropRet = AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple resId)
1029 plusgtSpec = AST.Function (mkVHDLExtId plusgtId) [AST.IfaceVarDec aPar elemTM,
1030 AST.IfaceVarDec vecPar vectorTM] vectorTM
1031 -- variable res : fsvec_x (0 to vec'length);
1034 (AST.SubtypeIn vectorTM
1035 (Just $ AST.ConstraintIndex $ AST.IndexConstraint
1036 [AST.ToRange (AST.PrimLit "0")
1037 (AST.PrimName (AST.NAttribute $
1038 AST.AttribName (AST.NSimple vecPar) (AST.NSimple $ mkVHDLBasicId lengthId) Nothing))]))
1040 plusgtExpr = AST.NSimple resId AST.:=
1041 ((AST.PrimName $ AST.NSimple aPar) AST.:&:
1042 (AST.PrimName $ AST.NSimple vecPar))
1043 plusgtRet = AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple resId)
1044 emptySpec = AST.Function (mkVHDLExtId emptyId) [] vectorTM
1047 (AST.SubtypeIn vectorTM Nothing)
1048 (Just $ AST.PrimLit "\"\"")
1049 emptyExpr = AST.ReturnSm (Just $ AST.PrimName (AST.NSimple resId))
1050 singletonSpec = AST.Function (mkVHDLExtId singletonId) [AST.IfaceVarDec aPar elemTM ]
1052 -- variable res : fsvec_x (0 to 0) := (others => a);
1055 (AST.SubtypeIn vectorTM
1056 (Just $ AST.ConstraintIndex $ AST.IndexConstraint
1057 [AST.ToRange (AST.PrimLit "0") (AST.PrimLit "0")]))
1058 (Just $ AST.Aggregate [AST.ElemAssoc (Just AST.Others)
1059 (AST.PrimName $ AST.NSimple aPar)])
1060 singletonRet = AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple resId)
1061 copynSpec = AST.Function (mkVHDLExtId copynId) [AST.IfaceVarDec nPar naturalTM,
1062 AST.IfaceVarDec aPar elemTM ] vectorTM
1063 -- variable res : fsvec_x (0 to n-1) := (others => a);
1066 (AST.SubtypeIn vectorTM
1067 (Just $ AST.ConstraintIndex $ AST.IndexConstraint
1068 [AST.ToRange (AST.PrimLit "0")
1069 ((AST.PrimName (AST.NSimple nPar)) AST.:-:
1070 (AST.PrimLit "1")) ]))
1071 (Just $ AST.Aggregate [AST.ElemAssoc (Just AST.Others)
1072 (AST.PrimName $ AST.NSimple aPar)])
1074 copynExpr = AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple resId)
1075 selSpec = AST.Function (mkVHDLExtId selId) [AST.IfaceVarDec fPar naturalTM,
1076 AST.IfaceVarDec sPar naturalTM,
1077 AST.IfaceVarDec nPar naturalTM,
1078 AST.IfaceVarDec vecPar vectorTM ] vectorTM
1079 -- variable res : fsvec_x (0 to n-1);
1082 (AST.SubtypeIn vectorTM
1083 (Just $ AST.ConstraintIndex $ AST.IndexConstraint
1084 [AST.ToRange (AST.PrimLit "0")
1085 ((AST.PrimName (AST.NSimple nPar)) AST.:-:
1086 (AST.PrimLit "1")) ])
1089 -- for i res'range loop
1090 -- res(i) := vec(f+i*s);
1092 selFor = AST.ForSM iId (AST.AttribRange $ AST.AttribName (AST.NSimple resId) (AST.NSimple $ rangeId) Nothing) [selAssign]
1093 -- res(i) := vec(f+i*s);
1094 selAssign = let origExp = AST.PrimName (AST.NSimple fPar) AST.:+:
1095 (AST.PrimName (AST.NSimple iId) AST.:*:
1096 AST.PrimName (AST.NSimple sPar)) in
1097 AST.NIndexed (AST.IndexedName (AST.NSimple resId) [AST.PrimName (AST.NSimple iId)]) AST.:=
1098 (AST.PrimName $ AST.NIndexed (AST.IndexedName (AST.NSimple vecPar) [origExp]))
1100 selRet = AST.ReturnSm (Just $ AST.PrimName (AST.NSimple resId))
1101 ltplusSpec = AST.Function (mkVHDLExtId ltplusId) [AST.IfaceVarDec vecPar vectorTM,
1102 AST.IfaceVarDec aPar elemTM] vectorTM
1103 -- variable res : fsvec_x (0 to vec'length);
1106 (AST.SubtypeIn vectorTM
1107 (Just $ AST.ConstraintIndex $ AST.IndexConstraint
1108 [AST.ToRange (AST.PrimLit "0")
1109 (AST.PrimName (AST.NAttribute $
1110 AST.AttribName (AST.NSimple vecPar) (AST.NSimple $ mkVHDLBasicId lengthId) Nothing))]))
1112 ltplusExpr = AST.NSimple resId AST.:=
1113 ((AST.PrimName $ AST.NSimple vecPar) AST.:&:
1114 (AST.PrimName $ AST.NSimple aPar))
1115 ltplusRet = AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple resId)
1116 plusplusSpec = AST.Function (mkVHDLExtId plusplusId) [AST.IfaceVarDec vec1Par vectorTM,
1117 AST.IfaceVarDec vec2Par vectorTM]
1119 -- variable res : fsvec_x (0 to vec1'length + vec2'length -1);
1122 (AST.SubtypeIn vectorTM
1123 (Just $ AST.ConstraintIndex $ AST.IndexConstraint
1124 [AST.ToRange (AST.PrimLit "0")
1125 (AST.PrimName (AST.NAttribute $
1126 AST.AttribName (AST.NSimple vec1Par) (AST.NSimple $ mkVHDLBasicId lengthId) Nothing) AST.:+:
1127 AST.PrimName (AST.NAttribute $
1128 AST.AttribName (AST.NSimple vec2Par) (AST.NSimple $ mkVHDLBasicId lengthId) Nothing) AST.:-:
1131 plusplusExpr = AST.NSimple resId AST.:=
1132 ((AST.PrimName $ AST.NSimple vec1Par) AST.:&:
1133 (AST.PrimName $ AST.NSimple vec2Par))
1134 plusplusRet = AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple resId)
1135 lengthTSpec = AST.Function (mkVHDLExtId lengthTId) [AST.IfaceVarDec vecPar vectorTM] naturalTM
1136 lengthTExpr = AST.ReturnSm (Just $ AST.PrimName (AST.NAttribute $
1137 AST.AttribName (AST.NSimple vecPar) (AST.NSimple $ mkVHDLBasicId lengthId) Nothing))
1138 shiftlSpec = AST.Function (mkVHDLExtId shiftlId) [AST.IfaceVarDec vecPar vectorTM,
1139 AST.IfaceVarDec aPar elemTM ] vectorTM
1140 -- variable res : fsvec_x (0 to vec'length-1);
1143 (AST.SubtypeIn vectorTM
1144 (Just $ AST.ConstraintIndex $ AST.IndexConstraint
1145 [AST.ToRange (AST.PrimLit "0")
1146 (AST.PrimName (AST.NAttribute $
1147 AST.AttribName (AST.NSimple vecPar) (AST.NSimple $ mkVHDLBasicId lengthId) Nothing) AST.:-:
1148 (AST.PrimLit "1")) ]))
1150 -- res := a & init(vec)
1151 shiftlExpr = AST.NSimple resId AST.:=
1152 (AST.PrimName (AST.NSimple aPar) AST.:&:
1153 (AST.PrimFCall $ AST.FCall (AST.NSimple (mkVHDLExtId initId))
1154 [Nothing AST.:=>: AST.ADExpr (AST.PrimName $ AST.NSimple vecPar)]))
1155 shiftlRet = AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple resId)
1156 shiftrSpec = AST.Function (mkVHDLExtId shiftrId) [AST.IfaceVarDec vecPar vectorTM,
1157 AST.IfaceVarDec aPar elemTM ] vectorTM
1158 -- variable res : fsvec_x (0 to vec'length-1);
1161 (AST.SubtypeIn vectorTM
1162 (Just $ AST.ConstraintIndex $ AST.IndexConstraint
1163 [AST.ToRange (AST.PrimLit "0")
1164 (AST.PrimName (AST.NAttribute $
1165 AST.AttribName (AST.NSimple vecPar) (AST.NSimple $ mkVHDLBasicId lengthId) Nothing) AST.:-:
1166 (AST.PrimLit "1")) ]))
1168 -- res := tail(vec) & a
1169 shiftrExpr = AST.NSimple resId AST.:=
1170 ((AST.PrimFCall $ AST.FCall (AST.NSimple (mkVHDLExtId tailId))
1171 [Nothing AST.:=>: AST.ADExpr (AST.PrimName $ AST.NSimple vecPar)]) AST.:&:
1172 (AST.PrimName (AST.NSimple aPar)))
1174 shiftrRet = AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple resId)
1175 nullSpec = AST.Function (mkVHDLExtId nullId) [AST.IfaceVarDec vecPar vectorTM] booleanTM
1176 -- return vec'length = 0
1177 nullExpr = AST.ReturnSm (Just $
1178 AST.PrimName (AST.NAttribute $
1179 AST.AttribName (AST.NSimple vecPar) (AST.NSimple $ mkVHDLBasicId lengthId) Nothing) AST.:=:
1181 rotlSpec = AST.Function (mkVHDLExtId rotlId) [AST.IfaceVarDec vecPar vectorTM] vectorTM
1182 -- variable res : fsvec_x (0 to vec'length-1);
1185 (AST.SubtypeIn vectorTM
1186 (Just $ AST.ConstraintIndex $ AST.IndexConstraint
1187 [AST.ToRange (AST.PrimLit "0")
1188 (AST.PrimName (AST.NAttribute $
1189 AST.AttribName (AST.NSimple vecPar) (AST.NSimple $ mkVHDLBasicId lengthId) Nothing) AST.:-:
1190 (AST.PrimLit "1")) ]))
1192 -- if null(vec) then res := vec else res := last(vec) & init(vec)
1193 rotlExpr = AST.IfSm (AST.PrimFCall $ AST.FCall (AST.NSimple (mkVHDLExtId nullId))
1194 [Nothing AST.:=>: AST.ADExpr (AST.PrimName $ AST.NSimple vecPar)])
1195 [AST.NSimple resId AST.:= (AST.PrimName $ AST.NSimple vecPar)]
1197 (Just $ AST.Else [rotlExprRet])
1199 AST.NSimple resId AST.:=
1200 ((AST.PrimFCall $ AST.FCall (AST.NSimple (mkVHDLExtId lastId))
1201 [Nothing AST.:=>: AST.ADExpr (AST.PrimName $ AST.NSimple vecPar)]) AST.:&:
1202 (AST.PrimFCall $ AST.FCall (AST.NSimple (mkVHDLExtId initId))
1203 [Nothing AST.:=>: AST.ADExpr (AST.PrimName $ AST.NSimple vecPar)]))
1204 rotlRet = AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple resId)
1205 rotrSpec = AST.Function (mkVHDLExtId rotrId) [AST.IfaceVarDec vecPar vectorTM] vectorTM
1206 -- variable res : fsvec_x (0 to vec'length-1);
1209 (AST.SubtypeIn vectorTM
1210 (Just $ AST.ConstraintIndex $ AST.IndexConstraint
1211 [AST.ToRange (AST.PrimLit "0")
1212 (AST.PrimName (AST.NAttribute $
1213 AST.AttribName (AST.NSimple vecPar) (AST.NSimple $ mkVHDLBasicId lengthId) Nothing) AST.:-:
1214 (AST.PrimLit "1")) ]))
1216 -- if null(vec) then res := vec else res := tail(vec) & head(vec)
1217 rotrExpr = AST.IfSm (AST.PrimFCall $ AST.FCall (AST.NSimple (mkVHDLExtId nullId))
1218 [Nothing AST.:=>: AST.ADExpr (AST.PrimName $ AST.NSimple vecPar)])
1219 [AST.NSimple resId AST.:= (AST.PrimName $ AST.NSimple vecPar)]
1221 (Just $ AST.Else [rotrExprRet])
1223 AST.NSimple resId AST.:=
1224 ((AST.PrimFCall $ AST.FCall (AST.NSimple (mkVHDLExtId tailId))
1225 [Nothing AST.:=>: AST.ADExpr (AST.PrimName $ AST.NSimple vecPar)]) AST.:&:
1226 (AST.PrimFCall $ AST.FCall (AST.NSimple (mkVHDLExtId headId))
1227 [Nothing AST.:=>: AST.ADExpr (AST.PrimName $ AST.NSimple vecPar)]))
1228 rotrRet = AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple resId)
1229 reverseSpec = AST.Function (mkVHDLExtId reverseId) [AST.IfaceVarDec vecPar vectorTM] vectorTM
1232 (AST.SubtypeIn vectorTM
1233 (Just $ AST.ConstraintIndex $ AST.IndexConstraint
1234 [AST.ToRange (AST.PrimLit "0")
1235 (AST.PrimName (AST.NAttribute $
1236 AST.AttribName (AST.NSimple vecPar) (AST.NSimple $ mkVHDLBasicId lengthId) Nothing) AST.:-:
1237 (AST.PrimLit "1")) ]))
1239 -- for i in 0 to res'range loop
1240 -- res(vec'length-i-1) := vec(i);
1243 AST.ForSM iId (AST.AttribRange $ AST.AttribName (AST.NSimple resId) (AST.NSimple $ rangeId) Nothing) [reverseAssign]
1244 -- res(vec'length-i-1) := vec(i);
1245 reverseAssign = AST.NIndexed (AST.IndexedName (AST.NSimple resId) [destExp]) AST.:=
1246 (AST.PrimName $ AST.NIndexed (AST.IndexedName (AST.NSimple vecPar)
1247 [AST.PrimName $ AST.NSimple iId]))
1248 where destExp = AST.PrimName (AST.NAttribute $ AST.AttribName (AST.NSimple vecPar)
1249 (AST.NSimple $ mkVHDLBasicId lengthId) Nothing) AST.:-:
1250 AST.PrimName (AST.NSimple iId) AST.:-:
1253 reverseRet = AST.ReturnSm (Just $ AST.PrimName (AST.NSimple resId))
1256 -----------------------------------------------------------------------------
1257 -- A table of builtin functions
1258 -----------------------------------------------------------------------------
1260 -- A function that generates VHDL for a builtin function
1261 type BuiltinBuilder =
1262 (Either CoreSyn.CoreBndr AST.VHDLName) -- ^ The destination signal and it's original type
1263 -> CoreSyn.CoreBndr -- ^ The function called
1264 -> [Either CoreSyn.CoreExpr AST.Expr] -- ^ The value arguments passed (excluding type and
1265 -- dictionary arguments).
1266 -> TranslatorSession ([AST.ConcSm], [CoreSyn.CoreBndr])
1267 -- ^ The corresponding VHDL concurrent statements and entities
1270 -- A map of a builtin function to VHDL function builder
1271 type NameTable = Map.Map String (Int, BuiltinBuilder )
1273 -- | The builtin functions we support. Maps a name to an argument count and a
1274 -- builder function.
1275 globalNameTable :: NameTable
1276 globalNameTable = Map.fromList
1277 [ (exId , (2, genFCall True ) )
1278 , (replaceId , (3, genFCall False ) )
1279 , (headId , (1, genFCall True ) )
1280 , (lastId , (1, genFCall True ) )
1281 , (tailId , (1, genFCall False ) )
1282 , (initId , (1, genFCall False ) )
1283 , (takeId , (2, genFCall False ) )
1284 , (dropId , (2, genFCall False ) )
1285 , (selId , (4, genFCall False ) )
1286 , (plusgtId , (2, genFCall False ) )
1287 , (ltplusId , (2, genFCall False ) )
1288 , (plusplusId , (2, genFCall False ) )
1289 , (mapId , (2, genMap ) )
1290 , (zipWithId , (3, genZipWith ) )
1291 , (foldlId , (3, genFoldl ) )
1292 , (foldrId , (3, genFoldr ) )
1293 , (zipId , (2, genZip ) )
1294 , (unzipId , (1, genUnzip ) )
1295 , (shiftlId , (2, genFCall False ) )
1296 , (shiftrId , (2, genFCall False ) )
1297 , (rotlId , (1, genFCall False ) )
1298 , (rotrId , (1, genFCall False ) )
1299 , (concatId , (1, genConcat ) )
1300 , (reverseId , (1, genFCall False ) )
1301 , (iteratenId , (3, genIteraten ) )
1302 , (iterateId , (2, genIterate ) )
1303 , (generatenId , (3, genGeneraten ) )
1304 , (generateId , (2, genGenerate ) )
1305 , (emptyId , (0, genFCall False ) )
1306 , (singletonId , (1, genFCall False ) )
1307 , (copynId , (2, genFCall False ) )
1308 , (copyId , (1, genCopy ) )
1309 , (lengthTId , (1, genFCall False ) )
1310 , (nullId , (1, genFCall False ) )
1311 , (hwxorId , (2, genOperator2 AST.Xor ) )
1312 , (hwandId , (2, genOperator2 AST.And ) )
1313 , (hworId , (2, genOperator2 AST.Or ) )
1314 , (hwnotId , (1, genOperator1 AST.Not ) )
1315 , (plusId , (2, genOperator2 (AST.:+:) ) )
1316 , (timesId , (2, genOperator2 (AST.:*:) ) )
1317 , (negateId , (1, genNegation ) )
1318 , (minusId , (2, genOperator2 (AST.:-:) ) )
1319 , (fromSizedWordId , (1, genFromSizedWord ) )
1320 , (fromIntegerId , (1, genFromInteger ) )
1321 , (resizeId , (1, genResize ) )
1322 , (sizedIntId , (1, genSizedInt ) )
1323 --, (tfvecId , (1, genTFVec ) )
1324 , (minimumId , (2, error $ "\nFunction name: \"minimum\" is used internally, use another name"))