2 -- Functions to generate VHDL from FlatFunctions
6 import Data.Traversable
11 import qualified TyCon
12 import Outputable ( showSDoc, ppr )
14 import qualified ForSyDe.Backend.VHDL.AST as AST
18 import TranslatorTypes
20 -- | Create an entity for a given function
22 HsFunction -- | The function signature
23 -> FuncData -- | The function data collected so far
24 -> FuncData -- | The modified function data
26 createEntity hsfunc fdata =
27 let func = flatFunc fdata in
29 -- Skip (builtin) functions without a FlatFunction
31 -- Create an entity for all other functions
38 args' = map (fmap (mkMap s)) a
39 res' = fmap (mkMap s) r
40 ent_decl' = createEntityAST hsfunc args' res'
41 entity' = Entity args' res' (Just ent_decl')
43 fdata { entity = Just entity' }
45 mkMap :: Eq id => [(id, SignalInfo)] -> id -> AST.VHDLId
49 info = Maybe.fromMaybe
50 (error $ "Signal not found in the name map? This should not happen!")
53 (error $ "Signal not named? This should not happen!")
56 -- | Create the VHDL AST for an entity
58 HsFunction -- | The signature of the function we're working with
59 -> [VHDLSignalMap] -- | The entity's arguments
60 -> VHDLSignalMap -- | The entity's result
61 -> AST.EntityDec -- | The entity with the ent_decl filled in as well
63 createEntityAST hsfunc args res =
64 AST.EntityDec vhdl_id ports
66 vhdl_id = mkEntityId hsfunc
69 -- | Generate a VHDL entity name for the given hsfunc
71 -- TODO: This doesn't work for functions with multiple signatures!
72 mkVHDLId $ hsFuncName hsfunc
75 (HsFunction, FuncData) -- | A function from the session
76 -> [AST.LibraryUnit] -- | The library units it generates
78 getLibraryUnits (hsfunc, fdata) =
81 Just ent -> case ent_decl ent of
83 Just decl -> [AST.LUEntity decl]
85 -- | The VHDL Bit type
86 bit_ty :: AST.TypeMark
87 bit_ty = AST.unsafeVHDLBasicId "Bit"
89 -- Translate a Haskell type to a VHDL type
90 vhdl_ty :: Type.Type -> AST.TypeMark
91 vhdl_ty ty = Maybe.fromMaybe
92 (error $ "Unsupported Haskell type: " ++ (showSDoc $ ppr ty))
95 -- Translate a Haskell type to a VHDL type
96 vhdl_ty_maybe :: Type.Type -> Maybe AST.TypeMark
98 case Type.splitTyConApp_maybe ty of
100 let name = TyCon.tyConName tycon in
101 -- TODO: Do something more robust than string matching
102 case Name.getOccString name of
108 mkVHDLId :: String -> AST.VHDLId
109 mkVHDLId = AST.unsafeVHDLBasicId