tyfun_decls = Map.elems (final_session ^.vsTypeFuns)
ty_decls = map mktydecl $ Map.elems (final_session ^. vsTypes)
vec_decls = map (\(v_id, v_def) -> AST.PDITD $ AST.TypeDec v_id v_def) (Map.elems (final_session ^. vsElemTypes))
tyfun_decls = Map.elems (final_session ^.vsTypeFuns)
ty_decls = map mktydecl $ Map.elems (final_session ^. vsTypes)
vec_decls = map (\(v_id, v_def) -> AST.PDITD $ AST.TypeDec v_id v_def) (Map.elems (final_session ^. vsElemTypes))
ieee_context = [
AST.Library $ mkVHDLBasicId "IEEE",
mkUseAll ["IEEE", "std_logic_1164"],
ieee_context = [
AST.Library $ mkVHDLBasicId "IEEE",
mkUseAll ["IEEE", "std_logic_1164"],
type_package_body = AST.LUPackageBody $ AST.PackageBody typesId (concat tyfun_decls)
subProgSpecs = concat (map subProgSpec tyfun_decls)
subProgSpec = map (\(AST.SubProgBody spec _ _) -> AST.PDISS spec)
type_package_body = AST.LUPackageBody $ AST.PackageBody typesId (concat tyfun_decls)
subProgSpecs = concat (map subProgSpec tyfun_decls)
subProgSpec = map (\(AST.SubProgBody spec _ _) -> AST.PDISS spec)
-- Strip off lambda's, these will be arguments
let (args, letexpr) = CoreSyn.collectBinders expr
-- There must be a let at top level
-- Strip off lambda's, these will be arguments
let (args, letexpr) = CoreSyn.collectBinders expr
-- There must be a let at top level
- -- Create signal declarations for all internal and state signals
- sig_dec_maybes <- mapM (mkSigDec' . fst) binds
+ -- Create signal declarations for all binders in the let expression, except
+ -- for the output port (that will already have an output port declared in
+ -- the entity).
+ sig_dec_maybes <- mapM (mkSigDec' . fst) (filter ((/=res).fst) binds)
return $ Just $ (Arrow.second Right) res
-- "SizedWord" -> do
-- res <- mk_vector_ty (sized_word_len ty) ty
-- return $ Just $ (Arrow.second Left) res
"RangedWord" -> do
return $ Just $ (Arrow.second Right) res
-- "SizedWord" -> do
-- res <- mk_vector_ty (sized_word_len ty) ty
-- return $ Just $ (Arrow.second Left) res
"RangedWord" -> do
return $ Just $ (Arrow.second Right) res
-- Create a custom type from this tycon
otherwise -> mk_tycon_ty tycon args
return $ Just $ (Arrow.second Right) res
-- Create a custom type from this tycon
otherwise -> mk_tycon_ty tycon args
elem_types_map <- getA vsElemTypes
el_ty_tm <- vhdl_ty el_ty
let ty_id = mkVHDLExtId $ "vector-"++ (AST.fromVHDLId el_ty_tm) ++ "-0_to_" ++ (show len)
elem_types_map <- getA vsElemTypes
el_ty_tm <- vhdl_ty el_ty
let ty_id = mkVHDLExtId $ "vector-"++ (AST.fromVHDLId el_ty_tm) ++ "-0_to_" ++ (show len)
let ty_def = AST.SubtypeIn vec_id (Just range)
return (ty_id, ty_def)
mk_natural_ty ::
Int -- ^ The minimum bound (> 0)
-> Int -- ^ The maximum bound (> minimum bound)
let ty_def = AST.SubtypeIn vec_id (Just range)
return (ty_id, ty_def)
mk_natural_ty ::
Int -- ^ The minimum bound (> 0)
-> Int -- ^ The maximum bound (> minimum bound)
let ty_id = mkVHDLExtId $ "nat_" ++ (show min_bound) ++ "_to_" ++ (show max_bound)
let range = AST.ConstraintRange $ AST.SubTypeRange (AST.PrimLit $ (show min_bound)) (AST.PrimLit $ (show max_bound))
let ty_def = AST.SubtypeIn naturalTM (Just range)
return (ty_id, ty_def)
let ty_id = mkVHDLExtId $ "nat_" ++ (show min_bound) ++ "_to_" ++ (show max_bound)
let range = AST.ConstraintRange $ AST.SubTypeRange (AST.PrimLit $ (show min_bound)) (AST.PrimLit $ (show max_bound))
let ty_def = AST.SubtypeIn naturalTM (Just range)
return (ty_id, ty_def)