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"]
68 type_package_dec = AST.LUPackageDec $ AST.PackageDec (mkVHDLBasicId "types") ([tfvec_index_decl] ++ vec_decls ++ ty_decls ++ subProgSpecs)
69 type_package_body = AST.LUPackageBody $ AST.PackageBody typesId (concat tyfun_decls)
70 subProgSpecs = concat (map subProgSpec tyfun_decls)
71 subProgSpec = map (\(AST.SubProgBody spec _ _) -> AST.PDISS spec)
72 mktydecl :: (AST.VHDLId, Either AST.TypeDef AST.SubtypeIn) -> AST.PackageDecItem
73 mktydecl (ty_id, Left ty_def) = AST.PDITD $ AST.TypeDec ty_id ty_def
74 mktydecl (ty_id, Right ty_def) = AST.PDISD $ AST.SubtypeDec ty_id ty_def
76 -- Create a use foo.bar.all statement. Takes a list of components in the used
77 -- name. Must contain at least two components
78 mkUseAll :: [String] -> AST.ContextItem
80 AST.Use $ from AST.:.: AST.All
82 base_prefix = (AST.NSimple $ mkVHDLBasicId $ head ss)
83 from = foldl select base_prefix (tail ss)
84 select prefix s = AST.NSelected $ prefix AST.:.: (AST.SSimple $ mkVHDLBasicId s)
87 [(CoreSyn.CoreBndr, CoreSyn.CoreExpr)]
88 -> VHDLState [(AST.VHDLId, [AST.LibraryUnit])]
90 createLibraryUnits binds = do
91 entities <- Monad.mapM createEntity binds
92 archs <- Monad.mapM createArchitecture binds
95 let AST.EntityDec id _ = ent in
96 (id, [AST.LUEntity ent, AST.LUArch arch])
100 -- | Create an entity for a given function
102 (CoreSyn.CoreBndr, CoreSyn.CoreExpr) -- | The function
103 -> VHDLState AST.EntityDec -- | The resulting entity
105 createEntity (fname, expr) = do
106 -- Strip off lambda's, these will be arguments
107 let (args, letexpr) = CoreSyn.collectBinders expr
108 args' <- Monad.mapM mkMap args
109 -- There must be a let at top level
110 let (CoreSyn.Let binds (CoreSyn.Var res)) = letexpr
112 let vhdl_id = mkVHDLBasicId $ bndrToString fname ++ "_" ++ varToStringUniq fname
113 let ent_decl' = createEntityAST vhdl_id args' res'
114 let AST.EntityDec entity_id _ = ent_decl'
115 let signature = Entity entity_id args' res'
116 modA vsSignatures (Map.insert fname signature)
120 --[(SignalId, SignalInfo)]
122 -> VHDLState VHDLSignalMapElement
123 -- We only need the vsTypes element from the state
126 --info = Maybe.fromMaybe
127 -- (error $ "Signal not found in the name map? This should not happen!")
128 -- (lookup id sigmap)
129 -- Assume the bndr has a valid VHDL id already
130 id = bndrToVHDLId bndr
131 ty = Var.varType bndr
133 if True -- isPortSigUse $ sigUse info
135 type_mark <- vhdl_ty ty
136 return $ Just (id, type_mark)
141 -- | Create the VHDL AST for an entity
143 AST.VHDLId -- | The name of the function
144 -> [VHDLSignalMapElement] -- | The entity's arguments
145 -> VHDLSignalMapElement -- | The entity's result
146 -> AST.EntityDec -- | The entity with the ent_decl filled in as well
148 createEntityAST vhdl_id args res =
149 AST.EntityDec vhdl_id ports
151 -- Create a basic Id, since VHDL doesn't grok filenames with extended Ids.
152 ports = Maybe.catMaybes $
153 map (mkIfaceSigDec AST.In) args
154 ++ [mkIfaceSigDec AST.Out res]
156 -- Add a clk port if we have state
157 clk_port = if True -- hasState hsfunc
159 Just $ AST.IfaceSigDec (mkVHDLExtId "clk") AST.In std_logic_ty
163 -- | Create a port declaration
165 AST.Mode -- | The mode for the port (In / Out)
166 -> Maybe (AST.VHDLId, AST.TypeMark) -- | The id and type for the port
167 -> Maybe AST.IfaceSigDec -- | The resulting port declaration
169 mkIfaceSigDec mode (Just (id, ty)) = Just $ AST.IfaceSigDec id mode ty
170 mkIfaceSigDec _ Nothing = Nothing
173 -- | Generate a VHDL entity name for the given hsfunc
175 -- TODO: This doesn't work for functions with multiple signatures!
176 -- Use a Basic Id, since using extended id's for entities throws off
177 -- precision and causes problems when generating filenames.
178 mkVHDLBasicId $ hsFuncName hsfunc
181 -- | Create an architecture for a given function
182 createArchitecture ::
183 (CoreSyn.CoreBndr, CoreSyn.CoreExpr) -- ^ The function
184 -> VHDLState AST.ArchBody -- ^ The architecture for this function
186 createArchitecture (fname, expr) = do
187 signaturemap <- getA vsSignatures
188 let signature = Maybe.fromMaybe
189 (error $ "Generating architecture for function " ++ (pprString fname) ++ "without signature? This should not happen!")
190 (Map.lookup fname signaturemap)
191 let entity_id = ent_id signature
192 -- Strip off lambda's, these will be arguments
193 let (args, letexpr) = CoreSyn.collectBinders expr
194 -- There must be a let at top level
195 let (CoreSyn.Let (CoreSyn.Rec binds) (Var res)) = letexpr
197 -- Create signal declarations for all binders in the let expression, except
198 -- for the output port (that will already have an output port declared in
200 sig_dec_maybes <- mapM (mkSigDec' . fst) (filter ((/=res).fst) binds)
201 let sig_decs = Maybe.catMaybes $ sig_dec_maybes
203 statementss <- Monad.mapM mkConcSm binds
204 let statements = concat statementss
205 return $ AST.ArchBody (mkVHDLBasicId "structural") (AST.NSimple entity_id) (map AST.BDISD sig_decs) (statements ++ procs')
207 procs = [] --map mkStateProcSm [] -- (makeStatePairs flatfunc)
208 procs' = map AST.CSPSm procs
209 -- mkSigDec only uses vsTypes from the state
213 -- | Looks up all pairs of old state, new state signals, together with
214 -- the state id they represent.
215 makeStatePairs :: FlatFunction -> [(StateId, SignalInfo, SignalInfo)]
216 makeStatePairs flatfunc =
217 [(Maybe.fromJust $ oldStateId $ sigUse old_info, old_info, new_info)
218 | old_info <- map snd (flat_sigs flatfunc)
219 , new_info <- map snd (flat_sigs flatfunc)
220 -- old_info must be an old state (and, because of the next equality,
221 -- new_info must be a new state).
222 , Maybe.isJust $ oldStateId $ sigUse old_info
223 -- And the state numbers must match
224 , (oldStateId $ sigUse old_info) == (newStateId $ sigUse new_info)]
226 -- Replace the second tuple element with the corresponding SignalInfo
227 --args_states = map (Arrow.second $ signalInfo sigs) args
228 mkStateProcSm :: (StateId, SignalInfo, SignalInfo) -> AST.ProcSm
229 mkStateProcSm (num, old, new) =
230 AST.ProcSm label [clk] [statement]
232 label = mkVHDLExtId $ "state_" ++ (show num)
233 clk = mkVHDLExtId "clk"
234 rising_edge = AST.NSimple $ mkVHDLBasicId "rising_edge"
235 wform = AST.Wform [AST.WformElem (AST.PrimName $ AST.NSimple $ getSignalId new) Nothing]
236 assign = AST.SigAssign (AST.NSimple $ getSignalId old) wform
237 rising_edge_clk = AST.PrimFCall $ AST.FCall rising_edge [Nothing AST.:=>: (AST.ADName $ AST.NSimple clk)]
238 statement = AST.IfSm rising_edge_clk [assign] [] Nothing
240 -- | Creates a VHDL Id from a named SignalInfo. Errors out if the SignalInfo
242 getSignalId :: SignalInfo -> AST.VHDLId
244 mkVHDLExtId $ Maybe.fromMaybe
245 (error $ "Unnamed signal? This should not happen!")
249 mkSigDec :: CoreSyn.CoreBndr -> VHDLState (Maybe AST.SigDec)
251 if True then do --isInternalSigUse use || isStateSigUse use then do
252 type_mark <- vhdl_ty $ Var.varType bndr
253 return $ Just (AST.SigDec (bndrToVHDLId bndr) type_mark Nothing)
257 -- | Transforms a core binding into a VHDL concurrent statement
259 (CoreSyn.CoreBndr, CoreSyn.CoreExpr) -- ^ The binding to process
260 -> VHDLState [AST.ConcSm] -- ^ The corresponding VHDL component instantiations.
263 -- Ignore Cast expressions, they should not longer have any meaning as long as
264 -- the type works out.
265 mkConcSm (bndr, Cast expr ty) = mkConcSm (bndr, expr)
267 -- For simple a = b assignments, just generate an unconditional signal
268 -- assignment. This should only happen for dataconstructors without arguments.
269 -- TODO: Integrate this with the below code for application (essentially this
270 -- is an application without arguments)
271 mkConcSm (bndr, Var v) = return $ [mkUncondAssign (Left bndr) (varToVHDLExpr v)]
273 mkConcSm (bndr, app@(CoreSyn.App _ _))= do
274 let (CoreSyn.Var f, args) = CoreSyn.collectArgs app
275 let valargs' = filter isValArg args
276 let valargs = filter (\(CoreSyn.Var bndr) -> not (Id.isDictId bndr)) valargs'
277 case Var.globalIdVarDetails f of
278 IdInfo.DataConWorkId dc ->
279 -- It's a datacon. Create a record from its arguments.
280 -- First, filter out type args. TODO: Is this the best way to do this?
281 -- The types should already have been taken into acocunt when creating
282 -- the signal, so this should probably work...
283 --let valargs = filter isValArg args in
284 if all is_var valargs then do
285 labels <- getFieldLabels (CoreUtils.exprType app)
286 return $ zipWith mkassign labels valargs
288 error $ "VHDL.mkConcSm Not in normal form: One ore more complex arguments: " ++ pprString args
290 mkassign :: AST.VHDLId -> CoreExpr -> AST.ConcSm
291 mkassign label (Var arg) =
292 let sel_name = mkSelectedName bndr label in
293 mkUncondAssign (Right sel_name) (varToVHDLExpr arg)
294 IdInfo.VanillaGlobal -> do
295 -- It's a global value imported from elsewhere. These can be builtin
297 funSignatures <- getA vsNameTable
298 signatures <- getA vsSignatures
299 case (Map.lookup (bndrToString f) funSignatures) of
300 Just (arg_count, builder) ->
301 if length valargs == arg_count then
305 sigs = map (varToVHDLExpr.varBndr) valargs
306 func = funBuilder sigs
307 src_wform = AST.Wform [AST.WformElem func Nothing]
308 dst_name = AST.NSimple (mkVHDLExtId (bndrToString bndr))
309 assign = dst_name AST.:<==: (AST.ConWforms [] src_wform Nothing)
311 return [AST.CSSASm assign]
314 sigs = map varBndr valargs
315 signature = Maybe.fromMaybe
316 (error $ "Using function '" ++ (bndrToString (head sigs)) ++ "' without signature? This should not happen!")
317 (Map.lookup (head sigs) signatures)
319 genSm = genBuilder signature (arg ++ [bndr])
320 in return [AST.CSGSm genSm]
322 error $ "VHDL.mkConcSm Incorrect number of arguments to builtin function: " ++ pprString f ++ " Args: " ++ pprString valargs
323 Nothing -> error $ "Using function from another module that is not a known builtin: " ++ pprString f
324 IdInfo.NotGlobalId -> do
325 signatures <- getA vsSignatures
326 -- This is a local id, so it should be a function whose definition we
327 -- have and which can be turned into a component instantiation.
329 signature = Maybe.fromMaybe
330 (error $ "Using function '" ++ (bndrToString f) ++ "' without signature? This should not happen!")
331 (Map.lookup f signatures)
332 entity_id = ent_id signature
333 label = "comp_ins_" ++ bndrToString bndr
334 -- Add a clk port if we have state
335 --clk_port = Maybe.fromJust $ mkAssocElem (Just $ mkVHDLExtId "clk") "clk"
336 clk_port = Maybe.fromJust $ mkAssocElem (Just $ mkVHDLExtId "clk") "clk"
337 --portmaps = mkAssocElems sigs args res signature ++ (if hasState hsfunc then [clk_port] else [])
338 portmaps = clk_port : mkAssocElems args bndr signature
340 return [genComponentInst label entity_id portmaps]
341 details -> error $ "Calling unsupported function " ++ pprString f ++ " with GlobalIdDetails " ++ pprString details
343 -- A single alt case must be a selector. This means thee scrutinee is a simple
344 -- variable, the alternative is a dataalt with a single non-wild binder that
346 mkConcSm (bndr, expr@(Case (Var scrut) b ty [alt])) =
348 (DataAlt dc, bndrs, (Var sel_bndr)) -> do
349 case List.elemIndex sel_bndr bndrs of
351 labels <- getFieldLabels (Id.idType scrut)
352 let label = labels!!i
353 let sel_name = mkSelectedName scrut label
354 let sel_expr = AST.PrimName sel_name
355 return [mkUncondAssign (Left bndr) sel_expr]
356 Nothing -> error $ "VHDL.mkConcSM Not in normal form: Not a selector case:\n" ++ (pprString expr)
358 _ -> error $ "VHDL.mkConcSM Not in normal form: Not a selector case:\n" ++ (pprString expr)
360 -- Multiple case alt are be conditional assignments and have only wild
361 -- binders in the alts and only variables in the case values and a variable
362 -- for a scrutinee. We check the constructor of the second alt, since the
363 -- first is the default case, if there is any.
364 mkConcSm (bndr, (Case (Var scrut) b ty [(_, _, Var false), (con, _, Var true)])) =
366 cond_expr = (varToVHDLExpr scrut) AST.:=: (altconToVHDLExpr con)
367 true_expr = (varToVHDLExpr true)
368 false_expr = (varToVHDLExpr false)
370 return [mkCondAssign (Left bndr) cond_expr true_expr false_expr]
371 mkConcSm (_, (Case (Var _) _ _ alts)) = error "VHDL.mkConcSm Not in normal form: Case statement with more than two alternatives"
372 mkConcSm (_, Case _ _ _ _) = error "VHDL.mkConcSm Not in normal form: Case statement has does not have a simple variable as scrutinee"
373 mkConcSm (bndr, expr) = error $ "VHDL.mkConcSM Unsupported binding in let expression: " ++ pprString bndr ++ " = " ++ pprString expr
375 -- Finds the field labels for VHDL type generated for the given Core type,
376 -- which must result in a record type.
377 getFieldLabels :: Type.Type -> VHDLState [AST.VHDLId]
378 getFieldLabels ty = do
379 -- Ensure that the type is generated (but throw away it's VHDLId)
381 -- Get the types map, lookup and unpack the VHDL TypeDef
382 types <- getA vsTypes
383 case Map.lookup (OrdType ty) types of
384 Just (_, Left (AST.TDR (AST.RecordTypeDef elems))) -> return $ map (\(AST.ElementDec id _) -> id) elems
385 _ -> error $ "VHDL.getFieldLabels Type not found or not a record type? This should not happen! Type: " ++ (show ty)
388 mkConcSm sigs (UncondDef src dst) _ = do
389 src_expr <- vhdl_expr src
390 let src_wform = AST.Wform [AST.WformElem src_expr Nothing]
391 let dst_name = AST.NSimple (getSignalId $ signalInfo sigs dst)
392 let assign = dst_name AST.:<==: (AST.ConWforms [] src_wform Nothing)
393 return $ AST.CSSASm assign
395 vhdl_expr (Left id) = return $ mkIdExpr sigs id
396 vhdl_expr (Right expr) =
399 return $ (mkIdExpr sigs id) AST.:=: (AST.PrimLit lit)
400 (Literal lit Nothing) ->
401 return $ AST.PrimLit lit
402 (Literal lit (Just ty)) -> do
403 -- Create a cast expression, which is just a function call using the
404 -- type name as the function name.
405 let litexpr = AST.PrimLit lit
407 let ty_name = AST.NSimple ty_id
408 let args = [Nothing AST.:=>: (AST.ADExpr litexpr)]
409 return $ AST.PrimFCall $ AST.FCall ty_name args
411 return $ (mkIdExpr sigs a) AST.:=: (mkIdExpr sigs b)
413 mkConcSm sigs (CondDef cond true false dst) _ =
415 cond_expr = mkIdExpr sigs cond
416 true_expr = mkIdExpr sigs true
417 false_expr = mkIdExpr sigs false
418 false_wform = AST.Wform [AST.WformElem false_expr Nothing]
419 true_wform = AST.Wform [AST.WformElem true_expr Nothing]
420 whenelse = AST.WhenElse true_wform cond_expr
421 dst_name = AST.NSimple (getSignalId $ signalInfo sigs dst)
422 assign = dst_name AST.:<==: (AST.ConWforms [whenelse] false_wform Nothing)
424 return $ AST.CSSASm assign
426 | Turn a SignalId into a VHDL Expr
427 mkIdExpr :: [(SignalId, SignalInfo)] -> SignalId -> AST.Expr
429 let src_name = AST.NSimple (getSignalId $ signalInfo sigs id) in
430 AST.PrimName src_name
432 -- | Look up a signal in the signal name map
433 lookupSigName :: [(SignalId, SignalInfo)] -> SignalId -> String
434 lookupSigName sigs sig = name
436 info = Maybe.fromMaybe
437 (error $ "Unknown signal " ++ (show sig) ++ " used? This should not happen!")
439 name = Maybe.fromMaybe
440 (error $ "Unnamed signal " ++ (show sig) ++ " used? This should not happen!")
444 -- Translate a Haskell type to a VHDL type
445 vhdl_ty :: Type.Type -> VHDLState AST.TypeMark
447 typemap <- getA vsTypes
448 let builtin_ty = do -- See if this is a tycon and lookup its name
449 (tycon, args) <- Type.splitTyConApp_maybe ty
450 let name = Name.getOccString (TyCon.tyConName tycon)
451 Map.lookup name builtin_types
452 -- If not a builtin type, try the custom types
453 let existing_ty = (fmap fst) $ Map.lookup (OrdType ty) typemap
454 case Monoid.getFirst $ Monoid.mconcat (map Monoid.First [builtin_ty, existing_ty]) of
455 -- Found a type, return it
457 -- No type yet, try to construct it
459 newty_maybe <- (construct_vhdl_ty ty)
461 Just (ty_id, ty_def) -> do
462 -- TODO: Check name uniqueness
463 modA vsTypes (Map.insert (OrdType ty) (ty_id, ty_def))
465 Nothing -> error $ "Unsupported Haskell type: " ++ (showSDoc $ ppr ty)
467 -- Construct a new VHDL type for the given Haskell type.
468 construct_vhdl_ty :: Type.Type -> VHDLState (Maybe (AST.TypeMark, Either AST.TypeDef AST.SubtypeIn))
469 construct_vhdl_ty ty = do
470 case Type.splitTyConApp_maybe ty of
471 Just (tycon, args) -> do
472 let name = Name.getOccString (TyCon.tyConName tycon)
475 res <- mk_vector_ty (tfvec_len ty) (tfvec_elem ty)
476 return $ Just $ (Arrow.second Right) res
478 -- res <- mk_vector_ty (sized_word_len ty) ty
479 -- return $ Just $ (Arrow.second Left) res
481 res <- mk_natural_ty 0 (ranged_word_bound ty)
482 return $ Just $ (Arrow.second Right) res
483 -- Create a custom type from this tycon
484 otherwise -> mk_tycon_ty tycon args
485 Nothing -> return $ Nothing
487 -- | Create VHDL type for a custom tycon
488 mk_tycon_ty :: TyCon.TyCon -> [Type.Type] -> VHDLState (Maybe (AST.TypeMark, Either AST.TypeDef AST.SubtypeIn))
489 mk_tycon_ty tycon args =
490 case TyCon.tyConDataCons tycon of
491 -- Not an algebraic type
492 [] -> error $ "Only custom algebraic types are supported: " ++ (showSDoc $ ppr tycon)
494 let arg_tys = DataCon.dataConRepArgTys dc
495 -- TODO: CoreSubst docs say each Subs can be applied only once. Is this a
496 -- violation? Or does it only mean not to apply it again to the same
498 let real_arg_tys = map (CoreSubst.substTy subst) arg_tys
499 elem_tys <- mapM vhdl_ty real_arg_tys
500 let elems = zipWith AST.ElementDec recordlabels elem_tys
501 -- For a single construct datatype, build a record with one field for
503 -- TODO: Add argument type ids to this, to ensure uniqueness
504 -- TODO: Special handling for tuples?
505 let ty_id = mkVHDLExtId $ nameToString (TyCon.tyConName tycon)
506 let ty_def = AST.TDR $ AST.RecordTypeDef elems
507 return $ Just (ty_id, Left ty_def)
508 dcs -> error $ "Only single constructor datatypes supported: " ++ (showSDoc $ ppr tycon)
510 -- Create a subst that instantiates all types passed to the tycon
511 -- TODO: I'm not 100% sure that this is the right way to do this. It seems
512 -- to work so far, though..
513 tyvars = TyCon.tyConTyVars tycon
514 subst = CoreSubst.extendTvSubstList CoreSubst.emptySubst (zip tyvars args)
516 -- | Create a VHDL vector type
518 Int -- ^ The length of the vector
519 -> Type.Type -- ^ The Haskell element type of the Vector
520 -> VHDLState (AST.TypeMark, AST.SubtypeIn) -- The typemark created.
522 mk_vector_ty len el_ty = do
523 elem_types_map <- getA vsElemTypes
524 el_ty_tm <- vhdl_ty el_ty
525 let ty_id = mkVHDLExtId $ "vector-"++ (AST.fromVHDLId el_ty_tm) ++ "-0_to_" ++ (show len)
526 let range = AST.ConstraintIndex $ AST.IndexConstraint [AST.ToRange (AST.PrimLit "0") (AST.PrimLit $ show (len - 1))]
527 let existing_elem_ty = (fmap fst) $ Map.lookup (OrdType el_ty) elem_types_map
528 case existing_elem_ty of
530 let ty_def = AST.SubtypeIn t (Just range)
531 return (ty_id, ty_def)
533 let vec_id = mkVHDLExtId $ "vector_" ++ (AST.fromVHDLId el_ty_tm)
534 let vec_def = AST.TDA $ AST.UnconsArrayDef [tfvec_indexTM] el_ty_tm
535 modA vsElemTypes (Map.insert (OrdType el_ty) (vec_id, vec_def))
536 modA vsTypeFuns (Map.insert (OrdType el_ty) (genUnconsVectorFuns el_ty_tm vec_id))
537 let ty_def = AST.SubtypeIn vec_id (Just range)
538 return (ty_id, ty_def)
541 Int -- ^ The minimum bound (> 0)
542 -> Int -- ^ The maximum bound (> minimum bound)
543 -> VHDLState (AST.TypeMark, AST.SubtypeIn) -- The typemark created.
544 mk_natural_ty min_bound max_bound = do
545 let ty_id = mkVHDLExtId $ "nat_" ++ (show min_bound) ++ "_to_" ++ (show max_bound)
546 let range = AST.ConstraintRange $ AST.SubTypeRange (AST.PrimLit $ (show min_bound)) (AST.PrimLit $ (show max_bound))
547 let ty_def = AST.SubtypeIn naturalTM (Just range)
548 return (ty_id, ty_def)