import Language.Haskell.Syntax
import Types
import Data.Param.TFVec
+import Data.RangedWord
mainIO f = Sim.simulateIO (Sim.stateless f) ()
in
\c d -> op' d c
-functiontest :: TFVec D4 Bit -> Bit
-functiontest = \v -> let r = head v in r
+functiontest :: TFVec D4 Bit -> RangedWord D3 -> Bit
+functiontest = \v i -> let r = v!i in r
highordtest2 = \a b ->
case a of
where
(tycon, args) = Type.splitTyConApp ty
[len] = args
+
+-- | Get the upperbound of a RangedWord type
+ranged_word_bound :: Type.Type -> Int
+ranged_word_bound ty =
+ eval_tfp_int len
+ where
+ (tycon, args) = Type.splitTyConApp ty
+ [len] = args
-- | Evaluate a core Type representing type level int from the TypeLevel
-- library to a real int.
genUnconsVectorFuns elemTM vectorTM =
[ AST.SubProgBody exSpec [] [exExpr]
, AST.SubProgBody replaceSpec [AST.SPVD replaceVar] [replaceExpr,replaceRet]
- , AST.SubProgBody headSpec [] [headExpr]
- , AST.SubProgBody lastSpec [] [lastExpr]
- , AST.SubProgBody initSpec [AST.SPVD initVar] [initExpr, initRet]
- , AST.SubProgBody tailSpec [AST.SPVD tailVar] [tailExpr, tailRet]
- , AST.SubProgBody takeSpec [AST.SPVD takeVar] [takeExpr, takeRet]
- , AST.SubProgBody dropSpec [AST.SPVD dropVar] [dropExpr, dropRet]
+ , AST.SubProgBody headSpec [] [headExpr]
+ , AST.SubProgBody lastSpec [] [lastExpr]
+ , AST.SubProgBody initSpec [AST.SPVD initVar] [initExpr, initRet]
+ , AST.SubProgBody tailSpec [AST.SPVD tailVar] [tailExpr, tailRet]
+ , AST.SubProgBody takeSpec [AST.SPVD takeVar] [takeExpr, takeRet]
+ , AST.SubProgBody dropSpec [AST.SPVD dropVar] [dropExpr, dropRet]
]
where
ixPar = AST.unsafeVHDLBasicId "ix"
globalNameTable :: NameTable
globalNameTable = mkGlobalNameTable
- [ (show ('(V.!)) , (2, genExprFCall2L exId ) )
- , ("head" , (1, genExprFCall1L headId ) )
+ [ ("!" , (2, genExprFCall2L exId ) )
+ , ("head" , (1, genExprFCall1L headId ) )
]
\ No newline at end of file
-> [(AST.VHDLId, AST.DesignFile)]
createDesignFiles binds =
- (mkVHDLBasicId "types", AST.DesignFile ieee_context [type_package]) :
+ (mkVHDLBasicId "types", AST.DesignFile ieee_context [type_package_dec, type_package_body]) :
map (Arrow.second $ AST.DesignFile full_context) units
where
- init_session = VHDLSession Map.empty Map.empty builtin_funcs globalNameTable
+ init_session = VHDLSession Map.empty Map.empty Map.empty builtin_funcs globalNameTable
(units, final_session) =
State.runState (createLibraryUnits binds) init_session
ty_decls = Map.elems (final_session ^. vsTypes)
+ subty_decls = Map.elems (final_session ^. vsSubTypes)
+ tyfun_decls = Map.elems (final_session ^.vsTypeFuns)
ieee_context = [
AST.Library $ mkVHDLBasicId "IEEE",
mkUseAll ["IEEE", "std_logic_1164"],
full_context =
mkUseAll ["work", "types"]
: ieee_context
- type_package = AST.LUPackageDec $ AST.PackageDec (mkVHDLBasicId "types") (map (AST.PDITD . snd) ty_decls)
+ type_package_dec = AST.LUPackageDec $ AST.PackageDec (mkVHDLBasicId "types") (packageTypeDecs ++ packageSubtypeDecs ++ subProgSpecs)
+ type_package_body = AST.LUPackageBody $ AST.PackageBody typesId (concat tyfun_decls)
+ packageTypeDecs = map (AST.PDITD . snd) ty_decls
+ packageSubtypeDecs = map (AST.PDISD . snd) subty_decls
+ subProgSpecs = concat (map subProgSpec tyfun_decls)
+ subProgSpec = map (\(AST.SubProgBody spec _ _) -> AST.PDISS spec)
-- Create a use foo.bar.all statement. Takes a list of components in the used
-- name. Must contain at least two components
case name of
"TFVec" -> Just $ mk_vector_ty (tfvec_len ty) ty
"SizedWord" -> Just $ mk_vector_ty (sized_word_len ty) ty
+ "RangedWord" -> Just $ mk_natural_ty 0 (ranged_word_bound ty) ty
otherwise -> Nothing
-- Return new_ty when a new type was successfully created
Maybe.fromMaybe
modA vsTypeFuns (Map.insert (OrdType ty) (genUnconsVectorFuns std_logic_ty ty_id))
return ty_id
+mk_natural_ty ::
+ Int -- ^ The minimum bound (> 0)
+ -> Int -- ^ The maximum bound (> minimum bound)
+ -> Type.Type -- ^ The Haskell type to create a VHDL type for
+ -> VHDLState AST.TypeMark -- The typemark created.
+mk_natural_ty min_bound max_bound ty = do
+ let ty_id = mkVHDLExtId $ "nat_" ++ (show min_bound) ++ "_to_" ++ (show max_bound)
+ let ty_def = AST.SubtypeIn naturalTM (Nothing)
+ let ty_dec = AST.SubtypeDec ty_id ty_def
+ modA vsSubTypes (Map.insert (OrdType ty) (ty_id, ty_dec))
+ return ty_id
+
builtin_types =
Map.fromList [
-- A map of a Core type to the corresponding type name
type TypeMap = Map.Map OrdType (AST.VHDLId, AST.TypeDec)
+-- A map of a Core type to the corresponding VHDL subtype
+type SubTypeMap = Map.Map OrdType (AST.VHDLId, AST.SubtypeDec)
+
-- A map of a vector Core type to the coressponding VHDL functions
type TypeFunMap = Map.Map OrdType [AST.SubProgBody]
data VHDLSession = VHDLSession {
-- | A map of Core type -> VHDL Type
vsTypes_ :: TypeMap,
+ -- | A map of Core type -> VHDL SubType
+ vsSubTypes_ :: SubTypeMap,
-- | A map of vector Core type -> VHDL type function
vsTypeFuns_ :: TypeFunMap,
-- | A map of HsFunction -> hardware signature (entity name, port names,