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])) =
165 (CoreSyn.DataAlt dc, bndrs, (CoreSyn.Var sel_bndr)) -> do
166 case List.elemIndex sel_bndr bndrs of
168 labels <- MonadState.lift tsType $ getFieldLabels (Id.idType scrut)
169 let label = labels!!i
170 let sel_name = mkSelectedName (varToVHDLName scrut) label
171 let sel_expr = AST.PrimName sel_name
172 return ([mkUncondAssign (Left bndr) sel_expr], [])
173 Nothing -> error $ "\nVHDL.mkConcSM: Not in normal form: Not a selector case:\n" ++ (pprString expr)
175 _ -> error $ "\nVHDL.mkConcSM: Not in normal form: Not a selector case:\n" ++ (pprString expr)
177 -- Multiple case alt are be conditional assignments and have only wild
178 -- binders in the alts and only variables in the case values and a variable
179 -- for a scrutinee. We check the constructor of the second alt, since the
180 -- first is the default case, if there is any.
181 mkConcSm (bndr, (CoreSyn.Case (CoreSyn.Var scrut) b ty [(_, _, CoreSyn.Var false), (con, _, CoreSyn.Var true)])) = do
182 scrut' <- MonadState.lift tsType $ varToVHDLExpr scrut
183 let cond_expr = scrut' AST.:=: (altconToVHDLExpr con)
184 true_expr <- MonadState.lift tsType $ varToVHDLExpr true
185 false_expr <- MonadState.lift tsType $ varToVHDLExpr false
186 return ([mkCondAssign (Left bndr) cond_expr true_expr false_expr], [])
188 mkConcSm (_, (CoreSyn.Case (CoreSyn.Var _) _ _ alts)) = error "\nVHDL.mkConcSm: Not in normal form: Case statement with more than two alternatives"
189 mkConcSm (_, CoreSyn.Case _ _ _ _) = error "\nVHDL.mkConcSm: Not in normal form: Case statement has does not have a simple variable as scrutinee"
190 mkConcSm (bndr, expr) = error $ "\nVHDL.mkConcSM: Unsupported binding in let expression: " ++ pprString bndr ++ " = " ++ pprString expr
192 -----------------------------------------------------------------------------
193 -- Functions to generate VHDL for builtin functions
194 -----------------------------------------------------------------------------
196 -- | A function to wrap a builder-like function that expects its arguments to
198 genExprArgs wrap dst func args = do
199 args' <- eitherCoreOrExprArgs args
202 eitherCoreOrExprArgs :: [Either CoreSyn.CoreExpr AST.Expr] -> TranslatorSession [AST.Expr]
203 eitherCoreOrExprArgs args = mapM (Either.either ((MonadState.lift tsType) . varToVHDLExpr . exprToVar) return) args
205 -- A function to wrap a builder-like function that generates no component
208 (dst -> func -> args -> TranslatorSession [AST.ConcSm])
209 -> (dst -> func -> args -> TranslatorSession ([AST.ConcSm], [CoreSyn.CoreBndr]))
210 genNoInsts wrap dst func args = do
211 concsms <- wrap dst func args
214 -- | A function to wrap a builder-like function that expects its arguments to
217 (dst -> func -> [Var.Var] -> res)
218 -> (dst -> func -> [Either CoreSyn.CoreExpr AST.Expr] -> res)
219 genVarArgs wrap dst func args = wrap dst func args'
221 args' = map exprToVar exprargs
222 -- Check (rather crudely) that all arguments are CoreExprs
223 (exprargs, []) = Either.partitionEithers args
225 -- | A function to wrap a builder-like function that expects its arguments to
228 (dst -> func -> [Literal.Literal] -> res)
229 -> (dst -> func -> [Either CoreSyn.CoreExpr AST.Expr] -> res)
230 genLitArgs wrap dst func args = wrap dst func args'
232 args' = map exprToLit litargs
233 -- FIXME: Check if we were passed an CoreSyn.App
234 litargs = concat (map getLiterals exprargs)
235 (exprargs, []) = Either.partitionEithers args
237 -- | A function to wrap a builder-like function that produces an expression
238 -- and expects it to be assigned to the destination.
240 ((Either CoreSyn.CoreBndr AST.VHDLName) -> func -> [arg] -> TranslatorSession AST.Expr)
241 -> ((Either CoreSyn.CoreBndr AST.VHDLName) -> func -> [arg] -> TranslatorSession [AST.ConcSm])
242 genExprRes wrap dst func args = do
243 expr <- wrap dst func args
244 return $ [mkUncondAssign dst expr]
246 -- | Generate a binary operator application. The first argument should be a
247 -- constructor from the AST.Expr type, e.g. AST.And.
248 genOperator2 :: (AST.Expr -> AST.Expr -> AST.Expr) -> BuiltinBuilder
249 genOperator2 op = genNoInsts $ genExprArgs $ genExprRes (genOperator2' op)
250 genOperator2' :: (AST.Expr -> AST.Expr -> AST.Expr) -> dst -> CoreSyn.CoreBndr -> [AST.Expr] -> TranslatorSession AST.Expr
251 genOperator2' op _ f [arg1, arg2] = return $ op arg1 arg2
253 -- | Generate a unary operator application
254 genOperator1 :: (AST.Expr -> AST.Expr) -> BuiltinBuilder
255 genOperator1 op = genNoInsts $ genExprArgs $ genExprRes (genOperator1' op)
256 genOperator1' :: (AST.Expr -> AST.Expr) -> dst -> CoreSyn.CoreBndr -> [AST.Expr] -> TranslatorSession AST.Expr
257 genOperator1' op _ f [arg] = return $ op arg
259 -- | Generate a unary operator application
260 genNegation :: BuiltinBuilder
261 genNegation = genNoInsts $ genVarArgs $ genExprRes genNegation'
262 genNegation' :: dst -> CoreSyn.CoreBndr -> [Var.Var] -> TranslatorSession AST.Expr
263 genNegation' _ f [arg] = do
264 arg1 <- MonadState.lift tsType $ varToVHDLExpr arg
265 let ty = Var.varType arg
266 let (tycon, args) = Type.splitTyConApp ty
267 let name = Name.getOccString (TyCon.tyConName tycon)
269 "SizedInt" -> return $ AST.Neg arg1
270 otherwise -> error $ "\nGenerate.genNegation': Negation allowed for type: " ++ show name
272 -- | Generate a function call from the destination binder, function name and a
273 -- list of expressions (its arguments)
274 genFCall :: Bool -> BuiltinBuilder
275 genFCall switch = genNoInsts $ genExprArgs $ genExprRes (genFCall' switch)
276 genFCall' :: Bool -> Either CoreSyn.CoreBndr AST.VHDLName -> CoreSyn.CoreBndr -> [AST.Expr] -> TranslatorSession AST.Expr
277 genFCall' switch (Left res) f args = do
278 let fname = varToString f
279 let el_ty = if switch then (Var.varType res) else ((tfvec_elem . Var.varType) res)
280 id <- MonadState.lift tsType $ vectorFunId el_ty fname
281 return $ AST.PrimFCall $ AST.FCall (AST.NSimple id) $
282 map (\exp -> Nothing AST.:=>: AST.ADExpr exp) args
283 genFCall' _ (Right name) _ _ = error $ "\nGenerate.genFCall': Cannot generate builtin function call assigned to a VHDLName: " ++ show name
285 genFromSizedWord :: BuiltinBuilder
286 genFromSizedWord = genNoInsts $ genExprArgs $ genExprRes genFromSizedWord'
287 genFromSizedWord' :: Either CoreSyn.CoreBndr AST.VHDLName -> CoreSyn.CoreBndr -> [AST.Expr] -> TranslatorSession AST.Expr
288 genFromSizedWord' (Left res) f args = do
289 let fname = varToString f
290 return $ AST.PrimFCall $ AST.FCall (AST.NSimple (mkVHDLBasicId toIntegerId)) $
291 map (\exp -> Nothing AST.:=>: AST.ADExpr exp) args
292 genFromSizedWord' (Right name) _ _ = error $ "\nGenerate.genFromSizedWord': Cannot generate builtin function call assigned to a VHDLName: " ++ show name
294 genResize :: BuiltinBuilder
295 genResize = genNoInsts $ genExprArgs $ genExprRes genResize'
296 genResize' :: Either CoreSyn.CoreBndr AST.VHDLName -> CoreSyn.CoreBndr -> [AST.Expr] -> TranslatorSession AST.Expr
297 genResize' (Left res) f [arg] = do {
298 ; let { ty = Var.varType res
299 ; (tycon, args) = Type.splitTyConApp ty
300 ; name = Name.getOccString (TyCon.tyConName tycon)
302 ; len <- case name of
303 "SizedInt" -> MonadState.lift tsType $ tfp_to_int (sized_int_len_ty ty)
304 "SizedWord" -> MonadState.lift tsType $ tfp_to_int (sized_word_len_ty ty)
305 ; return $ AST.PrimFCall $ AST.FCall (AST.NSimple (mkVHDLBasicId resizeId))
306 [Nothing AST.:=>: AST.ADExpr arg, Nothing AST.:=>: AST.ADExpr( AST.PrimLit (show len))]
308 genResize' (Right name) _ _ = error $ "\nGenerate.genFromSizedWord': Cannot generate builtin function call assigned to a VHDLName: " ++ show name
310 -- FIXME: I'm calling genLitArgs which is very specific function,
311 -- which needs to be fixed as well
312 genFromInteger :: BuiltinBuilder
313 genFromInteger = genNoInsts $ genLitArgs $ genExprRes genFromInteger'
314 genFromInteger' :: Either CoreSyn.CoreBndr AST.VHDLName -> CoreSyn.CoreBndr -> [Literal.Literal] -> TranslatorSession AST.Expr
315 genFromInteger' (Left res) f lits = do {
316 ; let { ty = Var.varType res
317 ; (tycon, args) = Type.splitTyConApp ty
318 ; name = Name.getOccString (TyCon.tyConName tycon)
321 "RangedWord" -> return $ AST.PrimLit (show (last lits))
323 ; len <- case name of
324 "SizedInt" -> MonadState.lift tsType $ tfp_to_int (sized_int_len_ty ty)
325 "SizedWord" -> MonadState.lift tsType $ tfp_to_int (sized_word_len_ty ty)
326 "RangedWord" -> MonadState.lift tsType $ tfp_to_int (ranged_word_bound_ty ty)
327 ; let fname = case name of "SizedInt" -> toSignedId ; "SizedWord" -> toUnsignedId
328 ; return $ AST.PrimFCall $ AST.FCall (AST.NSimple (mkVHDLBasicId fname))
329 [Nothing AST.:=>: AST.ADExpr (AST.PrimLit (show (last lits))), Nothing AST.:=>: AST.ADExpr( AST.PrimLit (show len))]
333 genFromInteger' (Right name) _ _ = error $ "\nGenerate.genFromInteger': Cannot generate builtin function call assigned to a VHDLName: " ++ show name
335 genSizedInt :: BuiltinBuilder
336 genSizedInt = genFromInteger
339 -- | Generate a Builder for the builtin datacon TFVec
340 genTFVec :: BuiltinBuilder
341 genTFVec (Left res) f [Left (CoreSyn.Let (CoreSyn.Rec letBinders) letRes)] = do {
342 -- Generate Assignments for all the binders
343 ; letAssigns <- mapM genBinderAssign letBinders
344 -- Generate assignments for the result (which might be another let binding)
345 ; (resBinders,resAssignments) <- genResAssign letRes
346 -- Get all the Assigned binders
347 ; let assignedBinders = Maybe.catMaybes (map fst letAssigns)
348 -- Make signal names for all the assigned binders
349 ; sigs <- mapM (\x -> MonadState.lift tsType $ varToVHDLExpr x) (assignedBinders ++ resBinders)
350 -- Assign all the signals to the resulting vector
351 ; let { vecsigns = mkAggregateSignal sigs
352 ; vecassign = mkUncondAssign (Left res) vecsigns
354 -- Generate all the signal declaration for the assigned binders
355 ; sig_dec_maybes <- mapM mkSigDec (assignedBinders ++ resBinders)
356 ; let { sig_decs = map (AST.BDISD) (Maybe.catMaybes $ sig_dec_maybes)
357 -- Setup the VHDL Block
358 ; block_label = mkVHDLExtId ("TFVec_" ++ show (varToString res))
359 ; block = AST.BlockSm block_label [] (AST.PMapAspect []) sig_decs ((concat (map snd letAssigns)) ++ resAssignments ++ [vecassign])
361 -- Return the block statement coressponding to the TFVec literal
362 ; return $ [AST.CSBSm block]
365 genBinderAssign :: (CoreSyn.CoreBndr, CoreSyn.CoreExpr) -> TranslatorSession (Maybe CoreSyn.CoreBndr, [AST.ConcSm])
366 -- For now we only translate applications
367 genBinderAssign (bndr, app@(CoreSyn.App _ _)) = do
368 let (CoreSyn.Var f, args) = CoreSyn.collectArgs app
369 let valargs = get_val_args (Var.varType f) args
370 apps <- genApplication (Left bndr) f (map Left valargs)
371 return (Just bndr, apps)
372 genBinderAssign _ = return (Nothing,[])
373 genResAssign :: CoreSyn.CoreExpr -> TranslatorSession ([CoreSyn.CoreBndr], [AST.ConcSm])
374 genResAssign app@(CoreSyn.App _ letexpr) = do
376 (CoreSyn.Let (CoreSyn.Rec letbndrs) letres) -> do
377 letapps <- mapM genBinderAssign letbndrs
378 let bndrs = Maybe.catMaybes (map fst letapps)
379 let app = (map snd letapps)
380 (vars, apps) <- genResAssign letres
381 return ((bndrs ++ vars),((concat app) ++ apps))
382 otherwise -> return ([],[])
383 genResAssign _ = return ([],[])
385 genTFVec (Left res) f [Left app@(CoreSyn.App _ _)] = do {
386 ; let { elems = reduceCoreListToHsList app
387 -- Make signal names for all the binders
388 ; binders = map (\expr -> case expr of
390 otherwise -> error $ "\nGenerate.genTFVec: Cannot generate TFVec: "
391 ++ show res ++ ", with elems:\n" ++ show elems ++ "\n" ++ pprString elems) elems
393 ; sigs <- mapM (\x -> MonadState.lift tsType $ varToVHDLExpr x) binders
394 -- Assign all the signals to the resulting vector
395 ; let { vecsigns = mkAggregateSignal sigs
396 ; vecassign = mkUncondAssign (Left res) vecsigns
397 -- Setup the VHDL Block
398 ; block_label = mkVHDLExtId ("TFVec_" ++ show (varToString res))
399 ; block = AST.BlockSm block_label [] (AST.PMapAspect []) [] [vecassign]
401 -- Return the block statement coressponding to the TFVec literal
402 ; return $ [AST.CSBSm block]
405 genTFVec (Left name) _ [Left xs] = error $ "\nGenerate.genTFVec: Cannot generate TFVec: " ++ show name ++ ", with elems:\n" ++ show xs ++ "\n" ++ pprString xs
407 genTFVec (Right name) _ _ = error $ "\nGenerate.genTFVec: Cannot generate TFVec assigned to VHDLName: " ++ show name
409 -- | Generate a generate statement for the builtin function "map"
410 genMap :: BuiltinBuilder
411 genMap (Left res) f [Left mapped_f, Left (CoreSyn.Var arg)] = do {
412 -- mapped_f must be a CoreExpr (since we can't represent functions as VHDL
413 -- expressions). arg must be a CoreExpr (and should be a CoreSyn.Var), since
414 -- we must index it (which we couldn't if it was a VHDL Expr, since only
415 -- VHDLNames can be indexed).
416 -- Setup the generate scheme
417 ; len <- MonadState.lift tsType $ tfp_to_int $ (tfvec_len_ty . Var.varType) res
418 -- TODO: Use something better than varToString
419 ; let { label = mkVHDLExtId ("mapVector" ++ (varToString res))
420 ; n_id = mkVHDLBasicId "n"
421 ; n_expr = idToVHDLExpr n_id
422 ; range = AST.ToRange (AST.PrimLit "0") (AST.PrimLit $ show (len-1))
423 ; genScheme = AST.ForGn n_id range
424 -- Create the content of the generate statement: Applying the mapped_f to
425 -- each of the elements in arg, storing to each element in res
426 ; resname = mkIndexedName (varToVHDLName res) n_expr
427 ; argexpr = vhdlNameToVHDLExpr $ mkIndexedName (varToVHDLName arg) n_expr
428 ; (CoreSyn.Var real_f, already_mapped_args) = CoreSyn.collectArgs mapped_f
429 ; valargs = get_val_args (Var.varType real_f) already_mapped_args
431 ; (app_concsms, used) <- genApplication (Right resname) real_f (map Left valargs ++ [Right argexpr])
432 -- Return the generate statement
433 ; return ([AST.CSGSm $ AST.GenerateSm label genScheme [] app_concsms], used)
436 genMap' (Right name) _ _ = error $ "\nGenerate.genMap': Cannot generate map function call assigned to a VHDLName: " ++ show name
438 genZipWith :: BuiltinBuilder
439 genZipWith = genVarArgs genZipWith'
440 genZipWith' :: (Either CoreSyn.CoreBndr AST.VHDLName) -> CoreSyn.CoreBndr -> [Var.Var] -> TranslatorSession ([AST.ConcSm], [CoreSyn.CoreBndr])
441 genZipWith' (Left res) f args@[zipped_f, arg1, arg2] = do {
442 -- Setup the generate scheme
443 ; len <- MonadState.lift tsType $ tfp_to_int $ (tfvec_len_ty . Var.varType) res
444 -- TODO: Use something better than varToString
445 ; let { label = mkVHDLExtId ("zipWithVector" ++ (varToString res))
446 ; n_id = mkVHDLBasicId "n"
447 ; n_expr = idToVHDLExpr n_id
448 ; range = AST.ToRange (AST.PrimLit "0") (AST.PrimLit $ show (len-1))
449 ; genScheme = AST.ForGn n_id range
450 -- Create the content of the generate statement: Applying the zipped_f to
451 -- each of the elements in arg1 and arg2, storing to each element in res
452 ; resname = mkIndexedName (varToVHDLName res) n_expr
453 ; argexpr1 = vhdlNameToVHDLExpr $ mkIndexedName (varToVHDLName arg1) n_expr
454 ; argexpr2 = vhdlNameToVHDLExpr $ mkIndexedName (varToVHDLName arg2) n_expr
456 ; (app_concsms, used) <- genApplication (Right resname) zipped_f [Right argexpr1, Right argexpr2]
457 -- Return the generate functions
458 ; return ([AST.CSGSm $ AST.GenerateSm label genScheme [] app_concsms], used)
461 genFoldl :: BuiltinBuilder
462 genFoldl = genFold True
464 genFoldr :: BuiltinBuilder
465 genFoldr = genFold False
467 genFold :: Bool -> BuiltinBuilder
468 genFold left = genVarArgs (genFold' left)
470 genFold' :: Bool -> (Either CoreSyn.CoreBndr AST.VHDLName) -> CoreSyn.CoreBndr -> [Var.Var] -> TranslatorSession ([AST.ConcSm], [CoreSyn.CoreBndr])
471 genFold' left res f args@[folded_f , start ,vec]= do
472 len <- MonadState.lift tsType $ tfp_to_int $ (tfvec_len_ty (Var.varType vec))
473 genFold'' len left res f args
475 genFold'' :: Int -> Bool -> (Either CoreSyn.CoreBndr AST.VHDLName) -> CoreSyn.CoreBndr -> [Var.Var] -> TranslatorSession ([AST.ConcSm], [CoreSyn.CoreBndr])
476 -- Special case for an empty input vector, just assign start to res
477 genFold'' len left (Left res) _ [_, start, vec] | len == 0 = do
478 arg <- MonadState.lift tsType $ varToVHDLExpr start
479 return ([mkUncondAssign (Left res) arg], [])
481 genFold'' len left (Left res) f [folded_f, start, vec] = do
483 --len <- MonadState.lift tsType $ tfp_to_int $ (tfvec_len_ty . Var.varType) vec
484 -- An expression for len-1
485 let len_min_expr = (AST.PrimLit $ show (len-1))
486 -- evec is (TFVec n), so it still needs an element type
487 let (nvec, _) = Type.splitAppTy (Var.varType vec)
488 -- Put the type of the start value in nvec, this will be the type of our
490 let tmp_ty = Type.mkAppTy nvec (Var.varType start)
491 let error_msg = "\nGenerate.genFold': Can not construct temp vector for element type: " ++ pprString tmp_ty
492 -- TODO: Handle Nothing
493 Just tmp_vhdl_ty <- MonadState.lift tsType $ vhdl_ty error_msg tmp_ty
494 -- Setup the generate scheme
495 let gen_label = mkVHDLExtId ("foldlVector" ++ (varToString vec))
496 let block_label = mkVHDLExtId ("foldlVector" ++ (varToString res))
497 let gen_range = if left then AST.ToRange (AST.PrimLit "0") len_min_expr
498 else AST.DownRange len_min_expr (AST.PrimLit "0")
499 let gen_scheme = AST.ForGn n_id gen_range
500 -- Make the intermediate vector
501 let tmp_dec = AST.BDISD $ AST.SigDec tmp_id tmp_vhdl_ty Nothing
502 -- Create the generate statement
503 cells' <- sequence [genFirstCell, genOtherCell]
504 let (cells, useds) = unzip cells'
505 let gen_sm = AST.GenerateSm gen_label gen_scheme [] (map AST.CSGSm cells)
506 -- Assign tmp[len-1] or tmp[0] to res
507 let out_assign = mkUncondAssign (Left res) $ vhdlNameToVHDLExpr (if left then
508 (mkIndexedName tmp_name (AST.PrimLit $ show (len-1))) else
509 (mkIndexedName tmp_name (AST.PrimLit "0")))
510 let block = AST.BlockSm block_label [] (AST.PMapAspect []) [tmp_dec] [AST.CSGSm gen_sm, out_assign]
511 return ([AST.CSBSm block], concat useds)
513 -- An id for the counter
514 n_id = mkVHDLBasicId "n"
515 n_cur = idToVHDLExpr n_id
516 -- An expression for previous n
517 n_prev = if left then (n_cur AST.:-: (AST.PrimLit "1"))
518 else (n_cur AST.:+: (AST.PrimLit "1"))
519 -- An id for the tmp result vector
520 tmp_id = mkVHDLBasicId "tmp"
521 tmp_name = AST.NSimple tmp_id
522 -- Generate parts of the fold
523 genFirstCell, genOtherCell :: TranslatorSession (AST.GenerateSm, [CoreSyn.CoreBndr])
525 len <- MonadState.lift tsType $ tfp_to_int $ (tfvec_len_ty . Var.varType) vec
526 let cond_label = mkVHDLExtId "firstcell"
527 -- if n == 0 or n == len-1
528 let cond_scheme = AST.IfGn $ n_cur AST.:=: (if left then (AST.PrimLit "0")
529 else (AST.PrimLit $ show (len-1)))
530 -- Output to tmp[current n]
531 let resname = mkIndexedName tmp_name n_cur
533 argexpr1 <- MonadState.lift tsType $ varToVHDLExpr start
534 -- Input from vec[current n]
535 let argexpr2 = vhdlNameToVHDLExpr $ mkIndexedName (varToVHDLName vec) n_cur
536 (app_concsms, used) <- genApplication (Right resname) folded_f ( if left then
537 [Right argexpr1, Right argexpr2]
539 [Right argexpr2, Right argexpr1]
541 -- Return the conditional generate part
542 return $ (AST.GenerateSm cond_label cond_scheme [] app_concsms, used)
545 len <- MonadState.lift tsType $ tfp_to_int $ (tfvec_len_ty . Var.varType) vec
546 let cond_label = mkVHDLExtId "othercell"
547 -- if n > 0 or n < len-1
548 let cond_scheme = AST.IfGn $ n_cur AST.:/=: (if left then (AST.PrimLit "0")
549 else (AST.PrimLit $ show (len-1)))
550 -- Output to tmp[current n]
551 let resname = mkIndexedName tmp_name n_cur
552 -- Input from tmp[previous n]
553 let argexpr1 = vhdlNameToVHDLExpr $ mkIndexedName tmp_name n_prev
554 -- Input from vec[current n]
555 let argexpr2 = vhdlNameToVHDLExpr $ mkIndexedName (varToVHDLName vec) n_cur
556 (app_concsms, used) <- genApplication (Right resname) folded_f ( if left then
557 [Right argexpr1, Right argexpr2]
559 [Right argexpr2, Right argexpr1]
561 -- Return the conditional generate part
562 return $ (AST.GenerateSm cond_label cond_scheme [] app_concsms, used)
564 -- | Generate a generate statement for the builtin function "zip"
565 genZip :: BuiltinBuilder
566 genZip = genNoInsts $ genVarArgs genZip'
567 genZip' :: (Either CoreSyn.CoreBndr AST.VHDLName) -> CoreSyn.CoreBndr -> [Var.Var] -> TranslatorSession [AST.ConcSm]
568 genZip' (Left res) f args@[arg1, arg2] = do {
569 -- Setup the generate scheme
570 ; len <- MonadState.lift tsType $ tfp_to_int $ (tfvec_len_ty . Var.varType) res
571 -- TODO: Use something better than varToString
572 ; let { label = mkVHDLExtId ("zipVector" ++ (varToString res))
573 ; n_id = mkVHDLBasicId "n"
574 ; n_expr = idToVHDLExpr n_id
575 ; range = AST.ToRange (AST.PrimLit "0") (AST.PrimLit $ show (len-1))
576 ; genScheme = AST.ForGn n_id range
577 ; resname' = mkIndexedName (varToVHDLName res) n_expr
578 ; argexpr1 = vhdlNameToVHDLExpr $ mkIndexedName (varToVHDLName arg1) n_expr
579 ; argexpr2 = vhdlNameToVHDLExpr $ mkIndexedName (varToVHDLName arg2) n_expr
581 ; labels <- MonadState.lift tsType $ getFieldLabels (tfvec_elem (Var.varType res))
582 ; let { resnameA = mkSelectedName resname' (labels!!0)
583 ; resnameB = mkSelectedName resname' (labels!!1)
584 ; resA_assign = mkUncondAssign (Right resnameA) argexpr1
585 ; resB_assign = mkUncondAssign (Right resnameB) argexpr2
587 -- Return the generate functions
588 ; return [AST.CSGSm $ AST.GenerateSm label genScheme [] [resA_assign,resB_assign]]
591 -- | Generate a generate statement for the builtin function "unzip"
592 genUnzip :: BuiltinBuilder
593 genUnzip = genNoInsts $ genVarArgs genUnzip'
594 genUnzip' :: (Either CoreSyn.CoreBndr AST.VHDLName) -> CoreSyn.CoreBndr -> [Var.Var] -> TranslatorSession [AST.ConcSm]
595 genUnzip' (Left res) f args@[arg] = do {
596 -- Setup the generate scheme
597 ; len <- MonadState.lift tsType $ tfp_to_int $ (tfvec_len_ty . Var.varType) arg
598 -- TODO: Use something better than varToString
599 ; let { label = mkVHDLExtId ("unzipVector" ++ (varToString res))
600 ; n_id = mkVHDLBasicId "n"
601 ; n_expr = idToVHDLExpr n_id
602 ; range = AST.ToRange (AST.PrimLit "0") (AST.PrimLit $ show (len-1))
603 ; genScheme = AST.ForGn n_id range
604 ; resname' = varToVHDLName res
605 ; argexpr' = mkIndexedName (varToVHDLName arg) n_expr
607 ; reslabels <- MonadState.lift tsType $ getFieldLabels (Var.varType res)
608 ; arglabels <- MonadState.lift tsType $ getFieldLabels (tfvec_elem (Var.varType arg))
609 ; let { resnameA = mkIndexedName (mkSelectedName resname' (reslabels!!0)) n_expr
610 ; resnameB = mkIndexedName (mkSelectedName resname' (reslabels!!1)) n_expr
611 ; argexprA = vhdlNameToVHDLExpr $ mkSelectedName argexpr' (arglabels!!0)
612 ; argexprB = vhdlNameToVHDLExpr $ mkSelectedName argexpr' (arglabels!!1)
613 ; resA_assign = mkUncondAssign (Right resnameA) argexprA
614 ; resB_assign = mkUncondAssign (Right resnameB) argexprB
616 -- Return the generate functions
617 ; return [AST.CSGSm $ AST.GenerateSm label genScheme [] [resA_assign,resB_assign]]
620 genCopy :: BuiltinBuilder
621 genCopy = genNoInsts $ genVarArgs genCopy'
622 genCopy' :: (Either CoreSyn.CoreBndr AST.VHDLName ) -> CoreSyn.CoreBndr -> [Var.Var] -> TranslatorSession [AST.ConcSm]
623 genCopy' (Left res) f args@[arg] =
625 resExpr = AST.Aggregate [AST.ElemAssoc (Just AST.Others)
626 (AST.PrimName $ (varToVHDLName arg))]
627 out_assign = mkUncondAssign (Left res) resExpr
631 genConcat :: BuiltinBuilder
632 genConcat = genNoInsts $ genVarArgs genConcat'
633 genConcat' :: (Either CoreSyn.CoreBndr AST.VHDLName) -> CoreSyn.CoreBndr -> [Var.Var] -> TranslatorSession [AST.ConcSm]
634 genConcat' (Left res) f args@[arg] = do {
635 -- Setup the generate scheme
636 ; len1 <- MonadState.lift tsType $ tfp_to_int $ (tfvec_len_ty . Var.varType) arg
637 ; let (_, nvec) = Type.splitAppTy (Var.varType arg)
638 ; len2 <- MonadState.lift tsType $ tfp_to_int $ tfvec_len_ty nvec
639 -- TODO: Use something better than varToString
640 ; let { label = mkVHDLExtId ("concatVector" ++ (varToString res))
641 ; n_id = mkVHDLBasicId "n"
642 ; n_expr = idToVHDLExpr n_id
643 ; fromRange = n_expr AST.:*: (AST.PrimLit $ show len2)
644 ; genScheme = AST.ForGn n_id range
645 -- Create the content of the generate statement: Applying the mapped_f to
646 -- each of the elements in arg, storing to each element in res
647 ; toRange = (n_expr AST.:*: (AST.PrimLit $ show len2)) AST.:+: (AST.PrimLit $ show (len2-1))
648 ; range = AST.ToRange (AST.PrimLit "0") (AST.PrimLit $ show (len1-1))
649 ; resname = vecSlice fromRange toRange
650 ; argexpr = vhdlNameToVHDLExpr $ mkIndexedName (varToVHDLName arg) n_expr
651 ; out_assign = mkUncondAssign (Right resname) argexpr
653 -- Return the generate statement
654 ; return [AST.CSGSm $ AST.GenerateSm label genScheme [] [out_assign]]
657 vecSlice init last = AST.NSlice (AST.SliceName (varToVHDLName res)
658 (AST.ToRange init last))
660 genIteraten :: BuiltinBuilder
661 genIteraten dst f args = genIterate dst f (tail args)
663 genIterate :: BuiltinBuilder
664 genIterate = genIterateOrGenerate True
666 genGeneraten :: BuiltinBuilder
667 genGeneraten dst f args = genGenerate dst f (tail args)
669 genGenerate :: BuiltinBuilder
670 genGenerate = genIterateOrGenerate False
672 genIterateOrGenerate :: Bool -> BuiltinBuilder
673 genIterateOrGenerate iter = genVarArgs (genIterateOrGenerate' iter)
675 genIterateOrGenerate' :: Bool -> (Either CoreSyn.CoreBndr AST.VHDLName) -> CoreSyn.CoreBndr -> [Var.Var] -> TranslatorSession ([AST.ConcSm], [CoreSyn.CoreBndr])
676 genIterateOrGenerate' iter (Left res) f args = do
677 len <- MonadState.lift tsType $ tfp_to_int ((tfvec_len_ty . Var.varType) res)
678 genIterateOrGenerate'' len iter (Left res) f args
680 genIterateOrGenerate'' :: Int -> Bool -> (Either CoreSyn.CoreBndr AST.VHDLName) -> CoreSyn.CoreBndr -> [Var.Var] -> TranslatorSession ([AST.ConcSm], [CoreSyn.CoreBndr])
681 -- Special case for an empty input vector, just assign start to res
682 genIterateOrGenerate'' len iter (Left res) _ [app_f, start] | len == 0 = return ([mkUncondAssign (Left res) (AST.PrimLit "\"\"")], [])
684 genIterateOrGenerate'' len iter (Left res) f [app_f, start] = do
686 -- len <- MonadState.lift tsType $ tfp_to_int ((tfvec_len_ty . Var.varType) res)
687 -- An expression for len-1
688 let len_min_expr = (AST.PrimLit $ show (len-1))
689 -- -- evec is (TFVec n), so it still needs an element type
690 -- let (nvec, _) = splitAppTy (Var.varType vec)
691 -- -- Put the type of the start value in nvec, this will be the type of our
692 -- -- temporary vector
693 let tmp_ty = Var.varType res
694 let error_msg = "\nGenerate.genFold': Can not construct temp vector for element type: " ++ pprString tmp_ty
695 -- TODO: Handle Nothing
696 Just tmp_vhdl_ty <- MonadState.lift tsType $ vhdl_ty error_msg tmp_ty
697 -- Setup the generate scheme
698 let gen_label = mkVHDLExtId ("iterateVector" ++ (varToString start))
699 let block_label = mkVHDLExtId ("iterateVector" ++ (varToString res))
700 let gen_range = AST.ToRange (AST.PrimLit "0") len_min_expr
701 let gen_scheme = AST.ForGn n_id gen_range
702 -- Make the intermediate vector
703 let tmp_dec = AST.BDISD $ AST.SigDec tmp_id tmp_vhdl_ty Nothing
704 -- Create the generate statement
705 cells' <- sequence [genFirstCell, genOtherCell]
706 let (cells, useds) = unzip cells'
707 let gen_sm = AST.GenerateSm gen_label gen_scheme [] (map AST.CSGSm cells)
708 -- Assign tmp[len-1] or tmp[0] to res
709 let out_assign = mkUncondAssign (Left res) $ vhdlNameToVHDLExpr tmp_name
710 let block = AST.BlockSm block_label [] (AST.PMapAspect []) [tmp_dec] [AST.CSGSm gen_sm, out_assign]
711 return ([AST.CSBSm block], concat useds)
713 -- An id for the counter
714 n_id = mkVHDLBasicId "n"
715 n_cur = idToVHDLExpr n_id
716 -- An expression for previous n
717 n_prev = n_cur AST.:-: (AST.PrimLit "1")
718 -- An id for the tmp result vector
719 tmp_id = mkVHDLBasicId "tmp"
720 tmp_name = AST.NSimple tmp_id
721 -- Generate parts of the fold
722 genFirstCell, genOtherCell :: TranslatorSession (AST.GenerateSm, [CoreSyn.CoreBndr])
724 let cond_label = mkVHDLExtId "firstcell"
725 -- if n == 0 or n == len-1
726 let cond_scheme = AST.IfGn $ n_cur AST.:=: (AST.PrimLit "0")
727 -- Output to tmp[current n]
728 let resname = mkIndexedName tmp_name n_cur
730 argexpr <- MonadState.lift tsType $ varToVHDLExpr start
731 let startassign = mkUncondAssign (Right resname) argexpr
732 (app_concsms, used) <- genApplication (Right resname) app_f [Right argexpr]
733 -- Return the conditional generate part
734 let gensm = AST.GenerateSm cond_label cond_scheme [] (if iter then
742 let cond_label = mkVHDLExtId "othercell"
743 -- if n > 0 or n < len-1
744 let cond_scheme = AST.IfGn $ n_cur AST.:/=: (AST.PrimLit "0")
745 -- Output to tmp[current n]
746 let resname = mkIndexedName tmp_name n_cur
747 -- Input from tmp[previous n]
748 let argexpr = vhdlNameToVHDLExpr $ mkIndexedName tmp_name n_prev
749 (app_concsms, used) <- genApplication (Right resname) app_f [Right argexpr]
750 -- Return the conditional generate part
751 return $ (AST.GenerateSm cond_label cond_scheme [] app_concsms, used)
754 -----------------------------------------------------------------------------
755 -- Function to generate VHDL for applications
756 -----------------------------------------------------------------------------
758 (Either CoreSyn.CoreBndr AST.VHDLName) -- ^ Where to store the result?
759 -> CoreSyn.CoreBndr -- ^ The function to apply
760 -> [Either CoreSyn.CoreExpr AST.Expr] -- ^ The arguments to apply
761 -> TranslatorSession ([AST.ConcSm], [CoreSyn.CoreBndr])
762 -- ^ The corresponding VHDL concurrent statements and entities
764 genApplication dst f args = do
765 case Var.isGlobalId f of
767 top <- isTopLevelBinder f
770 -- Local binder that references a top level binding. Generate a
771 -- component instantiation.
772 signature <- getEntity f
773 args' <- eitherCoreOrExprArgs args
774 let entity_id = ent_id signature
775 -- TODO: Using show here isn't really pretty, but we'll need some
776 -- unique-ish value...
777 let label = "comp_ins_" ++ (either show prettyShow) dst
778 let portmaps = mkAssocElems args' ((either varToVHDLName id) dst) signature
779 return ([mkComponentInst label entity_id portmaps], [f])
781 -- Not a top level binder, so this must be a local variable reference.
782 -- It should have a representable type (and thus, no arguments) and a
783 -- signal should be generated for it. Just generate an unconditional
785 f' <- MonadState.lift tsType $ varToVHDLExpr f
786 return $ ([mkUncondAssign dst f'], [])
787 True | not stateful ->
788 case Var.idDetails f of
789 IdInfo.DataConWorkId dc -> case dst of
790 -- It's a datacon. Create a record from its arguments.
792 -- We have the bndr, so we can get at the type
793 labels <- MonadState.lift tsType $ getFieldLabels (Var.varType bndr)
794 args' <- eitherCoreOrExprArgs args
795 return $ (zipWith mkassign labels $ args', [])
797 mkassign :: AST.VHDLId -> AST.Expr -> AST.ConcSm
799 let sel_name = mkSelectedName ((either varToVHDLName id) dst) label in
800 mkUncondAssign (Right sel_name) arg
801 Right _ -> error $ "\nGenerate.genApplication: Can't generate dataconstructor application without an original binder"
802 IdInfo.DataConWrapId dc -> case dst of
803 -- It's a datacon. Create a record from its arguments.
805 case (Map.lookup (varToString f) globalNameTable) of
806 Just (arg_count, builder) ->
807 if length args == arg_count then
810 error $ "\nGenerate.genApplication(DataConWrapId): Incorrect number of arguments to builtin function: " ++ pprString f ++ " Args: " ++ show args
811 Nothing -> error $ "\nGenerate.genApplication: Can't generate dataconwrapper: " ++ (show dc)
812 Right _ -> error $ "\nGenerate.genApplication: Can't generate dataconwrapper application without an original binder"
813 IdInfo.VanillaId -> do
814 -- It's a global value imported from elsewhere. These can be builtin
815 -- functions. Look up the function name in the name table and execute
816 -- the associated builder if there is any and the argument count matches
817 -- (this should always be the case if it typechecks, but just to be
819 case (Map.lookup (varToString f) globalNameTable) of
820 Just (arg_count, builder) ->
821 if length args == arg_count then
824 error $ "\nGenerate.genApplication(VanillaGlobal): Incorrect number of arguments to builtin function: " ++ pprString f ++ " Args: " ++ show args
825 Nothing -> error $ ("\nGenerate.genApplication(VanillaGlobal): Using function from another module that is not a known builtin: " ++ (pprString f))
826 IdInfo.ClassOpId cls -> do
827 -- FIXME: Not looking for what instance this class op is called for
828 -- Is quite stupid of course.
829 case (Map.lookup (varToString f) globalNameTable) of
830 Just (arg_count, builder) ->
831 if length args == arg_count then
834 error $ "\nGenerate.genApplication(ClassOpId): Incorrect number of arguments to builtin function: " ++ pprString f ++ " Args: " ++ show args
835 Nothing -> error $ "\nGenerate.genApplication(ClassOpId): Using function from another module that is not a known builtin: " ++ pprString f
836 details -> error $ "\nGenerate.genApplication: Calling unsupported function " ++ pprString f ++ " with GlobalIdDetails " ++ pprString details
837 -- If we can't generate a component instantiation, and the destination is
838 -- a state type, don't generate anything.
841 -- Is our destination a state value?
842 stateful = case dst of
843 -- When our destination is a VHDL name, it won't have had a state type
845 -- Otherwise check its type
846 Left bndr -> hasStateType bndr
848 -----------------------------------------------------------------------------
849 -- Functions to generate functions dealing with vectors.
850 -----------------------------------------------------------------------------
852 -- Returns the VHDLId of the vector function with the given name for the given
853 -- element type. Generates -- this function if needed.
854 vectorFunId :: Type.Type -> String -> TypeSession AST.VHDLId
855 vectorFunId el_ty fname = do
856 let error_msg = "\nGenerate.vectorFunId: Can not construct vector function for element: " ++ pprString el_ty
857 -- TODO: Handle the Nothing case?
858 Just elemTM <- vhdl_ty error_msg el_ty
859 -- TODO: This should not be duplicated from mk_vector_ty. Probably but it in
860 -- the VHDLState or something.
861 let vectorTM = mkVHDLExtId $ "vector_" ++ (AST.fromVHDLId elemTM)
862 typefuns <- getA tsTypeFuns
863 case Map.lookup (OrdType el_ty, fname) typefuns of
864 -- Function already generated, just return it
865 Just (id, _) -> return id
866 -- Function not generated yet, generate it
868 let functions = genUnconsVectorFuns elemTM vectorTM
869 case lookup fname functions of
871 modA tsTypeFuns $ Map.insert (OrdType el_ty, fname) (function_id, (fst body))
872 mapM_ (vectorFunId el_ty) (snd body)
874 Nothing -> error $ "\nGenerate.vectorFunId: I don't know how to generate vector function " ++ fname
876 function_id = mkVHDLExtId fname
878 genUnconsVectorFuns :: AST.TypeMark -- ^ type of the vector elements
879 -> AST.TypeMark -- ^ type of the vector
880 -> [(String, (AST.SubProgBody, [String]))]
881 genUnconsVectorFuns elemTM vectorTM =
882 [ (exId, (AST.SubProgBody exSpec [] [exExpr],[]))
883 , (replaceId, (AST.SubProgBody replaceSpec [AST.SPVD replaceVar] [replaceExpr,replaceRet],[]))
884 , (lastId, (AST.SubProgBody lastSpec [] [lastExpr],[]))
885 , (initId, (AST.SubProgBody initSpec [AST.SPVD initVar] [initExpr, initRet],[]))
886 , (minimumId, (AST.SubProgBody minimumSpec [] [minimumExpr],[]))
887 , (takeId, (AST.SubProgBody takeSpec [AST.SPVD takeVar] [takeExpr, takeRet],[minimumId]))
888 , (dropId, (AST.SubProgBody dropSpec [AST.SPVD dropVar] [dropExpr, dropRet],[]))
889 , (plusgtId, (AST.SubProgBody plusgtSpec [AST.SPVD plusgtVar] [plusgtExpr, plusgtRet],[]))
890 , (emptyId, (AST.SubProgBody emptySpec [AST.SPCD emptyVar] [emptyExpr],[]))
891 , (singletonId, (AST.SubProgBody singletonSpec [AST.SPVD singletonVar] [singletonRet],[]))
892 , (copynId, (AST.SubProgBody copynSpec [AST.SPVD copynVar] [copynExpr],[]))
893 , (selId, (AST.SubProgBody selSpec [AST.SPVD selVar] [selFor, selRet],[]))
894 , (ltplusId, (AST.SubProgBody ltplusSpec [AST.SPVD ltplusVar] [ltplusExpr, ltplusRet],[]))
895 , (plusplusId, (AST.SubProgBody plusplusSpec [AST.SPVD plusplusVar] [plusplusExpr, plusplusRet],[]))
896 , (lengthTId, (AST.SubProgBody lengthTSpec [] [lengthTExpr],[]))
897 , (shiftlId, (AST.SubProgBody shiftlSpec [AST.SPVD shiftlVar] [shiftlExpr, shiftlRet], [initId]))
898 , (shiftrId, (AST.SubProgBody shiftrSpec [AST.SPVD shiftrVar] [shiftrExpr, shiftrRet], [tailId]))
899 , (nullId, (AST.SubProgBody nullSpec [] [nullExpr], []))
900 , (rotlId, (AST.SubProgBody rotlSpec [AST.SPVD rotlVar] [rotlExpr, rotlRet], [nullId, lastId, initId]))
901 , (rotrId, (AST.SubProgBody rotrSpec [AST.SPVD rotrVar] [rotrExpr, rotrRet], [nullId, tailId, headId]))
902 , (reverseId, (AST.SubProgBody reverseSpec [AST.SPVD reverseVar] [reverseFor, reverseRet], []))
905 ixPar = AST.unsafeVHDLBasicId "ix"
906 vecPar = AST.unsafeVHDLBasicId "vec"
907 vec1Par = AST.unsafeVHDLBasicId "vec1"
908 vec2Par = AST.unsafeVHDLBasicId "vec2"
909 nPar = AST.unsafeVHDLBasicId "n"
910 leftPar = AST.unsafeVHDLBasicId "nLeft"
911 rightPar = AST.unsafeVHDLBasicId "nRight"
912 iId = AST.unsafeVHDLBasicId "i"
914 aPar = AST.unsafeVHDLBasicId "a"
915 fPar = AST.unsafeVHDLBasicId "f"
916 sPar = AST.unsafeVHDLBasicId "s"
917 resId = AST.unsafeVHDLBasicId "res"
918 exSpec = AST.Function (mkVHDLExtId exId) [AST.IfaceVarDec vecPar vectorTM,
919 AST.IfaceVarDec ixPar naturalTM] elemTM
920 exExpr = AST.ReturnSm (Just $ AST.PrimName $ AST.NIndexed
921 (AST.IndexedName (AST.NSimple vecPar) [AST.PrimName $
923 replaceSpec = AST.Function (mkVHDLExtId replaceId) [ AST.IfaceVarDec vecPar vectorTM
924 , AST.IfaceVarDec iPar naturalTM
925 , AST.IfaceVarDec aPar elemTM
927 -- variable res : fsvec_x (0 to vec'length-1);
930 (AST.SubtypeIn vectorTM
931 (Just $ AST.ConstraintIndex $ AST.IndexConstraint
932 [AST.ToRange (AST.PrimLit "0")
933 (AST.PrimName (AST.NAttribute $
934 AST.AttribName (AST.NSimple vecPar) (AST.NSimple $ mkVHDLBasicId lengthId) Nothing) AST.:-:
935 (AST.PrimLit "1")) ]))
937 -- res AST.:= vec(0 to i-1) & a & vec(i+1 to length'vec-1)
938 replaceExpr = AST.NSimple resId AST.:=
939 (vecSlice (AST.PrimLit "0") (AST.PrimName (AST.NSimple iPar) AST.:-: AST.PrimLit "1") AST.:&:
940 AST.PrimName (AST.NSimple aPar) AST.:&:
941 vecSlice (AST.PrimName (AST.NSimple iPar) AST.:+: AST.PrimLit "1")
942 ((AST.PrimName (AST.NAttribute $
943 AST.AttribName (AST.NSimple vecPar) (AST.NSimple $ mkVHDLBasicId lengthId) Nothing))
944 AST.:-: AST.PrimLit "1"))
945 replaceRet = AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple resId)
946 vecSlice init last = AST.PrimName (AST.NSlice
949 (AST.ToRange init last)))
950 lastSpec = AST.Function (mkVHDLExtId lastId) [AST.IfaceVarDec vecPar vectorTM] elemTM
951 -- return vec(vec'length-1);
952 lastExpr = AST.ReturnSm (Just $ (AST.PrimName $ AST.NIndexed (AST.IndexedName
954 [AST.PrimName (AST.NAttribute $
955 AST.AttribName (AST.NSimple vecPar) (AST.NSimple $ mkVHDLBasicId lengthId) Nothing)
956 AST.:-: AST.PrimLit "1"])))
957 initSpec = AST.Function (mkVHDLExtId initId) [AST.IfaceVarDec vecPar vectorTM] vectorTM
958 -- variable res : fsvec_x (0 to vec'length-2);
961 (AST.SubtypeIn vectorTM
962 (Just $ AST.ConstraintIndex $ AST.IndexConstraint
963 [AST.ToRange (AST.PrimLit "0")
964 (AST.PrimName (AST.NAttribute $
965 AST.AttribName (AST.NSimple vecPar) (AST.NSimple $ mkVHDLBasicId lengthId) Nothing) AST.:-:
966 (AST.PrimLit "2")) ]))
968 -- resAST.:= vec(0 to vec'length-2)
969 initExpr = AST.NSimple resId AST.:= (vecSlice
971 (AST.PrimName (AST.NAttribute $
972 AST.AttribName (AST.NSimple vecPar) (AST.NSimple $ mkVHDLBasicId lengthId) Nothing)
973 AST.:-: AST.PrimLit "2"))
974 initRet = AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple resId)
975 minimumSpec = AST.Function (mkVHDLExtId minimumId) [AST.IfaceVarDec leftPar naturalTM,
976 AST.IfaceVarDec rightPar naturalTM ] naturalTM
977 minimumExpr = AST.IfSm ((AST.PrimName $ AST.NSimple leftPar) AST.:<: (AST.PrimName $ AST.NSimple rightPar))
978 [AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple leftPar)]
980 (Just $ AST.Else [minimumExprRet])
981 where minimumExprRet = AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple rightPar)
982 takeSpec = AST.Function (mkVHDLExtId takeId) [AST.IfaceVarDec nPar naturalTM,
983 AST.IfaceVarDec vecPar vectorTM ] vectorTM
984 -- variable res : fsvec_x (0 to (minimum (n,vec'length))-1);
985 minLength = AST.PrimFCall $ AST.FCall (AST.NSimple (mkVHDLExtId minimumId))
986 [Nothing AST.:=>: AST.ADExpr (AST.PrimName $ AST.NSimple nPar)
987 ,Nothing AST.:=>: AST.ADExpr (AST.PrimName (AST.NAttribute $
988 AST.AttribName (AST.NSimple vecPar) (AST.NSimple $ mkVHDLBasicId lengthId) Nothing))]
991 (AST.SubtypeIn vectorTM
992 (Just $ AST.ConstraintIndex $ AST.IndexConstraint
993 [AST.ToRange (AST.PrimLit "0")
995 (AST.PrimLit "1")) ]))
997 -- res AST.:= vec(0 to n-1)
998 takeExpr = AST.NSimple resId AST.:=
999 (vecSlice (AST.PrimLit "0")
1000 (minLength AST.:-: AST.PrimLit "1"))
1001 takeRet = AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple resId)
1002 dropSpec = AST.Function (mkVHDLExtId dropId) [AST.IfaceVarDec nPar naturalTM,
1003 AST.IfaceVarDec vecPar vectorTM ] vectorTM
1004 -- variable res : fsvec_x (0 to vec'length-n-1);
1007 (AST.SubtypeIn vectorTM
1008 (Just $ AST.ConstraintIndex $ AST.IndexConstraint
1009 [AST.ToRange (AST.PrimLit "0")
1010 (AST.PrimName (AST.NAttribute $
1011 AST.AttribName (AST.NSimple vecPar) (AST.NSimple $ mkVHDLBasicId lengthId) Nothing) AST.:-:
1012 (AST.PrimName $ AST.NSimple nPar)AST.:-: (AST.PrimLit "1")) ]))
1014 -- res AST.:= vec(n to vec'length-1)
1015 dropExpr = AST.NSimple resId AST.:= (vecSlice
1016 (AST.PrimName $ AST.NSimple nPar)
1017 (AST.PrimName (AST.NAttribute $
1018 AST.AttribName (AST.NSimple vecPar) (AST.NSimple $ mkVHDLBasicId lengthId) Nothing)
1019 AST.:-: AST.PrimLit "1"))
1020 dropRet = AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple resId)
1021 plusgtSpec = AST.Function (mkVHDLExtId plusgtId) [AST.IfaceVarDec aPar elemTM,
1022 AST.IfaceVarDec vecPar vectorTM] vectorTM
1023 -- variable res : fsvec_x (0 to vec'length);
1026 (AST.SubtypeIn vectorTM
1027 (Just $ AST.ConstraintIndex $ AST.IndexConstraint
1028 [AST.ToRange (AST.PrimLit "0")
1029 (AST.PrimName (AST.NAttribute $
1030 AST.AttribName (AST.NSimple vecPar) (AST.NSimple $ mkVHDLBasicId lengthId) Nothing))]))
1032 plusgtExpr = AST.NSimple resId AST.:=
1033 ((AST.PrimName $ AST.NSimple aPar) AST.:&:
1034 (AST.PrimName $ AST.NSimple vecPar))
1035 plusgtRet = AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple resId)
1036 emptySpec = AST.Function (mkVHDLExtId emptyId) [] vectorTM
1039 (AST.SubtypeIn vectorTM Nothing)
1040 (Just $ AST.PrimLit "\"\"")
1041 emptyExpr = AST.ReturnSm (Just $ AST.PrimName (AST.NSimple resId))
1042 singletonSpec = AST.Function (mkVHDLExtId singletonId) [AST.IfaceVarDec aPar elemTM ]
1044 -- variable res : fsvec_x (0 to 0) := (others => a);
1047 (AST.SubtypeIn vectorTM
1048 (Just $ AST.ConstraintIndex $ AST.IndexConstraint
1049 [AST.ToRange (AST.PrimLit "0") (AST.PrimLit "0")]))
1050 (Just $ AST.Aggregate [AST.ElemAssoc (Just AST.Others)
1051 (AST.PrimName $ AST.NSimple aPar)])
1052 singletonRet = AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple resId)
1053 copynSpec = AST.Function (mkVHDLExtId copynId) [AST.IfaceVarDec nPar naturalTM,
1054 AST.IfaceVarDec aPar elemTM ] vectorTM
1055 -- variable res : fsvec_x (0 to n-1) := (others => a);
1058 (AST.SubtypeIn vectorTM
1059 (Just $ AST.ConstraintIndex $ AST.IndexConstraint
1060 [AST.ToRange (AST.PrimLit "0")
1061 ((AST.PrimName (AST.NSimple nPar)) AST.:-:
1062 (AST.PrimLit "1")) ]))
1063 (Just $ AST.Aggregate [AST.ElemAssoc (Just AST.Others)
1064 (AST.PrimName $ AST.NSimple aPar)])
1066 copynExpr = AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple resId)
1067 selSpec = AST.Function (mkVHDLExtId selId) [AST.IfaceVarDec fPar naturalTM,
1068 AST.IfaceVarDec sPar naturalTM,
1069 AST.IfaceVarDec nPar naturalTM,
1070 AST.IfaceVarDec vecPar vectorTM ] vectorTM
1071 -- variable res : fsvec_x (0 to n-1);
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")) ])
1081 -- for i res'range loop
1082 -- res(i) := vec(f+i*s);
1084 selFor = AST.ForSM iId (AST.AttribRange $ AST.AttribName (AST.NSimple resId) (AST.NSimple $ rangeId) Nothing) [selAssign]
1085 -- res(i) := vec(f+i*s);
1086 selAssign = let origExp = AST.PrimName (AST.NSimple fPar) AST.:+:
1087 (AST.PrimName (AST.NSimple iId) AST.:*:
1088 AST.PrimName (AST.NSimple sPar)) in
1089 AST.NIndexed (AST.IndexedName (AST.NSimple resId) [AST.PrimName (AST.NSimple iId)]) AST.:=
1090 (AST.PrimName $ AST.NIndexed (AST.IndexedName (AST.NSimple vecPar) [origExp]))
1092 selRet = AST.ReturnSm (Just $ AST.PrimName (AST.NSimple resId))
1093 ltplusSpec = AST.Function (mkVHDLExtId ltplusId) [AST.IfaceVarDec vecPar vectorTM,
1094 AST.IfaceVarDec aPar elemTM] vectorTM
1095 -- variable res : fsvec_x (0 to vec'length);
1098 (AST.SubtypeIn vectorTM
1099 (Just $ AST.ConstraintIndex $ AST.IndexConstraint
1100 [AST.ToRange (AST.PrimLit "0")
1101 (AST.PrimName (AST.NAttribute $
1102 AST.AttribName (AST.NSimple vecPar) (AST.NSimple $ mkVHDLBasicId lengthId) Nothing))]))
1104 ltplusExpr = AST.NSimple resId AST.:=
1105 ((AST.PrimName $ AST.NSimple vecPar) AST.:&:
1106 (AST.PrimName $ AST.NSimple aPar))
1107 ltplusRet = AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple resId)
1108 plusplusSpec = AST.Function (mkVHDLExtId plusplusId) [AST.IfaceVarDec vec1Par vectorTM,
1109 AST.IfaceVarDec vec2Par vectorTM]
1111 -- variable res : fsvec_x (0 to vec1'length + vec2'length -1);
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 vec1Par) (AST.NSimple $ mkVHDLBasicId lengthId) Nothing) AST.:+:
1119 AST.PrimName (AST.NAttribute $
1120 AST.AttribName (AST.NSimple vec2Par) (AST.NSimple $ mkVHDLBasicId lengthId) Nothing) AST.:-:
1123 plusplusExpr = AST.NSimple resId AST.:=
1124 ((AST.PrimName $ AST.NSimple vec1Par) AST.:&:
1125 (AST.PrimName $ AST.NSimple vec2Par))
1126 plusplusRet = AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple resId)
1127 lengthTSpec = AST.Function (mkVHDLExtId lengthTId) [AST.IfaceVarDec vecPar vectorTM] naturalTM
1128 lengthTExpr = AST.ReturnSm (Just $ AST.PrimName (AST.NAttribute $
1129 AST.AttribName (AST.NSimple vecPar) (AST.NSimple $ mkVHDLBasicId lengthId) Nothing))
1130 shiftlSpec = AST.Function (mkVHDLExtId shiftlId) [AST.IfaceVarDec vecPar vectorTM,
1131 AST.IfaceVarDec aPar elemTM ] vectorTM
1132 -- variable res : fsvec_x (0 to vec'length-1);
1135 (AST.SubtypeIn vectorTM
1136 (Just $ AST.ConstraintIndex $ AST.IndexConstraint
1137 [AST.ToRange (AST.PrimLit "0")
1138 (AST.PrimName (AST.NAttribute $
1139 AST.AttribName (AST.NSimple vecPar) (AST.NSimple $ mkVHDLBasicId lengthId) Nothing) AST.:-:
1140 (AST.PrimLit "1")) ]))
1142 -- res := a & init(vec)
1143 shiftlExpr = AST.NSimple resId AST.:=
1144 (AST.PrimName (AST.NSimple aPar) AST.:&:
1145 (AST.PrimFCall $ AST.FCall (AST.NSimple (mkVHDLExtId initId))
1146 [Nothing AST.:=>: AST.ADExpr (AST.PrimName $ AST.NSimple vecPar)]))
1147 shiftlRet = AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple resId)
1148 shiftrSpec = AST.Function (mkVHDLExtId shiftrId) [AST.IfaceVarDec vecPar vectorTM,
1149 AST.IfaceVarDec aPar elemTM ] vectorTM
1150 -- variable res : fsvec_x (0 to vec'length-1);
1153 (AST.SubtypeIn vectorTM
1154 (Just $ AST.ConstraintIndex $ AST.IndexConstraint
1155 [AST.ToRange (AST.PrimLit "0")
1156 (AST.PrimName (AST.NAttribute $
1157 AST.AttribName (AST.NSimple vecPar) (AST.NSimple $ mkVHDLBasicId lengthId) Nothing) AST.:-:
1158 (AST.PrimLit "1")) ]))
1160 -- res := tail(vec) & a
1161 shiftrExpr = AST.NSimple resId AST.:=
1162 ((AST.PrimFCall $ AST.FCall (AST.NSimple (mkVHDLExtId tailId))
1163 [Nothing AST.:=>: AST.ADExpr (AST.PrimName $ AST.NSimple vecPar)]) AST.:&:
1164 (AST.PrimName (AST.NSimple aPar)))
1166 shiftrRet = AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple resId)
1167 nullSpec = AST.Function (mkVHDLExtId nullId) [AST.IfaceVarDec vecPar vectorTM] booleanTM
1168 -- return vec'length = 0
1169 nullExpr = AST.ReturnSm (Just $
1170 AST.PrimName (AST.NAttribute $
1171 AST.AttribName (AST.NSimple vecPar) (AST.NSimple $ mkVHDLBasicId lengthId) Nothing) AST.:=:
1173 rotlSpec = AST.Function (mkVHDLExtId rotlId) [AST.IfaceVarDec vecPar vectorTM] vectorTM
1174 -- variable res : fsvec_x (0 to vec'length-1);
1177 (AST.SubtypeIn vectorTM
1178 (Just $ AST.ConstraintIndex $ AST.IndexConstraint
1179 [AST.ToRange (AST.PrimLit "0")
1180 (AST.PrimName (AST.NAttribute $
1181 AST.AttribName (AST.NSimple vecPar) (AST.NSimple $ mkVHDLBasicId lengthId) Nothing) AST.:-:
1182 (AST.PrimLit "1")) ]))
1184 -- if null(vec) then res := vec else res := last(vec) & init(vec)
1185 rotlExpr = AST.IfSm (AST.PrimFCall $ AST.FCall (AST.NSimple (mkVHDLExtId nullId))
1186 [Nothing AST.:=>: AST.ADExpr (AST.PrimName $ AST.NSimple vecPar)])
1187 [AST.NSimple resId AST.:= (AST.PrimName $ AST.NSimple vecPar)]
1189 (Just $ AST.Else [rotlExprRet])
1191 AST.NSimple resId AST.:=
1192 ((AST.PrimFCall $ AST.FCall (AST.NSimple (mkVHDLExtId lastId))
1193 [Nothing AST.:=>: AST.ADExpr (AST.PrimName $ AST.NSimple vecPar)]) AST.:&:
1194 (AST.PrimFCall $ AST.FCall (AST.NSimple (mkVHDLExtId initId))
1195 [Nothing AST.:=>: AST.ADExpr (AST.PrimName $ AST.NSimple vecPar)]))
1196 rotlRet = AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple resId)
1197 rotrSpec = AST.Function (mkVHDLExtId rotrId) [AST.IfaceVarDec vecPar vectorTM] vectorTM
1198 -- variable res : fsvec_x (0 to vec'length-1);
1201 (AST.SubtypeIn vectorTM
1202 (Just $ AST.ConstraintIndex $ AST.IndexConstraint
1203 [AST.ToRange (AST.PrimLit "0")
1204 (AST.PrimName (AST.NAttribute $
1205 AST.AttribName (AST.NSimple vecPar) (AST.NSimple $ mkVHDLBasicId lengthId) Nothing) AST.:-:
1206 (AST.PrimLit "1")) ]))
1208 -- if null(vec) then res := vec else res := tail(vec) & head(vec)
1209 rotrExpr = AST.IfSm (AST.PrimFCall $ AST.FCall (AST.NSimple (mkVHDLExtId nullId))
1210 [Nothing AST.:=>: AST.ADExpr (AST.PrimName $ AST.NSimple vecPar)])
1211 [AST.NSimple resId AST.:= (AST.PrimName $ AST.NSimple vecPar)]
1213 (Just $ AST.Else [rotrExprRet])
1215 AST.NSimple resId AST.:=
1216 ((AST.PrimFCall $ AST.FCall (AST.NSimple (mkVHDLExtId tailId))
1217 [Nothing AST.:=>: AST.ADExpr (AST.PrimName $ AST.NSimple vecPar)]) AST.:&:
1218 (AST.PrimFCall $ AST.FCall (AST.NSimple (mkVHDLExtId headId))
1219 [Nothing AST.:=>: AST.ADExpr (AST.PrimName $ AST.NSimple vecPar)]))
1220 rotrRet = AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple resId)
1221 reverseSpec = AST.Function (mkVHDLExtId reverseId) [AST.IfaceVarDec vecPar vectorTM] vectorTM
1224 (AST.SubtypeIn vectorTM
1225 (Just $ AST.ConstraintIndex $ AST.IndexConstraint
1226 [AST.ToRange (AST.PrimLit "0")
1227 (AST.PrimName (AST.NAttribute $
1228 AST.AttribName (AST.NSimple vecPar) (AST.NSimple $ mkVHDLBasicId lengthId) Nothing) AST.:-:
1229 (AST.PrimLit "1")) ]))
1231 -- for i in 0 to res'range loop
1232 -- res(vec'length-i-1) := vec(i);
1235 AST.ForSM iId (AST.AttribRange $ AST.AttribName (AST.NSimple resId) (AST.NSimple $ rangeId) Nothing) [reverseAssign]
1236 -- res(vec'length-i-1) := vec(i);
1237 reverseAssign = AST.NIndexed (AST.IndexedName (AST.NSimple resId) [destExp]) AST.:=
1238 (AST.PrimName $ AST.NIndexed (AST.IndexedName (AST.NSimple vecPar)
1239 [AST.PrimName $ AST.NSimple iId]))
1240 where destExp = AST.PrimName (AST.NAttribute $ AST.AttribName (AST.NSimple vecPar)
1241 (AST.NSimple $ mkVHDLBasicId lengthId) Nothing) AST.:-:
1242 AST.PrimName (AST.NSimple iId) AST.:-:
1245 reverseRet = AST.ReturnSm (Just $ AST.PrimName (AST.NSimple resId))
1248 -----------------------------------------------------------------------------
1249 -- A table of builtin functions
1250 -----------------------------------------------------------------------------
1252 -- A function that generates VHDL for a builtin function
1253 type BuiltinBuilder =
1254 (Either CoreSyn.CoreBndr AST.VHDLName) -- ^ The destination signal and it's original type
1255 -> CoreSyn.CoreBndr -- ^ The function called
1256 -> [Either CoreSyn.CoreExpr AST.Expr] -- ^ The value arguments passed (excluding type and
1257 -- dictionary arguments).
1258 -> TranslatorSession ([AST.ConcSm], [CoreSyn.CoreBndr])
1259 -- ^ The corresponding VHDL concurrent statements and entities
1262 -- A map of a builtin function to VHDL function builder
1263 type NameTable = Map.Map String (Int, BuiltinBuilder )
1265 -- | The builtin functions we support. Maps a name to an argument count and a
1266 -- builder function.
1267 globalNameTable :: NameTable
1268 globalNameTable = Map.fromList
1269 [ (exId , (2, genFCall True ) )
1270 , (replaceId , (3, genFCall False ) )
1271 , (headId , (1, genFCall True ) )
1272 , (lastId , (1, genFCall True ) )
1273 , (tailId , (1, genFCall False ) )
1274 , (initId , (1, genFCall False ) )
1275 , (takeId , (2, genFCall False ) )
1276 , (dropId , (2, genFCall False ) )
1277 , (selId , (4, genFCall False ) )
1278 , (plusgtId , (2, genFCall False ) )
1279 , (ltplusId , (2, genFCall False ) )
1280 , (plusplusId , (2, genFCall False ) )
1281 , (mapId , (2, genMap ) )
1282 , (zipWithId , (3, genZipWith ) )
1283 , (foldlId , (3, genFoldl ) )
1284 , (foldrId , (3, genFoldr ) )
1285 , (zipId , (2, genZip ) )
1286 , (unzipId , (1, genUnzip ) )
1287 , (shiftlId , (2, genFCall False ) )
1288 , (shiftrId , (2, genFCall False ) )
1289 , (rotlId , (1, genFCall False ) )
1290 , (rotrId , (1, genFCall False ) )
1291 , (concatId , (1, genConcat ) )
1292 , (reverseId , (1, genFCall False ) )
1293 , (iteratenId , (3, genIteraten ) )
1294 , (iterateId , (2, genIterate ) )
1295 , (generatenId , (3, genGeneraten ) )
1296 , (generateId , (2, genGenerate ) )
1297 , (emptyId , (0, genFCall False ) )
1298 , (singletonId , (1, genFCall False ) )
1299 , (copynId , (2, genFCall False ) )
1300 , (copyId , (1, genCopy ) )
1301 , (lengthTId , (1, genFCall False ) )
1302 , (nullId , (1, genFCall False ) )
1303 , (hwxorId , (2, genOperator2 AST.Xor ) )
1304 , (hwandId , (2, genOperator2 AST.And ) )
1305 , (hworId , (2, genOperator2 AST.Or ) )
1306 , (hwnotId , (1, genOperator1 AST.Not ) )
1307 , (plusId , (2, genOperator2 (AST.:+:) ) )
1308 , (timesId , (2, genOperator2 (AST.:*:) ) )
1309 , (negateId , (1, genNegation ) )
1310 , (minusId , (2, genOperator2 (AST.:-:) ) )
1311 , (fromSizedWordId , (1, genFromSizedWord ) )
1312 , (fromIntegerId , (1, genFromInteger ) )
1313 , (resizeId , (1, genResize ) )
1314 , (sizedIntId , (1, genSizedInt ) )
1315 --, (tfvecId , (1, genTFVec ) )
1316 , (minimumId , (2, error $ "\nFunction name: \"minimum\" is used internally, use another name"))