2 -- Functions to generate VHDL from FlatFunctions
6 import Data.Traversable
7 import qualified Data.Foldable as Foldable
12 import qualified TyCon
13 import Outputable ( showSDoc, ppr )
15 import qualified ForSyDe.Backend.VHDL.AST as AST
19 import TranslatorTypes
21 -- | Create an entity for a given function
23 HsFunction -- | The function signature
24 -> FuncData -- | The function data collected so far
25 -> FuncData -- | The modified function data
27 createEntity hsfunc fdata =
28 let func = flatFunc fdata in
30 -- Skip (builtin) functions without a FlatFunction
32 -- Create an entity for all other functions
39 args' = map (fmap (mkMap s)) a
40 res' = fmap (mkMap s) r
41 ent_decl' = createEntityAST hsfunc args' res'
42 entity' = Entity args' res' (Just ent_decl')
44 fdata { entity = Just entity' }
46 mkMap :: Eq id => [(id, SignalInfo)] -> id -> (AST.VHDLId, AST.TypeMark)
48 (mkVHDLId nm, vhdl_ty ty)
50 info = Maybe.fromMaybe
51 (error $ "Signal not found in the name map? This should not happen!")
54 (error $ "Signal not named? This should not happen!")
58 -- | Create the VHDL AST for an entity
60 HsFunction -- | The signature of the function we're working with
61 -> [VHDLSignalMap] -- | The entity's arguments
62 -> VHDLSignalMap -- | The entity's result
63 -> AST.EntityDec -- | The entity with the ent_decl filled in as well
65 createEntityAST hsfunc args res =
66 AST.EntityDec vhdl_id ports
68 vhdl_id = mkEntityId hsfunc
69 ports = concatMap (mapToPorts AST.In) args
70 ++ mapToPorts AST.Out res
71 mapToPorts :: AST.Mode -> VHDLSignalMap -> [AST.IfaceSigDec]
73 map (mkIfaceSigDec mode) (Foldable.toList m)
75 -- | Create a port declaration
77 AST.Mode -- | The mode for the port (In / Out)
78 -> (AST.VHDLId, AST.TypeMark) -- | The id and type for the port
79 -> AST.IfaceSigDec -- | The resulting port declaration
81 mkIfaceSigDec mode (id, ty) = AST.IfaceSigDec id mode ty
83 -- | Generate a VHDL entity name for the given hsfunc
85 -- TODO: This doesn't work for functions with multiple signatures!
86 mkVHDLId $ hsFuncName hsfunc
89 (HsFunction, FuncData) -- | A function from the session
90 -> [AST.LibraryUnit] -- | The library units it generates
92 getLibraryUnits (hsfunc, fdata) =
95 Just ent -> case ent_decl ent of
97 Just decl -> [AST.LUEntity decl]
99 -- | The VHDL Bit type
100 bit_ty :: AST.TypeMark
101 bit_ty = AST.unsafeVHDLBasicId "Bit"
103 -- Translate a Haskell type to a VHDL type
104 vhdl_ty :: Type.Type -> AST.TypeMark
105 vhdl_ty ty = Maybe.fromMaybe
106 (error $ "Unsupported Haskell type: " ++ (showSDoc $ ppr ty))
109 -- Translate a Haskell type to a VHDL type
110 vhdl_ty_maybe :: Type.Type -> Maybe AST.TypeMark
112 case Type.splitTyConApp_maybe ty of
113 Just (tycon, args) ->
114 let name = TyCon.tyConName tycon in
115 -- TODO: Do something more robust than string matching
116 case Name.getOccString name of
122 mkVHDLId :: String -> AST.VHDLId
123 mkVHDLId = AST.unsafeVHDLBasicId