2 -- Functions to generate VHDL from FlatFunctions
7 import qualified Data.List as List
8 import qualified Data.Map as Map
10 import qualified Control.Monad as Monad
11 import qualified Control.Arrow as Arrow
12 import qualified Control.Monad.Trans.State as State
13 import qualified Data.Monoid as Monoid
17 import qualified ForSyDe.Backend.VHDL.AST as AST
25 import qualified IdInfo
26 import qualified TyCon
27 import qualified DataCon
28 import qualified CoreSubst
29 import qualified CoreUtils
30 import Outputable ( showSDoc, ppr )
39 import GlobalNameTable
42 [(CoreSyn.CoreBndr, CoreSyn.CoreExpr)]
43 -> [(AST.VHDLId, AST.DesignFile)]
45 createDesignFiles binds =
46 (mkVHDLBasicId "types", AST.DesignFile ieee_context [type_package_dec, type_package_body]) :
47 map (Arrow.second $ AST.DesignFile full_context) units
50 init_session = VHDLSession Map.empty Map.empty Map.empty Map.empty globalNameTable
51 (units, final_session) =
52 State.runState (createLibraryUnits binds) init_session
53 tyfun_decls = Map.elems (final_session ^.vsTypeFuns)
54 ty_decls = map mktydecl $ Map.elems (final_session ^. vsTypes)
55 vec_decls = map (\(v_id, v_def) -> AST.PDITD $ AST.TypeDec v_id v_def) (Map.elems (final_session ^. vsElemTypes))
56 tfvec_index_decl = AST.PDISD $ AST.SubtypeDec tfvec_indexTM tfvec_index_def
57 tfvec_range = AST.ConstraintRange $ AST.SubTypeRange (AST.PrimLit "-1") (AST.PrimName $ AST.NAttribute $ AST.AttribName (AST.NSimple integerTM) highId Nothing)
58 tfvec_index_def = AST.SubtypeIn integerTM (Just tfvec_range)
60 AST.Library $ mkVHDLBasicId "IEEE",
61 mkUseAll ["IEEE", "std_logic_1164"],
62 mkUseAll ["IEEE", "numeric_std"]
65 mkUseAll ["work", "types"]
67 type_package_dec = AST.LUPackageDec $ AST.PackageDec (mkVHDLBasicId "types") ([tfvec_index_decl] ++ vec_decls ++ ty_decls ++ subProgSpecs)
68 type_package_body = AST.LUPackageBody $ AST.PackageBody typesId (concat tyfun_decls)
69 subProgSpecs = concat (map subProgSpec tyfun_decls)
70 subProgSpec = map (\(AST.SubProgBody spec _ _) -> AST.PDISS spec)
71 mktydecl :: (AST.VHDLId, Either AST.TypeDef AST.SubtypeIn) -> AST.PackageDecItem
72 mktydecl (ty_id, Left ty_def) = AST.PDITD $ AST.TypeDec ty_id ty_def
73 mktydecl (ty_id, Right ty_def) = AST.PDISD $ AST.SubtypeDec ty_id ty_def
75 -- Create a use foo.bar.all statement. Takes a list of components in the used
76 -- name. Must contain at least two components
77 mkUseAll :: [String] -> AST.ContextItem
79 AST.Use $ from AST.:.: AST.All
81 base_prefix = (AST.NSimple $ mkVHDLBasicId $ head ss)
82 from = foldl select base_prefix (tail ss)
83 select prefix s = AST.NSelected $ prefix AST.:.: (AST.SSimple $ mkVHDLBasicId s)
86 [(CoreSyn.CoreBndr, CoreSyn.CoreExpr)]
87 -> VHDLState [(AST.VHDLId, [AST.LibraryUnit])]
89 createLibraryUnits binds = do
90 entities <- Monad.mapM createEntity binds
91 archs <- Monad.mapM createArchitecture binds
94 let AST.EntityDec id _ = ent in
95 (id, [AST.LUEntity ent, AST.LUArch arch])
99 -- | Create an entity for a given function
101 (CoreSyn.CoreBndr, CoreSyn.CoreExpr) -- | The function
102 -> VHDLState AST.EntityDec -- | The resulting entity
104 createEntity (fname, expr) = do
105 -- Strip off lambda's, these will be arguments
106 let (args, letexpr) = CoreSyn.collectBinders expr
107 args' <- Monad.mapM mkMap args
108 -- There must be a let at top level
109 let (CoreSyn.Let binds (CoreSyn.Var res)) = letexpr
111 let vhdl_id = mkVHDLBasicId $ bndrToString fname ++ "_" ++ varToStringUniq fname
112 let ent_decl' = createEntityAST vhdl_id args' res'
113 let AST.EntityDec entity_id _ = ent_decl'
114 let signature = Entity entity_id args' res'
115 modA vsSignatures (Map.insert fname signature)
119 --[(SignalId, SignalInfo)]
121 -> VHDLState VHDLSignalMapElement
122 -- We only need the vsTypes element from the state
125 --info = Maybe.fromMaybe
126 -- (error $ "Signal not found in the name map? This should not happen!")
127 -- (lookup id sigmap)
128 -- Assume the bndr has a valid VHDL id already
129 id = bndrToVHDLId bndr
130 ty = Var.varType bndr
132 if True -- isPortSigUse $ sigUse info
134 type_mark <- vhdl_ty ty
135 return $ Just (id, type_mark)
140 -- | Create the VHDL AST for an entity
142 AST.VHDLId -- | The name of the function
143 -> [VHDLSignalMapElement] -- | The entity's arguments
144 -> VHDLSignalMapElement -- | The entity's result
145 -> AST.EntityDec -- | The entity with the ent_decl filled in as well
147 createEntityAST vhdl_id args res =
148 AST.EntityDec vhdl_id ports
150 -- Create a basic Id, since VHDL doesn't grok filenames with extended Ids.
151 ports = Maybe.catMaybes $
152 map (mkIfaceSigDec AST.In) args
153 ++ [mkIfaceSigDec AST.Out res]
155 -- Add a clk port if we have state
156 clk_port = if True -- hasState hsfunc
158 Just $ AST.IfaceSigDec (mkVHDLExtId "clk") AST.In std_logic_ty
162 -- | Create a port declaration
164 AST.Mode -- | The mode for the port (In / Out)
165 -> Maybe (AST.VHDLId, AST.TypeMark) -- | The id and type for the port
166 -> Maybe AST.IfaceSigDec -- | The resulting port declaration
168 mkIfaceSigDec mode (Just (id, ty)) = Just $ AST.IfaceSigDec id mode ty
169 mkIfaceSigDec _ Nothing = Nothing
172 -- | Generate a VHDL entity name for the given hsfunc
174 -- TODO: This doesn't work for functions with multiple signatures!
175 -- Use a Basic Id, since using extended id's for entities throws off
176 -- precision and causes problems when generating filenames.
177 mkVHDLBasicId $ hsFuncName hsfunc
180 -- | Create an architecture for a given function
181 createArchitecture ::
182 (CoreSyn.CoreBndr, CoreSyn.CoreExpr) -- ^ The function
183 -> VHDLState AST.ArchBody -- ^ The architecture for this function
185 createArchitecture (fname, expr) = do
186 signaturemap <- getA vsSignatures
187 let signature = Maybe.fromMaybe
188 (error $ "Generating architecture for function " ++ (pprString fname) ++ "without signature? This should not happen!")
189 (Map.lookup fname signaturemap)
190 let entity_id = ent_id signature
191 -- Strip off lambda's, these will be arguments
192 let (args, letexpr) = CoreSyn.collectBinders expr
193 -- There must be a let at top level
194 let (CoreSyn.Let (CoreSyn.Rec binds) (Var res)) = letexpr
196 -- Create signal declarations for all binders in the let expression, except
197 -- for the output port (that will already have an output port declared in
199 sig_dec_maybes <- mapM (mkSigDec' . fst) (filter ((/=res).fst) binds)
200 let sig_decs = Maybe.catMaybes $ sig_dec_maybes
202 statementss <- Monad.mapM mkConcSm binds
203 let statements = concat statementss
204 return $ AST.ArchBody (mkVHDLBasicId "structural") (AST.NSimple entity_id) (map AST.BDISD sig_decs) (statements ++ procs')
206 procs = [] --map mkStateProcSm [] -- (makeStatePairs flatfunc)
207 procs' = map AST.CSPSm procs
208 -- mkSigDec only uses vsTypes from the state
212 -- | Looks up all pairs of old state, new state signals, together with
213 -- the state id they represent.
214 makeStatePairs :: FlatFunction -> [(StateId, SignalInfo, SignalInfo)]
215 makeStatePairs flatfunc =
216 [(Maybe.fromJust $ oldStateId $ sigUse old_info, old_info, new_info)
217 | old_info <- map snd (flat_sigs flatfunc)
218 , new_info <- map snd (flat_sigs flatfunc)
219 -- old_info must be an old state (and, because of the next equality,
220 -- new_info must be a new state).
221 , Maybe.isJust $ oldStateId $ sigUse old_info
222 -- And the state numbers must match
223 , (oldStateId $ sigUse old_info) == (newStateId $ sigUse new_info)]
225 -- Replace the second tuple element with the corresponding SignalInfo
226 --args_states = map (Arrow.second $ signalInfo sigs) args
227 mkStateProcSm :: (StateId, SignalInfo, SignalInfo) -> AST.ProcSm
228 mkStateProcSm (num, old, new) =
229 AST.ProcSm label [clk] [statement]
231 label = mkVHDLExtId $ "state_" ++ (show num)
232 clk = mkVHDLExtId "clk"
233 rising_edge = AST.NSimple $ mkVHDLBasicId "rising_edge"
234 wform = AST.Wform [AST.WformElem (AST.PrimName $ AST.NSimple $ getSignalId new) Nothing]
235 assign = AST.SigAssign (AST.NSimple $ getSignalId old) wform
236 rising_edge_clk = AST.PrimFCall $ AST.FCall rising_edge [Nothing AST.:=>: (AST.ADName $ AST.NSimple clk)]
237 statement = AST.IfSm rising_edge_clk [assign] [] Nothing
239 -- | Creates a VHDL Id from a named SignalInfo. Errors out if the SignalInfo
241 getSignalId :: SignalInfo -> AST.VHDLId
243 mkVHDLExtId $ Maybe.fromMaybe
244 (error $ "Unnamed signal? This should not happen!")
248 mkSigDec :: CoreSyn.CoreBndr -> VHDLState (Maybe AST.SigDec)
250 if True then do --isInternalSigUse use || isStateSigUse use then do
251 type_mark <- vhdl_ty $ Var.varType bndr
252 return $ Just (AST.SigDec (bndrToVHDLId bndr) type_mark Nothing)
256 -- | Transforms a core binding into a VHDL concurrent statement
258 (CoreSyn.CoreBndr, CoreSyn.CoreExpr) -- ^ The binding to process
259 -> VHDLState [AST.ConcSm] -- ^ The corresponding VHDL component instantiations.
262 -- Ignore Cast expressions, they should not longer have any meaning as long as
263 -- the type works out.
264 mkConcSm (bndr, Cast expr ty) = mkConcSm (bndr, expr)
266 -- For simple a = b assignments, just generate an unconditional signal
267 -- assignment. This should only happen for dataconstructors without arguments.
268 -- TODO: Integrate this with the below code for application (essentially this
269 -- is an application without arguments)
270 mkConcSm (bndr, Var v) = return $ [mkUncondAssign (Left bndr) (varToVHDLExpr v)]
272 mkConcSm (bndr, app@(CoreSyn.App _ _))= do
273 let (CoreSyn.Var f, args) = CoreSyn.collectArgs app
274 let valargs' = filter isValArg args
275 let valargs = filter (\(CoreSyn.Var bndr) -> not (Id.isDictId bndr)) valargs'
276 case Var.globalIdVarDetails f of
277 IdInfo.DataConWorkId dc ->
278 -- It's a datacon. Create a record from its arguments.
279 -- First, filter out type args. TODO: Is this the best way to do this?
280 -- The types should already have been taken into acocunt when creating
281 -- the signal, so this should probably work...
282 --let valargs = filter isValArg args in
283 if all is_var valargs then do
284 labels <- getFieldLabels (CoreUtils.exprType app)
285 return $ zipWith mkassign labels valargs
287 error $ "VHDL.mkConcSm Not in normal form: One ore more complex arguments: " ++ pprString args
289 mkassign :: AST.VHDLId -> CoreExpr -> AST.ConcSm
290 mkassign label (Var arg) =
291 let sel_name = mkSelectedName bndr label in
292 mkUncondAssign (Right sel_name) (varToVHDLExpr arg)
293 IdInfo.VanillaGlobal -> do
294 -- It's a global value imported from elsewhere. These can be builtin
296 funSignatures <- getA vsNameTable
297 signatures <- getA vsSignatures
298 case (Map.lookup (bndrToString f) funSignatures) of
299 Just (arg_count, builder) ->
300 if length valargs == arg_count then
304 sigs = map (varToVHDLExpr.varBndr) valargs
305 func = funBuilder sigs
306 src_wform = AST.Wform [AST.WformElem func Nothing]
307 dst_name = AST.NSimple (mkVHDLExtId (bndrToString bndr))
308 assign = dst_name AST.:<==: (AST.ConWforms [] src_wform Nothing)
310 return [AST.CSSASm assign]
313 sigs = map varBndr valargs
314 signature = Maybe.fromMaybe
315 (error $ "Using function '" ++ (bndrToString (head sigs)) ++ "' without signature? This should not happen!")
316 (Map.lookup (head sigs) signatures)
318 genSm = genBuilder signature (arg ++ [bndr])
319 in return [AST.CSGSm genSm]
321 error $ "VHDL.mkConcSm Incorrect number of arguments to builtin function: " ++ pprString f ++ " Args: " ++ pprString valargs
322 Nothing -> error $ "Using function from another module that is not a known builtin: " ++ pprString f
323 IdInfo.NotGlobalId -> do
324 signatures <- getA vsSignatures
325 -- This is a local id, so it should be a function whose definition we
326 -- have and which can be turned into a component instantiation.
328 signature = Maybe.fromMaybe
329 (error $ "Using function '" ++ (bndrToString f) ++ "' without signature? This should not happen!")
330 (Map.lookup f signatures)
331 entity_id = ent_id signature
332 label = "comp_ins_" ++ bndrToString bndr
333 -- Add a clk port if we have state
334 --clk_port = Maybe.fromJust $ mkAssocElem (Just $ mkVHDLExtId "clk") "clk"
335 clk_port = Maybe.fromJust $ mkAssocElem (Just $ mkVHDLExtId "clk") "clk"
336 --portmaps = mkAssocElems sigs args res signature ++ (if hasState hsfunc then [clk_port] else [])
337 portmaps = clk_port : mkAssocElems args bndr signature
339 return [genComponentInst label entity_id portmaps]
340 details -> error $ "Calling unsupported function " ++ pprString f ++ " with GlobalIdDetails " ++ pprString details
342 -- A single alt case must be a selector. This means thee scrutinee is a simple
343 -- variable, the alternative is a dataalt with a single non-wild binder that
345 mkConcSm (bndr, expr@(Case (Var scrut) b ty [alt])) =
347 (DataAlt dc, bndrs, (Var sel_bndr)) -> do
348 case List.elemIndex sel_bndr bndrs of
350 labels <- getFieldLabels (Id.idType scrut)
351 let label = labels!!i
352 let sel_name = mkSelectedName scrut label
353 let sel_expr = AST.PrimName sel_name
354 return [mkUncondAssign (Left bndr) sel_expr]
355 Nothing -> error $ "VHDL.mkConcSM Not in normal form: Not a selector case:\n" ++ (pprString expr)
357 _ -> error $ "VHDL.mkConcSM Not in normal form: Not a selector case:\n" ++ (pprString expr)
359 -- Multiple case alt are be conditional assignments and have only wild
360 -- binders in the alts and only variables in the case values and a variable
361 -- for a scrutinee. We check the constructor of the second alt, since the
362 -- first is the default case, if there is any.
363 mkConcSm (bndr, (Case (Var scrut) b ty [(_, _, Var false), (con, _, Var true)])) =
365 cond_expr = (varToVHDLExpr scrut) AST.:=: (altconToVHDLExpr con)
366 true_expr = (varToVHDLExpr true)
367 false_expr = (varToVHDLExpr false)
369 return [mkCondAssign (Left bndr) cond_expr true_expr false_expr]
370 mkConcSm (_, (Case (Var _) _ _ alts)) = error "VHDL.mkConcSm Not in normal form: Case statement with more than two alternatives"
371 mkConcSm (_, Case _ _ _ _) = error "VHDL.mkConcSm Not in normal form: Case statement has does not have a simple variable as scrutinee"
372 mkConcSm (bndr, expr) = error $ "VHDL.mkConcSM Unsupported binding in let expression: " ++ pprString bndr ++ " = " ++ pprString expr
374 -- Finds the field labels for VHDL type generated for the given Core type,
375 -- which must result in a record type.
376 getFieldLabels :: Type.Type -> VHDLState [AST.VHDLId]
377 getFieldLabels ty = do
378 -- Ensure that the type is generated (but throw away it's VHDLId)
380 -- Get the types map, lookup and unpack the VHDL TypeDef
381 types <- getA vsTypes
382 case Map.lookup (OrdType ty) types of
383 Just (_, Left (AST.TDR (AST.RecordTypeDef elems))) -> return $ map (\(AST.ElementDec id _) -> id) elems
384 _ -> error $ "VHDL.getFieldLabels Type not found or not a record type? This should not happen! Type: " ++ (show ty)
387 mkConcSm sigs (UncondDef src dst) _ = do
388 src_expr <- vhdl_expr src
389 let src_wform = AST.Wform [AST.WformElem src_expr Nothing]
390 let dst_name = AST.NSimple (getSignalId $ signalInfo sigs dst)
391 let assign = dst_name AST.:<==: (AST.ConWforms [] src_wform Nothing)
392 return $ AST.CSSASm assign
394 vhdl_expr (Left id) = return $ mkIdExpr sigs id
395 vhdl_expr (Right expr) =
398 return $ (mkIdExpr sigs id) AST.:=: (AST.PrimLit lit)
399 (Literal lit Nothing) ->
400 return $ AST.PrimLit lit
401 (Literal lit (Just ty)) -> do
402 -- Create a cast expression, which is just a function call using the
403 -- type name as the function name.
404 let litexpr = AST.PrimLit lit
406 let ty_name = AST.NSimple ty_id
407 let args = [Nothing AST.:=>: (AST.ADExpr litexpr)]
408 return $ AST.PrimFCall $ AST.FCall ty_name args
410 return $ (mkIdExpr sigs a) AST.:=: (mkIdExpr sigs b)
412 mkConcSm sigs (CondDef cond true false dst) _ =
414 cond_expr = mkIdExpr sigs cond
415 true_expr = mkIdExpr sigs true
416 false_expr = mkIdExpr sigs false
417 false_wform = AST.Wform [AST.WformElem false_expr Nothing]
418 true_wform = AST.Wform [AST.WformElem true_expr Nothing]
419 whenelse = AST.WhenElse true_wform cond_expr
420 dst_name = AST.NSimple (getSignalId $ signalInfo sigs dst)
421 assign = dst_name AST.:<==: (AST.ConWforms [whenelse] false_wform Nothing)
423 return $ AST.CSSASm assign
425 | Turn a SignalId into a VHDL Expr
426 mkIdExpr :: [(SignalId, SignalInfo)] -> SignalId -> AST.Expr
428 let src_name = AST.NSimple (getSignalId $ signalInfo sigs id) in
429 AST.PrimName src_name
431 -- | Look up a signal in the signal name map
432 lookupSigName :: [(SignalId, SignalInfo)] -> SignalId -> String
433 lookupSigName sigs sig = name
435 info = Maybe.fromMaybe
436 (error $ "Unknown signal " ++ (show sig) ++ " used? This should not happen!")
438 name = Maybe.fromMaybe
439 (error $ "Unnamed signal " ++ (show sig) ++ " used? This should not happen!")
443 -- Translate a Haskell type to a VHDL type
444 vhdl_ty :: Type.Type -> VHDLState AST.TypeMark
446 typemap <- getA vsTypes
447 let builtin_ty = do -- See if this is a tycon and lookup its name
448 (tycon, args) <- Type.splitTyConApp_maybe ty
449 let name = Name.getOccString (TyCon.tyConName tycon)
450 Map.lookup name builtin_types
451 -- If not a builtin type, try the custom types
452 let existing_ty = (fmap fst) $ Map.lookup (OrdType ty) typemap
453 case Monoid.getFirst $ Monoid.mconcat (map Monoid.First [builtin_ty, existing_ty]) of
454 -- Found a type, return it
456 -- No type yet, try to construct it
458 newty_maybe <- (construct_vhdl_ty ty)
460 Just (ty_id, ty_def) -> do
461 -- TODO: Check name uniqueness
462 modA vsTypes (Map.insert (OrdType ty) (ty_id, ty_def))
464 Nothing -> error $ "Unsupported Haskell type: " ++ (showSDoc $ ppr ty)
466 -- Construct a new VHDL type for the given Haskell type.
467 construct_vhdl_ty :: Type.Type -> VHDLState (Maybe (AST.TypeMark, Either AST.TypeDef AST.SubtypeIn))
468 construct_vhdl_ty ty = do
469 case Type.splitTyConApp_maybe ty of
470 Just (tycon, args) -> do
471 let name = Name.getOccString (TyCon.tyConName tycon)
474 res <- mk_vector_ty (tfvec_len ty) (tfvec_elem ty)
475 return $ Just $ (Arrow.second Right) res
477 -- res <- mk_vector_ty (sized_word_len ty) ty
478 -- return $ Just $ (Arrow.second Left) res
480 res <- mk_natural_ty 0 (ranged_word_bound ty)
481 return $ Just $ (Arrow.second Right) res
482 -- Create a custom type from this tycon
483 otherwise -> mk_tycon_ty tycon args
484 Nothing -> return $ Nothing
486 -- | Create VHDL type for a custom tycon
487 mk_tycon_ty :: TyCon.TyCon -> [Type.Type] -> VHDLState (Maybe (AST.TypeMark, Either AST.TypeDef AST.SubtypeIn))
488 mk_tycon_ty tycon args =
489 case TyCon.tyConDataCons tycon of
490 -- Not an algebraic type
491 [] -> error $ "Only custom algebraic types are supported: " ++ (showSDoc $ ppr tycon)
493 let arg_tys = DataCon.dataConRepArgTys dc
494 -- TODO: CoreSubst docs say each Subs can be applied only once. Is this a
495 -- violation? Or does it only mean not to apply it again to the same
497 let real_arg_tys = map (CoreSubst.substTy subst) arg_tys
498 elem_tys <- mapM vhdl_ty real_arg_tys
499 let elems = zipWith AST.ElementDec recordlabels elem_tys
500 -- For a single construct datatype, build a record with one field for
502 -- TODO: Add argument type ids to this, to ensure uniqueness
503 -- TODO: Special handling for tuples?
504 let ty_id = mkVHDLExtId $ nameToString (TyCon.tyConName tycon)
505 let ty_def = AST.TDR $ AST.RecordTypeDef elems
506 return $ Just (ty_id, Left ty_def)
507 dcs -> error $ "Only single constructor datatypes supported: " ++ (showSDoc $ ppr tycon)
509 -- Create a subst that instantiates all types passed to the tycon
510 -- TODO: I'm not 100% sure that this is the right way to do this. It seems
511 -- to work so far, though..
512 tyvars = TyCon.tyConTyVars tycon
513 subst = CoreSubst.extendTvSubstList CoreSubst.emptySubst (zip tyvars args)
515 -- | Create a VHDL vector type
517 Int -- ^ The length of the vector
518 -> Type.Type -- ^ The Haskell element type of the Vector
519 -> VHDLState (AST.TypeMark, AST.SubtypeIn) -- The typemark created.
521 mk_vector_ty len el_ty = do
522 elem_types_map <- getA vsElemTypes
523 el_ty_tm <- vhdl_ty el_ty
524 let ty_id = mkVHDLExtId $ "vector-"++ (AST.fromVHDLId el_ty_tm) ++ "-0_to_" ++ (show len)
525 let range = AST.ConstraintIndex $ AST.IndexConstraint [AST.ToRange (AST.PrimLit "0") (AST.PrimLit $ show (len - 1))]
526 let existing_elem_ty = (fmap fst) $ Map.lookup (OrdType el_ty) elem_types_map
527 case existing_elem_ty of
529 let ty_def = AST.SubtypeIn t (Just range)
530 return (ty_id, ty_def)
532 let vec_id = mkVHDLExtId $ "vector_" ++ (AST.fromVHDLId el_ty_tm)
533 let vec_def = AST.TDA $ AST.UnconsArrayDef [tfvec_indexTM] el_ty_tm
534 modA vsElemTypes (Map.insert (OrdType el_ty) (vec_id, vec_def))
535 modA vsTypeFuns (Map.insert (OrdType el_ty) (genUnconsVectorFuns el_ty_tm vec_id))
536 let ty_def = AST.SubtypeIn vec_id (Just range)
537 return (ty_id, ty_def)
540 Int -- ^ The minimum bound (> 0)
541 -> Int -- ^ The maximum bound (> minimum bound)
542 -> VHDLState (AST.TypeMark, AST.SubtypeIn) -- The typemark created.
543 mk_natural_ty min_bound max_bound = do
544 let ty_id = mkVHDLExtId $ "nat_" ++ (show min_bound) ++ "_to_" ++ (show max_bound)
545 let range = AST.ConstraintRange $ AST.SubTypeRange (AST.PrimLit $ (show min_bound)) (AST.PrimLit $ (show max_bound))
546 let ty_def = AST.SubtypeIn naturalTM (Just range)
547 return (ty_id, ty_def)