module VHDL where
import qualified Data.Foldable as Foldable
+import qualified Data.List as List
import qualified Maybe
import qualified Control.Monad as Monad
import qualified Control.Arrow as Arrow
import TranslatorTypes
import Pretty
-getDesignFiles :: VHDLState [AST.DesignFile]
-getDesignFiles = do
- -- Extract the library units generated from all the functions in the
- -- session.
- funcs <- getFuncs
- let units = Maybe.mapMaybe getLibraryUnits funcs
- let context = [
- AST.Library $ mkVHDLId "IEEE",
- AST.Use $ (AST.NSimple $ mkVHDLId "IEEE.std_logic_1164") AST.:.: AST.All]
- return $ map (AST.DesignFile context) units
+getDesignFiles :: [FuncData] -> [AST.DesignFile]
+getDesignFiles funcs =
+ map (AST.DesignFile context) units
+ where
+ units = filter (not.null) $ map getLibraryUnits funcs
+ context = [
+ AST.Library $ mkVHDLId "IEEE",
+ AST.Use $ (AST.NSimple $ mkVHDLId "IEEE.std_logic_1164") AST.:.: AST.All]
-- | Create an entity for a given function
createEntity ::
HsFunction -- | The function signature
-> FuncData -- | The function data collected so far
- -> VHDLState ()
+ -> Maybe Entity -- | The resulting entity. Should return the existing
+ --- Entity for builtin functions.
createEntity hsfunc fdata =
- let func = flatFunc fdata in
- case func of
+ case flatFunc fdata of
-- Skip (builtin) functions without a FlatFunction
- Nothing -> do return ()
+ Nothing -> funcEntity fdata
-- Create an entity for all other functions
Just flatfunc ->
let
then Nothing
else Just $ AST.PackageDec pkg_id (map AST.PDITD $ ty_decls ++ ty_decls')
AST.EntityDec entity_id _ = ent_decl'
- entity' = Entity entity_id args' res' (Just ent_decl') pkg_decl
- in do
- setEntity hsfunc entity'
+ in
+ Just $ Entity entity_id args' res' (Just ent_decl') pkg_decl
where
mkMap ::
[(SignalId, SignalInfo)]
Just (AST.EntityDec id _) -> Just id
getLibraryUnits ::
- (HsFunction, FuncData) -- | A function from the session
- -> Maybe [AST.LibraryUnit] -- | The entity, architecture and optional package for the function
+ FuncData -- | A function from the session
+ -> [AST.LibraryUnit] -- | The entity, architecture and optional package for the function
-getLibraryUnits (hsfunc, fdata) =
+getLibraryUnits fdata =
case funcEntity fdata of
- Nothing -> Nothing
+ Nothing -> []
Just ent ->
case ent_decl ent of
- Nothing -> Nothing
+ Nothing -> []
Just decl ->
case funcArch fdata of
- Nothing -> Nothing
+ Nothing -> []
Just arch ->
- Just $
[AST.LUEntity decl, AST.LUArch arch]
++ (Maybe.maybeToList (fmap AST.LUPackageDec $ ent_pkg_decl ent))
-- Shortcut
mkVHDLId :: String -> AST.VHDLId
mkVHDLId s =
- AST.unsafeVHDLBasicId s'
+ AST.unsafeVHDLBasicId $ (strip_multiscore . strip_invalid) s
where
-- Strip invalid characters.
- s' = filter (`elem` ['A'..'Z'] ++ ['a'..'z'] ++ ['0'..'9'] ++ "_.") s
+ strip_invalid = filter (`elem` ['A'..'Z'] ++ ['a'..'z'] ++ ['0'..'9'] ++ "_.")
+ -- Strip multiple adjacent underscores
+ strip_multiscore = concat . map (\cs ->
+ case cs of
+ ('_':_) -> "_"
+ _ -> cs
+ ) . List.group