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 = catMaybesM . (mapM argToVHDLExpr)
209 argToVHDLExpr :: Either CoreSyn.CoreExpr AST.Expr -> TranslatorSession (Maybe AST.Expr)
210 argToVHDLExpr (Left expr) = MonadState.lift tsType $ do
211 let errmsg = "Generate.argToVHDLExpr: Using non-representable type? Should not happen!"
212 ty_maybe <- vhdl_ty errmsg expr
215 vhdl_expr <- varToVHDLExpr $ exprToVar expr
216 return $ Just vhdl_expr
217 Nothing -> return $ Nothing
219 argToVHDLExpr (Right expr) = return $ Just expr
221 -- A function to wrap a builder-like function that generates no component
224 (dst -> func -> args -> TranslatorSession [AST.ConcSm])
225 -> (dst -> func -> args -> TranslatorSession ([AST.ConcSm], [CoreSyn.CoreBndr]))
226 genNoInsts wrap dst func args = do
227 concsms <- wrap dst func args
230 -- | A function to wrap a builder-like function that expects its arguments to
233 (dst -> func -> [Var.Var] -> res)
234 -> (dst -> func -> [Either CoreSyn.CoreExpr AST.Expr] -> res)
235 genVarArgs wrap dst func args = wrap dst func args'
237 args' = map exprToVar exprargs
238 -- Check (rather crudely) that all arguments are CoreExprs
239 (exprargs, []) = Either.partitionEithers args
241 -- | A function to wrap a builder-like function that expects its arguments to
244 (dst -> func -> [Literal.Literal] -> res)
245 -> (dst -> func -> [Either CoreSyn.CoreExpr AST.Expr] -> res)
246 genLitArgs wrap dst func args = wrap dst func args'
248 args' = map exprToLit litargs
249 -- FIXME: Check if we were passed an CoreSyn.App
250 litargs = concat (map getLiterals exprargs)
251 (exprargs, []) = Either.partitionEithers args
253 -- | A function to wrap a builder-like function that produces an expression
254 -- and expects it to be assigned to the destination.
256 ((Either CoreSyn.CoreBndr AST.VHDLName) -> func -> [arg] -> TranslatorSession AST.Expr)
257 -> ((Either CoreSyn.CoreBndr AST.VHDLName) -> func -> [arg] -> TranslatorSession [AST.ConcSm])
258 genExprRes wrap dst func args = do
259 expr <- wrap dst func args
260 return $ [mkUncondAssign dst expr]
262 -- | Generate a binary operator application. The first argument should be a
263 -- constructor from the AST.Expr type, e.g. AST.And.
264 genOperator2 :: (AST.Expr -> AST.Expr -> AST.Expr) -> BuiltinBuilder
265 genOperator2 op = genNoInsts $ genExprArgs $ genExprRes (genOperator2' op)
266 genOperator2' :: (AST.Expr -> AST.Expr -> AST.Expr) -> dst -> CoreSyn.CoreBndr -> [AST.Expr] -> TranslatorSession AST.Expr
267 genOperator2' op _ f [arg1, arg2] = return $ op arg1 arg2
269 -- | Generate a unary operator application
270 genOperator1 :: (AST.Expr -> AST.Expr) -> BuiltinBuilder
271 genOperator1 op = genNoInsts $ genExprArgs $ genExprRes (genOperator1' op)
272 genOperator1' :: (AST.Expr -> AST.Expr) -> dst -> CoreSyn.CoreBndr -> [AST.Expr] -> TranslatorSession AST.Expr
273 genOperator1' op _ f [arg] = return $ op arg
275 -- | Generate a unary operator application
276 genNegation :: BuiltinBuilder
277 genNegation = genNoInsts $ genVarArgs $ genExprRes genNegation'
278 genNegation' :: dst -> CoreSyn.CoreBndr -> [Var.Var] -> TranslatorSession AST.Expr
279 genNegation' _ f [arg] = do
280 arg1 <- MonadState.lift tsType $ varToVHDLExpr arg
281 let ty = Var.varType arg
282 let (tycon, args) = Type.splitTyConApp ty
283 let name = Name.getOccString (TyCon.tyConName tycon)
285 "SizedInt" -> return $ AST.Neg arg1
286 otherwise -> error $ "\nGenerate.genNegation': Negation allowed for type: " ++ show name
288 -- | Generate a function call from the destination binder, function name and a
289 -- list of expressions (its arguments)
290 genFCall :: Bool -> BuiltinBuilder
291 genFCall switch = genNoInsts $ genExprArgs $ genExprRes (genFCall' switch)
292 genFCall' :: Bool -> Either CoreSyn.CoreBndr AST.VHDLName -> CoreSyn.CoreBndr -> [AST.Expr] -> TranslatorSession AST.Expr
293 genFCall' switch (Left res) f args = do
294 let fname = varToString f
295 let el_ty = if switch then (Var.varType res) else ((tfvec_elem . Var.varType) res)
296 id <- MonadState.lift tsType $ vectorFunId el_ty fname
297 return $ AST.PrimFCall $ AST.FCall (AST.NSimple id) $
298 map (\exp -> Nothing AST.:=>: AST.ADExpr exp) args
299 genFCall' _ (Right name) _ _ = error $ "\nGenerate.genFCall': Cannot generate builtin function call assigned to a VHDLName: " ++ show name
301 genFromSizedWord :: BuiltinBuilder
302 genFromSizedWord = genNoInsts $ genExprArgs $ genExprRes genFromSizedWord'
303 genFromSizedWord' :: Either CoreSyn.CoreBndr AST.VHDLName -> CoreSyn.CoreBndr -> [AST.Expr] -> TranslatorSession AST.Expr
304 genFromSizedWord' (Left res) f args = do
305 let fname = varToString f
306 return $ AST.PrimFCall $ AST.FCall (AST.NSimple (mkVHDLBasicId toIntegerId)) $
307 map (\exp -> Nothing AST.:=>: AST.ADExpr exp) args
308 genFromSizedWord' (Right name) _ _ = error $ "\nGenerate.genFromSizedWord': Cannot generate builtin function call assigned to a VHDLName: " ++ show name
310 genResize :: BuiltinBuilder
311 genResize = genNoInsts $ genExprArgs $ genExprRes genResize'
312 genResize' :: Either CoreSyn.CoreBndr AST.VHDLName -> CoreSyn.CoreBndr -> [AST.Expr] -> TranslatorSession AST.Expr
313 genResize' (Left res) f [arg] = do {
314 ; let { ty = Var.varType res
315 ; (tycon, args) = Type.splitTyConApp ty
316 ; name = Name.getOccString (TyCon.tyConName tycon)
318 ; len <- case name of
319 "SizedInt" -> MonadState.lift tsType $ tfp_to_int (sized_int_len_ty ty)
320 "SizedWord" -> MonadState.lift tsType $ tfp_to_int (sized_word_len_ty ty)
321 ; return $ AST.PrimFCall $ AST.FCall (AST.NSimple (mkVHDLBasicId resizeId))
322 [Nothing AST.:=>: AST.ADExpr arg, Nothing AST.:=>: AST.ADExpr( AST.PrimLit (show len))]
324 genResize' (Right name) _ _ = error $ "\nGenerate.genFromSizedWord': Cannot generate builtin function call assigned to a VHDLName: " ++ show name
326 -- FIXME: I'm calling genLitArgs which is very specific function,
327 -- which needs to be fixed as well
328 genFromInteger :: BuiltinBuilder
329 genFromInteger = genNoInsts $ genLitArgs $ genExprRes genFromInteger'
330 genFromInteger' :: Either CoreSyn.CoreBndr AST.VHDLName -> CoreSyn.CoreBndr -> [Literal.Literal] -> TranslatorSession AST.Expr
331 genFromInteger' (Left res) f lits = do {
332 ; let { ty = Var.varType res
333 ; (tycon, args) = Type.splitTyConApp ty
334 ; name = Name.getOccString (TyCon.tyConName tycon)
337 "RangedWord" -> return $ AST.PrimLit (show (last lits))
339 ; len <- case name of
340 "SizedInt" -> MonadState.lift tsType $ tfp_to_int (sized_int_len_ty ty)
341 "SizedWord" -> MonadState.lift tsType $ tfp_to_int (sized_word_len_ty ty)
342 "RangedWord" -> MonadState.lift tsType $ tfp_to_int (ranged_word_bound_ty ty)
343 ; let fname = case name of "SizedInt" -> toSignedId ; "SizedWord" -> toUnsignedId
344 ; return $ AST.PrimFCall $ AST.FCall (AST.NSimple (mkVHDLBasicId fname))
345 [Nothing AST.:=>: AST.ADExpr (AST.PrimLit (show (last lits))), Nothing AST.:=>: AST.ADExpr( AST.PrimLit (show len))]
349 genFromInteger' (Right name) _ _ = error $ "\nGenerate.genFromInteger': Cannot generate builtin function call assigned to a VHDLName: " ++ show name
351 genSizedInt :: BuiltinBuilder
352 genSizedInt = genFromInteger
355 -- | Generate a Builder for the builtin datacon TFVec
356 genTFVec :: BuiltinBuilder
357 genTFVec (Left res) f [Left (CoreSyn.Let (CoreSyn.Rec letBinders) letRes)] = do {
358 -- Generate Assignments for all the binders
359 ; letAssigns <- mapM genBinderAssign letBinders
360 -- Generate assignments for the result (which might be another let binding)
361 ; (resBinders,resAssignments) <- genResAssign letRes
362 -- Get all the Assigned binders
363 ; let assignedBinders = Maybe.catMaybes (map fst letAssigns)
364 -- Make signal names for all the assigned binders
365 ; sigs <- mapM (\x -> MonadState.lift tsType $ varToVHDLExpr x) (assignedBinders ++ resBinders)
366 -- Assign all the signals to the resulting vector
367 ; let { vecsigns = mkAggregateSignal sigs
368 ; vecassign = mkUncondAssign (Left res) vecsigns
370 -- Generate all the signal declaration for the assigned binders
371 ; sig_dec_maybes <- mapM mkSigDec (assignedBinders ++ resBinders)
372 ; let { sig_decs = map (AST.BDISD) (Maybe.catMaybes $ sig_dec_maybes)
373 -- Setup the VHDL Block
374 ; block_label = mkVHDLExtId ("TFVec_" ++ show (varToString res))
375 ; block = AST.BlockSm block_label [] (AST.PMapAspect []) sig_decs ((concat (map snd letAssigns)) ++ resAssignments ++ [vecassign])
377 -- Return the block statement coressponding to the TFVec literal
378 ; return $ [AST.CSBSm block]
381 genBinderAssign :: (CoreSyn.CoreBndr, CoreSyn.CoreExpr) -> TranslatorSession (Maybe CoreSyn.CoreBndr, [AST.ConcSm])
382 -- For now we only translate applications
383 genBinderAssign (bndr, app@(CoreSyn.App _ _)) = do
384 let (CoreSyn.Var f, args) = CoreSyn.collectArgs app
385 let valargs = get_val_args (Var.varType f) args
386 apps <- genApplication (Left bndr) f (map Left valargs)
387 return (Just bndr, apps)
388 genBinderAssign _ = return (Nothing,[])
389 genResAssign :: CoreSyn.CoreExpr -> TranslatorSession ([CoreSyn.CoreBndr], [AST.ConcSm])
390 genResAssign app@(CoreSyn.App _ letexpr) = do
392 (CoreSyn.Let (CoreSyn.Rec letbndrs) letres) -> do
393 letapps <- mapM genBinderAssign letbndrs
394 let bndrs = Maybe.catMaybes (map fst letapps)
395 let app = (map snd letapps)
396 (vars, apps) <- genResAssign letres
397 return ((bndrs ++ vars),((concat app) ++ apps))
398 otherwise -> return ([],[])
399 genResAssign _ = return ([],[])
401 genTFVec (Left res) f [Left app@(CoreSyn.App _ _)] = do {
402 ; let { elems = reduceCoreListToHsList app
403 -- Make signal names for all the binders
404 ; binders = map (\expr -> case expr of
406 otherwise -> error $ "\nGenerate.genTFVec: Cannot generate TFVec: "
407 ++ show res ++ ", with elems:\n" ++ show elems ++ "\n" ++ pprString elems) elems
409 ; sigs <- mapM (\x -> MonadState.lift tsType $ varToVHDLExpr x) binders
410 -- Assign all the signals to the resulting vector
411 ; let { vecsigns = mkAggregateSignal sigs
412 ; vecassign = mkUncondAssign (Left res) vecsigns
413 -- Setup the VHDL Block
414 ; block_label = mkVHDLExtId ("TFVec_" ++ show (varToString res))
415 ; block = AST.BlockSm block_label [] (AST.PMapAspect []) [] [vecassign]
417 -- Return the block statement coressponding to the TFVec literal
418 ; return $ [AST.CSBSm block]
421 genTFVec (Left name) _ [Left xs] = error $ "\nGenerate.genTFVec: Cannot generate TFVec: " ++ show name ++ ", with elems:\n" ++ show xs ++ "\n" ++ pprString xs
423 genTFVec (Right name) _ _ = error $ "\nGenerate.genTFVec: Cannot generate TFVec assigned to VHDLName: " ++ show name
425 -- | Generate a generate statement for the builtin function "map"
426 genMap :: BuiltinBuilder
427 genMap (Left res) f [Left mapped_f, Left (CoreSyn.Var arg)] = do {
428 -- mapped_f must be a CoreExpr (since we can't represent functions as VHDL
429 -- expressions). arg must be a CoreExpr (and should be a CoreSyn.Var), since
430 -- we must index it (which we couldn't if it was a VHDL Expr, since only
431 -- VHDLNames can be indexed).
432 -- Setup the generate scheme
433 ; len <- MonadState.lift tsType $ tfp_to_int $ (tfvec_len_ty . Var.varType) res
434 -- TODO: Use something better than varToString
435 ; let { label = mkVHDLExtId ("mapVector" ++ (varToString res))
436 ; n_id = mkVHDLBasicId "n"
437 ; n_expr = idToVHDLExpr n_id
438 ; range = AST.ToRange (AST.PrimLit "0") (AST.PrimLit $ show (len-1))
439 ; genScheme = AST.ForGn n_id range
440 -- Create the content of the generate statement: Applying the mapped_f to
441 -- each of the elements in arg, storing to each element in res
442 ; resname = mkIndexedName (varToVHDLName res) n_expr
443 ; argexpr = vhdlNameToVHDLExpr $ mkIndexedName (varToVHDLName arg) n_expr
444 ; (CoreSyn.Var real_f, already_mapped_args) = CoreSyn.collectArgs mapped_f
445 ; valargs = get_val_args (Var.varType real_f) already_mapped_args
447 ; (app_concsms, used) <- genApplication (Right resname) real_f (map Left valargs ++ [Right argexpr])
448 -- Return the generate statement
449 ; return ([AST.CSGSm $ AST.GenerateSm label genScheme [] app_concsms], used)
452 genMap' (Right name) _ _ = error $ "\nGenerate.genMap': Cannot generate map function call assigned to a VHDLName: " ++ show name
454 genZipWith :: BuiltinBuilder
455 genZipWith = genVarArgs genZipWith'
456 genZipWith' :: (Either CoreSyn.CoreBndr AST.VHDLName) -> CoreSyn.CoreBndr -> [Var.Var] -> TranslatorSession ([AST.ConcSm], [CoreSyn.CoreBndr])
457 genZipWith' (Left res) f args@[zipped_f, arg1, arg2] = do {
458 -- Setup the generate scheme
459 ; len <- MonadState.lift tsType $ tfp_to_int $ (tfvec_len_ty . Var.varType) res
460 -- TODO: Use something better than varToString
461 ; let { label = mkVHDLExtId ("zipWithVector" ++ (varToString res))
462 ; n_id = mkVHDLBasicId "n"
463 ; n_expr = idToVHDLExpr n_id
464 ; range = AST.ToRange (AST.PrimLit "0") (AST.PrimLit $ show (len-1))
465 ; genScheme = AST.ForGn n_id range
466 -- Create the content of the generate statement: Applying the zipped_f to
467 -- each of the elements in arg1 and arg2, storing to each element in res
468 ; resname = mkIndexedName (varToVHDLName res) n_expr
469 ; argexpr1 = vhdlNameToVHDLExpr $ mkIndexedName (varToVHDLName arg1) n_expr
470 ; argexpr2 = vhdlNameToVHDLExpr $ mkIndexedName (varToVHDLName arg2) n_expr
472 ; (app_concsms, used) <- genApplication (Right resname) zipped_f [Right argexpr1, Right argexpr2]
473 -- Return the generate functions
474 ; return ([AST.CSGSm $ AST.GenerateSm label genScheme [] app_concsms], used)
477 genFoldl :: BuiltinBuilder
478 genFoldl = genFold True
480 genFoldr :: BuiltinBuilder
481 genFoldr = genFold False
483 genFold :: Bool -> BuiltinBuilder
484 genFold left = genVarArgs (genFold' left)
486 genFold' :: Bool -> (Either CoreSyn.CoreBndr AST.VHDLName) -> CoreSyn.CoreBndr -> [Var.Var] -> TranslatorSession ([AST.ConcSm], [CoreSyn.CoreBndr])
487 genFold' left res f args@[folded_f , start ,vec]= do
488 len <- MonadState.lift tsType $ tfp_to_int $ (tfvec_len_ty (Var.varType vec))
489 genFold'' len left res f args
491 genFold'' :: Int -> Bool -> (Either CoreSyn.CoreBndr AST.VHDLName) -> CoreSyn.CoreBndr -> [Var.Var] -> TranslatorSession ([AST.ConcSm], [CoreSyn.CoreBndr])
492 -- Special case for an empty input vector, just assign start to res
493 genFold'' len left (Left res) _ [_, start, vec] | len == 0 = do
494 arg <- MonadState.lift tsType $ varToVHDLExpr start
495 return ([mkUncondAssign (Left res) arg], [])
497 genFold'' len left (Left res) f [folded_f, start, vec] = do
499 --len <- MonadState.lift tsType $ tfp_to_int $ (tfvec_len_ty . Var.varType) vec
500 -- An expression for len-1
501 let len_min_expr = (AST.PrimLit $ show (len-1))
502 -- evec is (TFVec n), so it still needs an element type
503 let (nvec, _) = Type.splitAppTy (Var.varType vec)
504 -- Put the type of the start value in nvec, this will be the type of our
506 let tmp_ty = Type.mkAppTy nvec (Var.varType start)
507 let error_msg = "\nGenerate.genFold': Can not construct temp vector for element type: " ++ pprString tmp_ty
508 -- TODO: Handle Nothing
509 Just tmp_vhdl_ty <- MonadState.lift tsType $ vhdl_ty error_msg tmp_ty
510 -- Setup the generate scheme
511 let gen_label = mkVHDLExtId ("foldlVector" ++ (varToString vec))
512 let block_label = mkVHDLExtId ("foldlVector" ++ (varToString res))
513 let gen_range = if left then AST.ToRange (AST.PrimLit "0") len_min_expr
514 else AST.DownRange len_min_expr (AST.PrimLit "0")
515 let gen_scheme = AST.ForGn n_id gen_range
516 -- Make the intermediate vector
517 let tmp_dec = AST.BDISD $ AST.SigDec tmp_id tmp_vhdl_ty Nothing
518 -- Create the generate statement
519 cells' <- sequence [genFirstCell, genOtherCell]
520 let (cells, useds) = unzip cells'
521 let gen_sm = AST.GenerateSm gen_label gen_scheme [] (map AST.CSGSm cells)
522 -- Assign tmp[len-1] or tmp[0] to res
523 let out_assign = mkUncondAssign (Left res) $ vhdlNameToVHDLExpr (if left then
524 (mkIndexedName tmp_name (AST.PrimLit $ show (len-1))) else
525 (mkIndexedName tmp_name (AST.PrimLit "0")))
526 let block = AST.BlockSm block_label [] (AST.PMapAspect []) [tmp_dec] [AST.CSGSm gen_sm, out_assign]
527 return ([AST.CSBSm block], concat useds)
529 -- An id for the counter
530 n_id = mkVHDLBasicId "n"
531 n_cur = idToVHDLExpr n_id
532 -- An expression for previous n
533 n_prev = if left then (n_cur AST.:-: (AST.PrimLit "1"))
534 else (n_cur AST.:+: (AST.PrimLit "1"))
535 -- An id for the tmp result vector
536 tmp_id = mkVHDLBasicId "tmp"
537 tmp_name = AST.NSimple tmp_id
538 -- Generate parts of the fold
539 genFirstCell, genOtherCell :: TranslatorSession (AST.GenerateSm, [CoreSyn.CoreBndr])
541 len <- MonadState.lift tsType $ tfp_to_int $ (tfvec_len_ty . Var.varType) vec
542 let cond_label = mkVHDLExtId "firstcell"
543 -- if n == 0 or n == len-1
544 let cond_scheme = AST.IfGn $ n_cur AST.:=: (if left then (AST.PrimLit "0")
545 else (AST.PrimLit $ show (len-1)))
546 -- Output to tmp[current n]
547 let resname = mkIndexedName tmp_name n_cur
549 argexpr1 <- MonadState.lift tsType $ varToVHDLExpr start
550 -- Input from vec[current n]
551 let argexpr2 = vhdlNameToVHDLExpr $ mkIndexedName (varToVHDLName vec) n_cur
552 (app_concsms, used) <- genApplication (Right resname) folded_f ( if left then
553 [Right argexpr1, Right argexpr2]
555 [Right argexpr2, Right argexpr1]
557 -- Return the conditional generate part
558 return $ (AST.GenerateSm cond_label cond_scheme [] app_concsms, used)
561 len <- MonadState.lift tsType $ tfp_to_int $ (tfvec_len_ty . Var.varType) vec
562 let cond_label = mkVHDLExtId "othercell"
563 -- if n > 0 or n < len-1
564 let cond_scheme = AST.IfGn $ n_cur AST.:/=: (if left then (AST.PrimLit "0")
565 else (AST.PrimLit $ show (len-1)))
566 -- Output to tmp[current n]
567 let resname = mkIndexedName tmp_name n_cur
568 -- Input from tmp[previous n]
569 let argexpr1 = vhdlNameToVHDLExpr $ mkIndexedName tmp_name n_prev
570 -- Input from vec[current n]
571 let argexpr2 = vhdlNameToVHDLExpr $ mkIndexedName (varToVHDLName vec) n_cur
572 (app_concsms, used) <- genApplication (Right resname) folded_f ( if left then
573 [Right argexpr1, Right argexpr2]
575 [Right argexpr2, Right argexpr1]
577 -- Return the conditional generate part
578 return $ (AST.GenerateSm cond_label cond_scheme [] app_concsms, used)
580 -- | Generate a generate statement for the builtin function "zip"
581 genZip :: BuiltinBuilder
582 genZip = genNoInsts $ genVarArgs genZip'
583 genZip' :: (Either CoreSyn.CoreBndr AST.VHDLName) -> CoreSyn.CoreBndr -> [Var.Var] -> TranslatorSession [AST.ConcSm]
584 genZip' (Left res) f args@[arg1, arg2] = do {
585 -- Setup the generate scheme
586 ; len <- MonadState.lift tsType $ tfp_to_int $ (tfvec_len_ty . Var.varType) res
587 -- TODO: Use something better than varToString
588 ; let { label = mkVHDLExtId ("zipVector" ++ (varToString res))
589 ; n_id = mkVHDLBasicId "n"
590 ; n_expr = idToVHDLExpr n_id
591 ; range = AST.ToRange (AST.PrimLit "0") (AST.PrimLit $ show (len-1))
592 ; genScheme = AST.ForGn n_id range
593 ; resname' = mkIndexedName (varToVHDLName res) n_expr
594 ; argexpr1 = vhdlNameToVHDLExpr $ mkIndexedName (varToVHDLName arg1) n_expr
595 ; argexpr2 = vhdlNameToVHDLExpr $ mkIndexedName (varToVHDLName arg2) n_expr
597 ; labels <- MonadState.lift tsType $ getFieldLabels (tfvec_elem (Var.varType res))
598 ; let { resnameA = mkSelectedName resname' (labels!!0)
599 ; resnameB = mkSelectedName resname' (labels!!1)
600 ; resA_assign = mkUncondAssign (Right resnameA) argexpr1
601 ; resB_assign = mkUncondAssign (Right resnameB) argexpr2
603 -- Return the generate functions
604 ; return [AST.CSGSm $ AST.GenerateSm label genScheme [] [resA_assign,resB_assign]]
607 -- | Generate a generate statement for the builtin function "unzip"
608 genUnzip :: BuiltinBuilder
609 genUnzip = genNoInsts $ genVarArgs genUnzip'
610 genUnzip' :: (Either CoreSyn.CoreBndr AST.VHDLName) -> CoreSyn.CoreBndr -> [Var.Var] -> TranslatorSession [AST.ConcSm]
611 genUnzip' (Left res) f args@[arg] = do {
612 -- Setup the generate scheme
613 ; len <- MonadState.lift tsType $ tfp_to_int $ (tfvec_len_ty . Var.varType) arg
614 -- TODO: Use something better than varToString
615 ; let { label = mkVHDLExtId ("unzipVector" ++ (varToString res))
616 ; n_id = mkVHDLBasicId "n"
617 ; n_expr = idToVHDLExpr n_id
618 ; range = AST.ToRange (AST.PrimLit "0") (AST.PrimLit $ show (len-1))
619 ; genScheme = AST.ForGn n_id range
620 ; resname' = varToVHDLName res
621 ; argexpr' = mkIndexedName (varToVHDLName arg) n_expr
623 ; reslabels <- MonadState.lift tsType $ getFieldLabels (Var.varType res)
624 ; arglabels <- MonadState.lift tsType $ getFieldLabels (tfvec_elem (Var.varType arg))
625 ; let { resnameA = mkIndexedName (mkSelectedName resname' (reslabels!!0)) n_expr
626 ; resnameB = mkIndexedName (mkSelectedName resname' (reslabels!!1)) n_expr
627 ; argexprA = vhdlNameToVHDLExpr $ mkSelectedName argexpr' (arglabels!!0)
628 ; argexprB = vhdlNameToVHDLExpr $ mkSelectedName argexpr' (arglabels!!1)
629 ; resA_assign = mkUncondAssign (Right resnameA) argexprA
630 ; resB_assign = mkUncondAssign (Right resnameB) argexprB
632 -- Return the generate functions
633 ; return [AST.CSGSm $ AST.GenerateSm label genScheme [] [resA_assign,resB_assign]]
636 genCopy :: BuiltinBuilder
637 genCopy = genNoInsts $ genVarArgs genCopy'
638 genCopy' :: (Either CoreSyn.CoreBndr AST.VHDLName ) -> CoreSyn.CoreBndr -> [Var.Var] -> TranslatorSession [AST.ConcSm]
639 genCopy' (Left res) f args@[arg] =
641 resExpr = AST.Aggregate [AST.ElemAssoc (Just AST.Others)
642 (AST.PrimName $ (varToVHDLName arg))]
643 out_assign = mkUncondAssign (Left res) resExpr
647 genConcat :: BuiltinBuilder
648 genConcat = genNoInsts $ genVarArgs genConcat'
649 genConcat' :: (Either CoreSyn.CoreBndr AST.VHDLName) -> CoreSyn.CoreBndr -> [Var.Var] -> TranslatorSession [AST.ConcSm]
650 genConcat' (Left res) f args@[arg] = do {
651 -- Setup the generate scheme
652 ; len1 <- MonadState.lift tsType $ tfp_to_int $ (tfvec_len_ty . Var.varType) arg
653 ; let (_, nvec) = Type.splitAppTy (Var.varType arg)
654 ; len2 <- MonadState.lift tsType $ tfp_to_int $ tfvec_len_ty nvec
655 -- TODO: Use something better than varToString
656 ; let { label = mkVHDLExtId ("concatVector" ++ (varToString res))
657 ; n_id = mkVHDLBasicId "n"
658 ; n_expr = idToVHDLExpr n_id
659 ; fromRange = n_expr AST.:*: (AST.PrimLit $ show len2)
660 ; genScheme = AST.ForGn n_id range
661 -- Create the content of the generate statement: Applying the mapped_f to
662 -- each of the elements in arg, storing to each element in res
663 ; toRange = (n_expr AST.:*: (AST.PrimLit $ show len2)) AST.:+: (AST.PrimLit $ show (len2-1))
664 ; range = AST.ToRange (AST.PrimLit "0") (AST.PrimLit $ show (len1-1))
665 ; resname = vecSlice fromRange toRange
666 ; argexpr = vhdlNameToVHDLExpr $ mkIndexedName (varToVHDLName arg) n_expr
667 ; out_assign = mkUncondAssign (Right resname) argexpr
669 -- Return the generate statement
670 ; return [AST.CSGSm $ AST.GenerateSm label genScheme [] [out_assign]]
673 vecSlice init last = AST.NSlice (AST.SliceName (varToVHDLName res)
674 (AST.ToRange init last))
676 genIteraten :: BuiltinBuilder
677 genIteraten dst f args = genIterate dst f (tail args)
679 genIterate :: BuiltinBuilder
680 genIterate = genIterateOrGenerate True
682 genGeneraten :: BuiltinBuilder
683 genGeneraten dst f args = genGenerate dst f (tail args)
685 genGenerate :: BuiltinBuilder
686 genGenerate = genIterateOrGenerate False
688 genIterateOrGenerate :: Bool -> BuiltinBuilder
689 genIterateOrGenerate iter = genVarArgs (genIterateOrGenerate' iter)
691 genIterateOrGenerate' :: Bool -> (Either CoreSyn.CoreBndr AST.VHDLName) -> CoreSyn.CoreBndr -> [Var.Var] -> TranslatorSession ([AST.ConcSm], [CoreSyn.CoreBndr])
692 genIterateOrGenerate' iter (Left res) f args = do
693 len <- MonadState.lift tsType $ tfp_to_int ((tfvec_len_ty . Var.varType) res)
694 genIterateOrGenerate'' len iter (Left res) f args
696 genIterateOrGenerate'' :: Int -> Bool -> (Either CoreSyn.CoreBndr AST.VHDLName) -> CoreSyn.CoreBndr -> [Var.Var] -> TranslatorSession ([AST.ConcSm], [CoreSyn.CoreBndr])
697 -- Special case for an empty input vector, just assign start to res
698 genIterateOrGenerate'' len iter (Left res) _ [app_f, start] | len == 0 = return ([mkUncondAssign (Left res) (AST.PrimLit "\"\"")], [])
700 genIterateOrGenerate'' len iter (Left res) f [app_f, start] = do
702 -- len <- MonadState.lift tsType $ tfp_to_int ((tfvec_len_ty . Var.varType) res)
703 -- An expression for len-1
704 let len_min_expr = (AST.PrimLit $ show (len-1))
705 -- -- evec is (TFVec n), so it still needs an element type
706 -- let (nvec, _) = splitAppTy (Var.varType vec)
707 -- -- Put the type of the start value in nvec, this will be the type of our
708 -- -- temporary vector
709 let tmp_ty = Var.varType res
710 let error_msg = "\nGenerate.genFold': Can not construct temp vector for element type: " ++ pprString tmp_ty
711 -- TODO: Handle Nothing
712 Just tmp_vhdl_ty <- MonadState.lift tsType $ vhdl_ty error_msg tmp_ty
713 -- Setup the generate scheme
714 let gen_label = mkVHDLExtId ("iterateVector" ++ (varToString start))
715 let block_label = mkVHDLExtId ("iterateVector" ++ (varToString res))
716 let gen_range = AST.ToRange (AST.PrimLit "0") len_min_expr
717 let gen_scheme = AST.ForGn n_id gen_range
718 -- Make the intermediate vector
719 let tmp_dec = AST.BDISD $ AST.SigDec tmp_id tmp_vhdl_ty Nothing
720 -- Create the generate statement
721 cells' <- sequence [genFirstCell, genOtherCell]
722 let (cells, useds) = unzip cells'
723 let gen_sm = AST.GenerateSm gen_label gen_scheme [] (map AST.CSGSm cells)
724 -- Assign tmp[len-1] or tmp[0] to res
725 let out_assign = mkUncondAssign (Left res) $ vhdlNameToVHDLExpr tmp_name
726 let block = AST.BlockSm block_label [] (AST.PMapAspect []) [tmp_dec] [AST.CSGSm gen_sm, out_assign]
727 return ([AST.CSBSm block], concat useds)
729 -- An id for the counter
730 n_id = mkVHDLBasicId "n"
731 n_cur = idToVHDLExpr n_id
732 -- An expression for previous n
733 n_prev = n_cur AST.:-: (AST.PrimLit "1")
734 -- An id for the tmp result vector
735 tmp_id = mkVHDLBasicId "tmp"
736 tmp_name = AST.NSimple tmp_id
737 -- Generate parts of the fold
738 genFirstCell, genOtherCell :: TranslatorSession (AST.GenerateSm, [CoreSyn.CoreBndr])
740 let cond_label = mkVHDLExtId "firstcell"
741 -- if n == 0 or n == len-1
742 let cond_scheme = AST.IfGn $ n_cur AST.:=: (AST.PrimLit "0")
743 -- Output to tmp[current n]
744 let resname = mkIndexedName tmp_name n_cur
746 argexpr <- MonadState.lift tsType $ varToVHDLExpr start
747 let startassign = mkUncondAssign (Right resname) argexpr
748 (app_concsms, used) <- genApplication (Right resname) app_f [Right argexpr]
749 -- Return the conditional generate part
750 let gensm = AST.GenerateSm cond_label cond_scheme [] (if iter then
758 let cond_label = mkVHDLExtId "othercell"
759 -- if n > 0 or n < len-1
760 let cond_scheme = AST.IfGn $ n_cur AST.:/=: (AST.PrimLit "0")
761 -- Output to tmp[current n]
762 let resname = mkIndexedName tmp_name n_cur
763 -- Input from tmp[previous n]
764 let argexpr = vhdlNameToVHDLExpr $ mkIndexedName tmp_name n_prev
765 (app_concsms, used) <- genApplication (Right resname) app_f [Right argexpr]
766 -- Return the conditional generate part
767 return $ (AST.GenerateSm cond_label cond_scheme [] app_concsms, used)
770 -----------------------------------------------------------------------------
771 -- Function to generate VHDL for applications
772 -----------------------------------------------------------------------------
774 (Either CoreSyn.CoreBndr AST.VHDLName) -- ^ Where to store the result?
775 -> CoreSyn.CoreBndr -- ^ The function to apply
776 -> [Either CoreSyn.CoreExpr AST.Expr] -- ^ The arguments to apply
777 -> TranslatorSession ([AST.ConcSm], [CoreSyn.CoreBndr])
778 -- ^ The corresponding VHDL concurrent statements and entities
780 genApplication dst f args = do
781 case Var.isGlobalId f of
783 top <- isTopLevelBinder f
786 -- Local binder that references a top level binding. Generate a
787 -- component instantiation.
788 signature <- getEntity f
789 args' <- argsToVHDLExprs args
790 let entity_id = ent_id signature
791 -- TODO: Using show here isn't really pretty, but we'll need some
792 -- unique-ish value...
793 let label = "comp_ins_" ++ (either show prettyShow) dst
794 portmaps <- mkAssocElems args' ((either varToVHDLName id) dst) signature
795 return ([mkComponentInst label entity_id portmaps], [f])
797 -- Not a top level binder, so this must be a local variable reference.
798 -- It should have a representable type (and thus, no arguments) and a
799 -- signal should be generated for it. Just generate an unconditional
801 f' <- MonadState.lift tsType $ varToVHDLExpr f
802 return $ ([mkUncondAssign dst f'], [])
803 True | not stateful ->
804 case Var.idDetails f of
805 IdInfo.DataConWorkId dc -> case dst of
806 -- It's a datacon. Create a record from its arguments.
808 -- We have the bndr, so we can get at the type
809 labels <- MonadState.lift tsType $ getFieldLabels (Var.varType bndr)
810 args' <- argsToVHDLExprs args
811 return $ (zipWith mkassign labels $ args', [])
813 mkassign :: AST.VHDLId -> AST.Expr -> AST.ConcSm
815 let sel_name = mkSelectedName ((either varToVHDLName id) dst) label in
816 mkUncondAssign (Right sel_name) arg
817 Right _ -> error $ "\nGenerate.genApplication: Can't generate dataconstructor application without an original binder"
818 IdInfo.DataConWrapId dc -> case dst of
819 -- It's a datacon. Create a record from its arguments.
821 case (Map.lookup (varToString f) globalNameTable) of
822 Just (arg_count, builder) ->
823 if length args == arg_count then
826 error $ "\nGenerate.genApplication(DataConWrapId): Incorrect number of arguments to builtin function: " ++ pprString f ++ " Args: " ++ show args
827 Nothing -> error $ "\nGenerate.genApplication: Can't generate dataconwrapper: " ++ (show dc)
828 Right _ -> error $ "\nGenerate.genApplication: Can't generate dataconwrapper application without an original binder"
829 IdInfo.VanillaId -> do
830 -- It's a global value imported from elsewhere. These can be builtin
831 -- functions. Look up the function name in the name table and execute
832 -- the associated builder if there is any and the argument count matches
833 -- (this should always be the case if it typechecks, but just to be
835 case (Map.lookup (varToString f) globalNameTable) of
836 Just (arg_count, builder) ->
837 if length args == arg_count then
840 error $ "\nGenerate.genApplication(VanillaGlobal): Incorrect number of arguments to builtin function: " ++ pprString f ++ " Args: " ++ show args
841 Nothing -> error $ ("\nGenerate.genApplication(VanillaGlobal): Using function from another module that is not a known builtin: " ++ (pprString f))
842 IdInfo.ClassOpId cls -> do
843 -- FIXME: Not looking for what instance this class op is called for
844 -- Is quite stupid of course.
845 case (Map.lookup (varToString f) globalNameTable) of
846 Just (arg_count, builder) ->
847 if length args == arg_count then
850 error $ "\nGenerate.genApplication(ClassOpId): Incorrect number of arguments to builtin function: " ++ pprString f ++ " Args: " ++ show args
851 Nothing -> error $ "\nGenerate.genApplication(ClassOpId): Using function from another module that is not a known builtin: " ++ pprString f
852 details -> error $ "\nGenerate.genApplication: Calling unsupported function " ++ pprString f ++ " with GlobalIdDetails " ++ pprString details
853 -- If we can't generate a component instantiation, and the destination is
854 -- a state type, don't generate anything.
857 -- Is our destination a state value?
858 stateful = case dst of
859 -- When our destination is a VHDL name, it won't have had a state type
861 -- Otherwise check its type
862 Left bndr -> hasStateType bndr
864 -----------------------------------------------------------------------------
865 -- Functions to generate functions dealing with vectors.
866 -----------------------------------------------------------------------------
868 -- Returns the VHDLId of the vector function with the given name for the given
869 -- element type. Generates -- this function if needed.
870 vectorFunId :: Type.Type -> String -> TypeSession AST.VHDLId
871 vectorFunId el_ty fname = do
872 let error_msg = "\nGenerate.vectorFunId: Can not construct vector function for element: " ++ pprString el_ty
873 -- TODO: Handle the Nothing case?
874 Just elemTM <- vhdl_ty error_msg el_ty
875 -- TODO: This should not be duplicated from mk_vector_ty. Probably but it in
876 -- the VHDLState or something.
877 let vectorTM = mkVHDLExtId $ "vector_" ++ (AST.fromVHDLId elemTM)
878 typefuns <- getA tsTypeFuns
879 case Map.lookup (OrdType el_ty, fname) typefuns of
880 -- Function already generated, just return it
881 Just (id, _) -> return id
882 -- Function not generated yet, generate it
884 let functions = genUnconsVectorFuns elemTM vectorTM
885 case lookup fname functions of
887 modA tsTypeFuns $ Map.insert (OrdType el_ty, fname) (function_id, (fst body))
888 mapM_ (vectorFunId el_ty) (snd body)
890 Nothing -> error $ "\nGenerate.vectorFunId: I don't know how to generate vector function " ++ fname
892 function_id = mkVHDLExtId fname
894 genUnconsVectorFuns :: AST.TypeMark -- ^ type of the vector elements
895 -> AST.TypeMark -- ^ type of the vector
896 -> [(String, (AST.SubProgBody, [String]))]
897 genUnconsVectorFuns elemTM vectorTM =
898 [ (exId, (AST.SubProgBody exSpec [] [exExpr],[]))
899 , (replaceId, (AST.SubProgBody replaceSpec [AST.SPVD replaceVar] [replaceExpr,replaceRet],[]))
900 , (lastId, (AST.SubProgBody lastSpec [] [lastExpr],[]))
901 , (initId, (AST.SubProgBody initSpec [AST.SPVD initVar] [initExpr, initRet],[]))
902 , (minimumId, (AST.SubProgBody minimumSpec [] [minimumExpr],[]))
903 , (takeId, (AST.SubProgBody takeSpec [AST.SPVD takeVar] [takeExpr, takeRet],[minimumId]))
904 , (dropId, (AST.SubProgBody dropSpec [AST.SPVD dropVar] [dropExpr, dropRet],[]))
905 , (plusgtId, (AST.SubProgBody plusgtSpec [AST.SPVD plusgtVar] [plusgtExpr, plusgtRet],[]))
906 , (emptyId, (AST.SubProgBody emptySpec [AST.SPCD emptyVar] [emptyExpr],[]))
907 , (singletonId, (AST.SubProgBody singletonSpec [AST.SPVD singletonVar] [singletonRet],[]))
908 , (copynId, (AST.SubProgBody copynSpec [AST.SPVD copynVar] [copynExpr],[]))
909 , (selId, (AST.SubProgBody selSpec [AST.SPVD selVar] [selFor, selRet],[]))
910 , (ltplusId, (AST.SubProgBody ltplusSpec [AST.SPVD ltplusVar] [ltplusExpr, ltplusRet],[]))
911 , (plusplusId, (AST.SubProgBody plusplusSpec [AST.SPVD plusplusVar] [plusplusExpr, plusplusRet],[]))
912 , (lengthTId, (AST.SubProgBody lengthTSpec [] [lengthTExpr],[]))
913 , (shiftlId, (AST.SubProgBody shiftlSpec [AST.SPVD shiftlVar] [shiftlExpr, shiftlRet], [initId]))
914 , (shiftrId, (AST.SubProgBody shiftrSpec [AST.SPVD shiftrVar] [shiftrExpr, shiftrRet], [tailId]))
915 , (nullId, (AST.SubProgBody nullSpec [] [nullExpr], []))
916 , (rotlId, (AST.SubProgBody rotlSpec [AST.SPVD rotlVar] [rotlExpr, rotlRet], [nullId, lastId, initId]))
917 , (rotrId, (AST.SubProgBody rotrSpec [AST.SPVD rotrVar] [rotrExpr, rotrRet], [nullId, tailId, headId]))
918 , (reverseId, (AST.SubProgBody reverseSpec [AST.SPVD reverseVar] [reverseFor, reverseRet], []))
921 ixPar = AST.unsafeVHDLBasicId "ix"
922 vecPar = AST.unsafeVHDLBasicId "vec"
923 vec1Par = AST.unsafeVHDLBasicId "vec1"
924 vec2Par = AST.unsafeVHDLBasicId "vec2"
925 nPar = AST.unsafeVHDLBasicId "n"
926 leftPar = AST.unsafeVHDLBasicId "nLeft"
927 rightPar = AST.unsafeVHDLBasicId "nRight"
928 iId = AST.unsafeVHDLBasicId "i"
930 aPar = AST.unsafeVHDLBasicId "a"
931 fPar = AST.unsafeVHDLBasicId "f"
932 sPar = AST.unsafeVHDLBasicId "s"
933 resId = AST.unsafeVHDLBasicId "res"
934 exSpec = AST.Function (mkVHDLExtId exId) [AST.IfaceVarDec vecPar vectorTM,
935 AST.IfaceVarDec ixPar naturalTM] elemTM
936 exExpr = AST.ReturnSm (Just $ AST.PrimName $ AST.NIndexed
937 (AST.IndexedName (AST.NSimple vecPar) [AST.PrimName $
939 replaceSpec = AST.Function (mkVHDLExtId replaceId) [ AST.IfaceVarDec vecPar vectorTM
940 , AST.IfaceVarDec iPar naturalTM
941 , AST.IfaceVarDec aPar elemTM
943 -- variable res : fsvec_x (0 to vec'length-1);
946 (AST.SubtypeIn vectorTM
947 (Just $ AST.ConstraintIndex $ AST.IndexConstraint
948 [AST.ToRange (AST.PrimLit "0")
949 (AST.PrimName (AST.NAttribute $
950 AST.AttribName (AST.NSimple vecPar) (AST.NSimple $ mkVHDLBasicId lengthId) Nothing) AST.:-:
951 (AST.PrimLit "1")) ]))
953 -- res AST.:= vec(0 to i-1) & a & vec(i+1 to length'vec-1)
954 replaceExpr = AST.NSimple resId AST.:=
955 (vecSlice (AST.PrimLit "0") (AST.PrimName (AST.NSimple iPar) AST.:-: AST.PrimLit "1") AST.:&:
956 AST.PrimName (AST.NSimple aPar) AST.:&:
957 vecSlice (AST.PrimName (AST.NSimple iPar) AST.:+: AST.PrimLit "1")
958 ((AST.PrimName (AST.NAttribute $
959 AST.AttribName (AST.NSimple vecPar) (AST.NSimple $ mkVHDLBasicId lengthId) Nothing))
960 AST.:-: AST.PrimLit "1"))
961 replaceRet = AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple resId)
962 vecSlice init last = AST.PrimName (AST.NSlice
965 (AST.ToRange init last)))
966 lastSpec = AST.Function (mkVHDLExtId lastId) [AST.IfaceVarDec vecPar vectorTM] elemTM
967 -- return vec(vec'length-1);
968 lastExpr = AST.ReturnSm (Just $ (AST.PrimName $ AST.NIndexed (AST.IndexedName
970 [AST.PrimName (AST.NAttribute $
971 AST.AttribName (AST.NSimple vecPar) (AST.NSimple $ mkVHDLBasicId lengthId) Nothing)
972 AST.:-: AST.PrimLit "1"])))
973 initSpec = AST.Function (mkVHDLExtId initId) [AST.IfaceVarDec vecPar vectorTM] vectorTM
974 -- variable res : fsvec_x (0 to vec'length-2);
977 (AST.SubtypeIn vectorTM
978 (Just $ AST.ConstraintIndex $ AST.IndexConstraint
979 [AST.ToRange (AST.PrimLit "0")
980 (AST.PrimName (AST.NAttribute $
981 AST.AttribName (AST.NSimple vecPar) (AST.NSimple $ mkVHDLBasicId lengthId) Nothing) AST.:-:
982 (AST.PrimLit "2")) ]))
984 -- resAST.:= vec(0 to vec'length-2)
985 initExpr = AST.NSimple resId AST.:= (vecSlice
987 (AST.PrimName (AST.NAttribute $
988 AST.AttribName (AST.NSimple vecPar) (AST.NSimple $ mkVHDLBasicId lengthId) Nothing)
989 AST.:-: AST.PrimLit "2"))
990 initRet = AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple resId)
991 minimumSpec = AST.Function (mkVHDLExtId minimumId) [AST.IfaceVarDec leftPar naturalTM,
992 AST.IfaceVarDec rightPar naturalTM ] naturalTM
993 minimumExpr = AST.IfSm ((AST.PrimName $ AST.NSimple leftPar) AST.:<: (AST.PrimName $ AST.NSimple rightPar))
994 [AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple leftPar)]
996 (Just $ AST.Else [minimumExprRet])
997 where minimumExprRet = AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple rightPar)
998 takeSpec = AST.Function (mkVHDLExtId takeId) [AST.IfaceVarDec nPar naturalTM,
999 AST.IfaceVarDec vecPar vectorTM ] vectorTM
1000 -- variable res : fsvec_x (0 to (minimum (n,vec'length))-1);
1001 minLength = AST.PrimFCall $ AST.FCall (AST.NSimple (mkVHDLExtId minimumId))
1002 [Nothing AST.:=>: AST.ADExpr (AST.PrimName $ AST.NSimple nPar)
1003 ,Nothing AST.:=>: AST.ADExpr (AST.PrimName (AST.NAttribute $
1004 AST.AttribName (AST.NSimple vecPar) (AST.NSimple $ mkVHDLBasicId lengthId) Nothing))]
1007 (AST.SubtypeIn vectorTM
1008 (Just $ AST.ConstraintIndex $ AST.IndexConstraint
1009 [AST.ToRange (AST.PrimLit "0")
1011 (AST.PrimLit "1")) ]))
1013 -- res AST.:= vec(0 to n-1)
1014 takeExpr = AST.NSimple resId AST.:=
1015 (vecSlice (AST.PrimLit "0")
1016 (minLength AST.:-: AST.PrimLit "1"))
1017 takeRet = AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple resId)
1018 dropSpec = AST.Function (mkVHDLExtId dropId) [AST.IfaceVarDec nPar naturalTM,
1019 AST.IfaceVarDec vecPar vectorTM ] vectorTM
1020 -- variable res : fsvec_x (0 to vec'length-n-1);
1023 (AST.SubtypeIn vectorTM
1024 (Just $ AST.ConstraintIndex $ AST.IndexConstraint
1025 [AST.ToRange (AST.PrimLit "0")
1026 (AST.PrimName (AST.NAttribute $
1027 AST.AttribName (AST.NSimple vecPar) (AST.NSimple $ mkVHDLBasicId lengthId) Nothing) AST.:-:
1028 (AST.PrimName $ AST.NSimple nPar)AST.:-: (AST.PrimLit "1")) ]))
1030 -- res AST.:= vec(n to vec'length-1)
1031 dropExpr = AST.NSimple resId AST.:= (vecSlice
1032 (AST.PrimName $ AST.NSimple nPar)
1033 (AST.PrimName (AST.NAttribute $
1034 AST.AttribName (AST.NSimple vecPar) (AST.NSimple $ mkVHDLBasicId lengthId) Nothing)
1035 AST.:-: AST.PrimLit "1"))
1036 dropRet = AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple resId)
1037 plusgtSpec = AST.Function (mkVHDLExtId plusgtId) [AST.IfaceVarDec aPar elemTM,
1038 AST.IfaceVarDec vecPar vectorTM] vectorTM
1039 -- variable res : fsvec_x (0 to vec'length);
1042 (AST.SubtypeIn vectorTM
1043 (Just $ AST.ConstraintIndex $ AST.IndexConstraint
1044 [AST.ToRange (AST.PrimLit "0")
1045 (AST.PrimName (AST.NAttribute $
1046 AST.AttribName (AST.NSimple vecPar) (AST.NSimple $ mkVHDLBasicId lengthId) Nothing))]))
1048 plusgtExpr = AST.NSimple resId AST.:=
1049 ((AST.PrimName $ AST.NSimple aPar) AST.:&:
1050 (AST.PrimName $ AST.NSimple vecPar))
1051 plusgtRet = AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple resId)
1052 emptySpec = AST.Function (mkVHDLExtId emptyId) [] vectorTM
1055 (AST.SubtypeIn vectorTM Nothing)
1056 (Just $ AST.PrimLit "\"\"")
1057 emptyExpr = AST.ReturnSm (Just $ AST.PrimName (AST.NSimple resId))
1058 singletonSpec = AST.Function (mkVHDLExtId singletonId) [AST.IfaceVarDec aPar elemTM ]
1060 -- variable res : fsvec_x (0 to 0) := (others => a);
1063 (AST.SubtypeIn vectorTM
1064 (Just $ AST.ConstraintIndex $ AST.IndexConstraint
1065 [AST.ToRange (AST.PrimLit "0") (AST.PrimLit "0")]))
1066 (Just $ AST.Aggregate [AST.ElemAssoc (Just AST.Others)
1067 (AST.PrimName $ AST.NSimple aPar)])
1068 singletonRet = AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple resId)
1069 copynSpec = AST.Function (mkVHDLExtId copynId) [AST.IfaceVarDec nPar naturalTM,
1070 AST.IfaceVarDec aPar elemTM ] vectorTM
1071 -- variable res : fsvec_x (0 to n-1) := (others => a);
1074 (AST.SubtypeIn vectorTM
1075 (Just $ AST.ConstraintIndex $ AST.IndexConstraint
1076 [AST.ToRange (AST.PrimLit "0")
1077 ((AST.PrimName (AST.NSimple nPar)) AST.:-:
1078 (AST.PrimLit "1")) ]))
1079 (Just $ AST.Aggregate [AST.ElemAssoc (Just AST.Others)
1080 (AST.PrimName $ AST.NSimple aPar)])
1082 copynExpr = AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple resId)
1083 selSpec = AST.Function (mkVHDLExtId selId) [AST.IfaceVarDec fPar naturalTM,
1084 AST.IfaceVarDec sPar naturalTM,
1085 AST.IfaceVarDec nPar naturalTM,
1086 AST.IfaceVarDec vecPar vectorTM ] vectorTM
1087 -- variable res : fsvec_x (0 to n-1);
1090 (AST.SubtypeIn vectorTM
1091 (Just $ AST.ConstraintIndex $ AST.IndexConstraint
1092 [AST.ToRange (AST.PrimLit "0")
1093 ((AST.PrimName (AST.NSimple nPar)) AST.:-:
1094 (AST.PrimLit "1")) ])
1097 -- for i res'range loop
1098 -- res(i) := vec(f+i*s);
1100 selFor = AST.ForSM iId (AST.AttribRange $ AST.AttribName (AST.NSimple resId) (AST.NSimple $ rangeId) Nothing) [selAssign]
1101 -- res(i) := vec(f+i*s);
1102 selAssign = let origExp = AST.PrimName (AST.NSimple fPar) AST.:+:
1103 (AST.PrimName (AST.NSimple iId) AST.:*:
1104 AST.PrimName (AST.NSimple sPar)) in
1105 AST.NIndexed (AST.IndexedName (AST.NSimple resId) [AST.PrimName (AST.NSimple iId)]) AST.:=
1106 (AST.PrimName $ AST.NIndexed (AST.IndexedName (AST.NSimple vecPar) [origExp]))
1108 selRet = AST.ReturnSm (Just $ AST.PrimName (AST.NSimple resId))
1109 ltplusSpec = AST.Function (mkVHDLExtId ltplusId) [AST.IfaceVarDec vecPar vectorTM,
1110 AST.IfaceVarDec aPar elemTM] vectorTM
1111 -- variable res : fsvec_x (0 to vec'length);
1114 (AST.SubtypeIn vectorTM
1115 (Just $ AST.ConstraintIndex $ AST.IndexConstraint
1116 [AST.ToRange (AST.PrimLit "0")
1117 (AST.PrimName (AST.NAttribute $
1118 AST.AttribName (AST.NSimple vecPar) (AST.NSimple $ mkVHDLBasicId lengthId) Nothing))]))
1120 ltplusExpr = AST.NSimple resId AST.:=
1121 ((AST.PrimName $ AST.NSimple vecPar) AST.:&:
1122 (AST.PrimName $ AST.NSimple aPar))
1123 ltplusRet = AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple resId)
1124 plusplusSpec = AST.Function (mkVHDLExtId plusplusId) [AST.IfaceVarDec vec1Par vectorTM,
1125 AST.IfaceVarDec vec2Par vectorTM]
1127 -- variable res : fsvec_x (0 to vec1'length + vec2'length -1);
1130 (AST.SubtypeIn vectorTM
1131 (Just $ AST.ConstraintIndex $ AST.IndexConstraint
1132 [AST.ToRange (AST.PrimLit "0")
1133 (AST.PrimName (AST.NAttribute $
1134 AST.AttribName (AST.NSimple vec1Par) (AST.NSimple $ mkVHDLBasicId lengthId) Nothing) AST.:+:
1135 AST.PrimName (AST.NAttribute $
1136 AST.AttribName (AST.NSimple vec2Par) (AST.NSimple $ mkVHDLBasicId lengthId) Nothing) AST.:-:
1139 plusplusExpr = AST.NSimple resId AST.:=
1140 ((AST.PrimName $ AST.NSimple vec1Par) AST.:&:
1141 (AST.PrimName $ AST.NSimple vec2Par))
1142 plusplusRet = AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple resId)
1143 lengthTSpec = AST.Function (mkVHDLExtId lengthTId) [AST.IfaceVarDec vecPar vectorTM] naturalTM
1144 lengthTExpr = AST.ReturnSm (Just $ AST.PrimName (AST.NAttribute $
1145 AST.AttribName (AST.NSimple vecPar) (AST.NSimple $ mkVHDLBasicId lengthId) Nothing))
1146 shiftlSpec = AST.Function (mkVHDLExtId shiftlId) [AST.IfaceVarDec vecPar vectorTM,
1147 AST.IfaceVarDec aPar elemTM ] vectorTM
1148 -- variable res : fsvec_x (0 to vec'length-1);
1151 (AST.SubtypeIn vectorTM
1152 (Just $ AST.ConstraintIndex $ AST.IndexConstraint
1153 [AST.ToRange (AST.PrimLit "0")
1154 (AST.PrimName (AST.NAttribute $
1155 AST.AttribName (AST.NSimple vecPar) (AST.NSimple $ mkVHDLBasicId lengthId) Nothing) AST.:-:
1156 (AST.PrimLit "1")) ]))
1158 -- res := a & init(vec)
1159 shiftlExpr = AST.NSimple resId AST.:=
1160 (AST.PrimName (AST.NSimple aPar) AST.:&:
1161 (AST.PrimFCall $ AST.FCall (AST.NSimple (mkVHDLExtId initId))
1162 [Nothing AST.:=>: AST.ADExpr (AST.PrimName $ AST.NSimple vecPar)]))
1163 shiftlRet = AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple resId)
1164 shiftrSpec = AST.Function (mkVHDLExtId shiftrId) [AST.IfaceVarDec vecPar vectorTM,
1165 AST.IfaceVarDec aPar elemTM ] vectorTM
1166 -- variable res : fsvec_x (0 to vec'length-1);
1169 (AST.SubtypeIn vectorTM
1170 (Just $ AST.ConstraintIndex $ AST.IndexConstraint
1171 [AST.ToRange (AST.PrimLit "0")
1172 (AST.PrimName (AST.NAttribute $
1173 AST.AttribName (AST.NSimple vecPar) (AST.NSimple $ mkVHDLBasicId lengthId) Nothing) AST.:-:
1174 (AST.PrimLit "1")) ]))
1176 -- res := tail(vec) & a
1177 shiftrExpr = AST.NSimple resId AST.:=
1178 ((AST.PrimFCall $ AST.FCall (AST.NSimple (mkVHDLExtId tailId))
1179 [Nothing AST.:=>: AST.ADExpr (AST.PrimName $ AST.NSimple vecPar)]) AST.:&:
1180 (AST.PrimName (AST.NSimple aPar)))
1182 shiftrRet = AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple resId)
1183 nullSpec = AST.Function (mkVHDLExtId nullId) [AST.IfaceVarDec vecPar vectorTM] booleanTM
1184 -- return vec'length = 0
1185 nullExpr = AST.ReturnSm (Just $
1186 AST.PrimName (AST.NAttribute $
1187 AST.AttribName (AST.NSimple vecPar) (AST.NSimple $ mkVHDLBasicId lengthId) Nothing) AST.:=:
1189 rotlSpec = AST.Function (mkVHDLExtId rotlId) [AST.IfaceVarDec vecPar vectorTM] vectorTM
1190 -- variable res : fsvec_x (0 to vec'length-1);
1193 (AST.SubtypeIn vectorTM
1194 (Just $ AST.ConstraintIndex $ AST.IndexConstraint
1195 [AST.ToRange (AST.PrimLit "0")
1196 (AST.PrimName (AST.NAttribute $
1197 AST.AttribName (AST.NSimple vecPar) (AST.NSimple $ mkVHDLBasicId lengthId) Nothing) AST.:-:
1198 (AST.PrimLit "1")) ]))
1200 -- if null(vec) then res := vec else res := last(vec) & init(vec)
1201 rotlExpr = AST.IfSm (AST.PrimFCall $ AST.FCall (AST.NSimple (mkVHDLExtId nullId))
1202 [Nothing AST.:=>: AST.ADExpr (AST.PrimName $ AST.NSimple vecPar)])
1203 [AST.NSimple resId AST.:= (AST.PrimName $ AST.NSimple vecPar)]
1205 (Just $ AST.Else [rotlExprRet])
1207 AST.NSimple resId AST.:=
1208 ((AST.PrimFCall $ AST.FCall (AST.NSimple (mkVHDLExtId lastId))
1209 [Nothing AST.:=>: AST.ADExpr (AST.PrimName $ AST.NSimple vecPar)]) AST.:&:
1210 (AST.PrimFCall $ AST.FCall (AST.NSimple (mkVHDLExtId initId))
1211 [Nothing AST.:=>: AST.ADExpr (AST.PrimName $ AST.NSimple vecPar)]))
1212 rotlRet = AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple resId)
1213 rotrSpec = AST.Function (mkVHDLExtId rotrId) [AST.IfaceVarDec vecPar vectorTM] vectorTM
1214 -- variable res : fsvec_x (0 to vec'length-1);
1217 (AST.SubtypeIn vectorTM
1218 (Just $ AST.ConstraintIndex $ AST.IndexConstraint
1219 [AST.ToRange (AST.PrimLit "0")
1220 (AST.PrimName (AST.NAttribute $
1221 AST.AttribName (AST.NSimple vecPar) (AST.NSimple $ mkVHDLBasicId lengthId) Nothing) AST.:-:
1222 (AST.PrimLit "1")) ]))
1224 -- if null(vec) then res := vec else res := tail(vec) & head(vec)
1225 rotrExpr = AST.IfSm (AST.PrimFCall $ AST.FCall (AST.NSimple (mkVHDLExtId nullId))
1226 [Nothing AST.:=>: AST.ADExpr (AST.PrimName $ AST.NSimple vecPar)])
1227 [AST.NSimple resId AST.:= (AST.PrimName $ AST.NSimple vecPar)]
1229 (Just $ AST.Else [rotrExprRet])
1231 AST.NSimple resId AST.:=
1232 ((AST.PrimFCall $ AST.FCall (AST.NSimple (mkVHDLExtId tailId))
1233 [Nothing AST.:=>: AST.ADExpr (AST.PrimName $ AST.NSimple vecPar)]) AST.:&:
1234 (AST.PrimFCall $ AST.FCall (AST.NSimple (mkVHDLExtId headId))
1235 [Nothing AST.:=>: AST.ADExpr (AST.PrimName $ AST.NSimple vecPar)]))
1236 rotrRet = AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple resId)
1237 reverseSpec = AST.Function (mkVHDLExtId reverseId) [AST.IfaceVarDec vecPar vectorTM] vectorTM
1240 (AST.SubtypeIn vectorTM
1241 (Just $ AST.ConstraintIndex $ AST.IndexConstraint
1242 [AST.ToRange (AST.PrimLit "0")
1243 (AST.PrimName (AST.NAttribute $
1244 AST.AttribName (AST.NSimple vecPar) (AST.NSimple $ mkVHDLBasicId lengthId) Nothing) AST.:-:
1245 (AST.PrimLit "1")) ]))
1247 -- for i in 0 to res'range loop
1248 -- res(vec'length-i-1) := vec(i);
1251 AST.ForSM iId (AST.AttribRange $ AST.AttribName (AST.NSimple resId) (AST.NSimple $ rangeId) Nothing) [reverseAssign]
1252 -- res(vec'length-i-1) := vec(i);
1253 reverseAssign = AST.NIndexed (AST.IndexedName (AST.NSimple resId) [destExp]) AST.:=
1254 (AST.PrimName $ AST.NIndexed (AST.IndexedName (AST.NSimple vecPar)
1255 [AST.PrimName $ AST.NSimple iId]))
1256 where destExp = AST.PrimName (AST.NAttribute $ AST.AttribName (AST.NSimple vecPar)
1257 (AST.NSimple $ mkVHDLBasicId lengthId) Nothing) AST.:-:
1258 AST.PrimName (AST.NSimple iId) AST.:-:
1261 reverseRet = AST.ReturnSm (Just $ AST.PrimName (AST.NSimple resId))
1264 -----------------------------------------------------------------------------
1265 -- A table of builtin functions
1266 -----------------------------------------------------------------------------
1268 -- A function that generates VHDL for a builtin function
1269 type BuiltinBuilder =
1270 (Either CoreSyn.CoreBndr AST.VHDLName) -- ^ The destination signal and it's original type
1271 -> CoreSyn.CoreBndr -- ^ The function called
1272 -> [Either CoreSyn.CoreExpr AST.Expr] -- ^ The value arguments passed (excluding type and
1273 -- dictionary arguments).
1274 -> TranslatorSession ([AST.ConcSm], [CoreSyn.CoreBndr])
1275 -- ^ The corresponding VHDL concurrent statements and entities
1278 -- A map of a builtin function to VHDL function builder
1279 type NameTable = Map.Map String (Int, BuiltinBuilder )
1281 -- | The builtin functions we support. Maps a name to an argument count and a
1282 -- builder function.
1283 globalNameTable :: NameTable
1284 globalNameTable = Map.fromList
1285 [ (exId , (2, genFCall True ) )
1286 , (replaceId , (3, genFCall False ) )
1287 , (headId , (1, genFCall True ) )
1288 , (lastId , (1, genFCall True ) )
1289 , (tailId , (1, genFCall False ) )
1290 , (initId , (1, genFCall False ) )
1291 , (takeId , (2, genFCall False ) )
1292 , (dropId , (2, genFCall False ) )
1293 , (selId , (4, genFCall False ) )
1294 , (plusgtId , (2, genFCall False ) )
1295 , (ltplusId , (2, genFCall False ) )
1296 , (plusplusId , (2, genFCall False ) )
1297 , (mapId , (2, genMap ) )
1298 , (zipWithId , (3, genZipWith ) )
1299 , (foldlId , (3, genFoldl ) )
1300 , (foldrId , (3, genFoldr ) )
1301 , (zipId , (2, genZip ) )
1302 , (unzipId , (1, genUnzip ) )
1303 , (shiftlId , (2, genFCall False ) )
1304 , (shiftrId , (2, genFCall False ) )
1305 , (rotlId , (1, genFCall False ) )
1306 , (rotrId , (1, genFCall False ) )
1307 , (concatId , (1, genConcat ) )
1308 , (reverseId , (1, genFCall False ) )
1309 , (iteratenId , (3, genIteraten ) )
1310 , (iterateId , (2, genIterate ) )
1311 , (generatenId , (3, genGeneraten ) )
1312 , (generateId , (2, genGenerate ) )
1313 , (emptyId , (0, genFCall False ) )
1314 , (singletonId , (1, genFCall False ) )
1315 , (copynId , (2, genFCall False ) )
1316 , (copyId , (1, genCopy ) )
1317 , (lengthTId , (1, genFCall False ) )
1318 , (nullId , (1, genFCall False ) )
1319 , (hwxorId , (2, genOperator2 AST.Xor ) )
1320 , (hwandId , (2, genOperator2 AST.And ) )
1321 , (hworId , (2, genOperator2 AST.Or ) )
1322 , (hwnotId , (1, genOperator1 AST.Not ) )
1323 , (plusId , (2, genOperator2 (AST.:+:) ) )
1324 , (timesId , (2, genOperator2 (AST.:*:) ) )
1325 , (negateId , (1, genNegation ) )
1326 , (minusId , (2, genOperator2 (AST.:-:) ) )
1327 , (fromSizedWordId , (1, genFromSizedWord ) )
1328 , (fromIntegerId , (1, genFromInteger ) )
1329 , (resizeId , (1, genResize ) )
1330 , (sizedIntId , (1, genSizedInt ) )
1331 --, (tfvecId , (1, genTFVec ) )
1332 , (minimumId , (2, error $ "\nFunction name: \"minimum\" is used internally, use another name"))