+-- | Create a VHDL vector type
+mk_vector_ty ::
+ Int -- ^ The length of the vector
+ -> Type.Type -- ^ The Haskell type to create a VHDL type for
+ -> TypeState AST.TypeMark -- The typemark created.
+
+mk_vector_ty len ty = do
+ -- Assume there is a single type argument
+ let ty_id = mkVHDLExtId $ "vector_" ++ (show len)
+ -- TODO: Use el_ty
+ let range = AST.IndexConstraint [AST.ToRange (AST.PrimLit "0") (AST.PrimLit $ show (len - 1))]
+ let ty_def = AST.TDA $ AST.ConsArrayDef range std_logic_ty
+ let ty_dec = AST.TypeDec ty_id ty_def
+ -- TODO: Check name uniqueness
+ State.modify (Map.insert (OrdType ty) (ty_id, ty_dec))
+ return ty_id
+
+
+builtin_types =
+ Map.fromList [
+ ("Bit", std_logic_ty),
+ ("Bool", bool_ty) -- TysWiredIn.boolTy
+ ]
+
+-- Shortcut for
+-- Can only contain alphanumerics and underscores. The supplied string must be
+-- a valid basic id, otherwise an error value is returned. This function is
+-- not meant to be passed identifiers from a source file, use mkVHDLExtId for
+-- that.
+mkVHDLBasicId :: String -> AST.VHDLId
+mkVHDLBasicId s =
+ AST.unsafeVHDLBasicId $ (strip_multiscore . strip_leading . strip_invalid) s
+ where
+ -- Strip invalid characters.
+ strip_invalid = filter (`elem` ['A'..'Z'] ++ ['a'..'z'] ++ ['0'..'9'] ++ "_.")
+ -- Strip leading numbers and underscores
+ strip_leading = dropWhile (`elem` ['0'..'9'] ++ "_")
+ -- Strip multiple adjacent underscores
+ strip_multiscore = concat . map (\cs ->
+ case cs of
+ ('_':_) -> "_"
+ _ -> cs
+ ) . List.group
+
+-- Shortcut for Extended VHDL Id's. These Id's can contain a lot more
+-- different characters than basic ids, but can never be used to refer to
+-- basic ids.
+-- Use extended Ids for any values that are taken from the source file.
+mkVHDLExtId :: String -> AST.VHDLId
+mkVHDLExtId s =
+ AST.unsafeVHDLExtId $ strip_invalid s
+ where
+ -- Allowed characters, taken from ForSyde's mkVHDLExtId
+ allowed = ['A'..'Z'] ++ ['a'..'z'] ++ ['0'..'9'] ++ " \"#&\\'()*+,./:;<=>_|!$%@?[]^`{}~-"
+ strip_invalid = filter (`elem` allowed)
+
+-- Creates a VHDL Id from a binder
+bndrToVHDLId ::
+ CoreSyn.CoreBndr
+ -> AST.VHDLId
+
+bndrToVHDLId = mkVHDLExtId . OccName.occNameString . Name.nameOccName . Var.varName
+
+-- Extracts the binder name as a String
+bndrToString ::
+ CoreSyn.CoreBndr
+ -> String
+
+bndrToString = OccName.occNameString . Name.nameOccName . Var.varName
+
+-- | A consise representation of a (set of) ports on a builtin function
+--type PortMap = HsValueMap (String, AST.TypeMark)
+-- | A consise representation of a builtin function
+data BuiltIn = BuiltIn String [(String, AST.TypeMark)] (String, AST.TypeMark)
+
+-- | Translate a list of concise representation of builtin functions to a
+-- SignatureMap
+mkBuiltins :: [BuiltIn] -> SignatureMap
+mkBuiltins = Map.fromList . map (\(BuiltIn name args res) ->
+ (name,
+ Entity (VHDL.mkVHDLBasicId name) (map toVHDLSignalMapElement args) (toVHDLSignalMapElement res))
+ )
+
+builtin_hsfuncs = Map.keys builtin_funcs
+builtin_funcs = mkBuiltins
+ [
+ BuiltIn "hwxor" [("a", VHDL.bit_ty), ("b", VHDL.bit_ty)] ("o", VHDL.bit_ty),
+ BuiltIn "hwand" [("a", VHDL.bit_ty), ("b", VHDL.bit_ty)] ("o", VHDL.bit_ty),
+ BuiltIn "hwor" [("a", VHDL.bit_ty), ("b", VHDL.bit_ty)] ("o", VHDL.bit_ty),
+ BuiltIn "hwnot" [("a", VHDL.bit_ty)] ("o", VHDL.bit_ty)
+ ]
+
+-- | Map a port specification of a builtin function to a VHDL Signal to put in
+-- a VHDLSignalMap
+toVHDLSignalMapElement :: (String, AST.TypeMark) -> VHDLSignalMapElement
+toVHDLSignalMapElement (name, ty) = Just (mkVHDLBasicId name, ty)