VHDL.hs

   1 --
   2 -- Functions to generate VHDL from FlatFunctions
   3 --
   4 module VHDL where
   5
   6 import Data.Traversable
   7 import qualified Maybe
   8
   9 import qualified Type
  10 import qualified Name
  11 import qualified TyCon
  12 import Outputable ( showSDoc, ppr )
  13
  14 import qualified ForSyDe.Backend.VHDL.AST as AST
  15
  16 import VHDLTypes
  17 import FlattenTypes
  18 import TranslatorTypes
  19
  20 -- | Create an entity for a given function
  21 createEntity ::
  22   HsFunction        -- | The function signature
  23   -> FuncData       -- | The function data collected so far
  24   -> FuncData       -- | The modified function data
  25
  26 createEntity hsfunc fdata =
  27   let func = flatFunc fdata in
  28   case func of
  29     -- Skip (builtin) functions without a FlatFunction
  30     Nothing -> fdata
  31     -- Create an entity for all other functions
  32     Just flatfunc ->
  33
  34       let
  35         s       = sigs flatfunc
  36         a       = args flatfunc
  37         r       = res  flatfunc
  38         args'   = map (fmap (mkMap s)) a
  39         res'    = fmap (mkMap s) r
  40         entity' = Entity args' res' Nothing
  41       in
  42         fdata { entity = Just entity' }
  43   where
  44     mkMap :: Eq id => [(id, SignalInfo)] -> id -> AST.VHDLId
  45     mkMap sigmap id =
  46       mkVHDLId nm
  47       where
  48         info = Maybe.fromMaybe
  49           (error $ "Signal not found in the name map? This should not happen!")
  50           (lookup id sigmap)
  51         nm = Maybe.fromMaybe
  52           (error $ "Signal not named? This should not happen!")
  53           (name info)
  54
  55
  56
  57
  58
  59 -- | The VHDL Bit type
  60 bit_ty :: AST.TypeMark
  61 bit_ty = AST.unsafeVHDLBasicId "Bit"
  62
  63 -- Translate a Haskell type to a VHDL type
  64 vhdl_ty :: Type.Type -> AST.TypeMark
  65 vhdl_ty ty = Maybe.fromMaybe
  66   (error $ "Unsupported Haskell type: " ++ (showSDoc $ ppr ty))
  67   (vhdl_ty_maybe ty)
  68
  69 -- Translate a Haskell type to a VHDL type
  70 vhdl_ty_maybe :: Type.Type -> Maybe AST.TypeMark
  71 vhdl_ty_maybe ty =
  72   case Type.splitTyConApp_maybe ty of
  73     Just (tycon, args) ->
  74       let name = TyCon.tyConName tycon in
  75         -- TODO: Do something more robust than string matching
  76         case Name.getOccString name of
  77           "Bit"      -> Just bit_ty
  78           otherwise  -> Nothing
  79     otherwise -> Nothing
  80
  81 -- Shortcut
  82 mkVHDLId :: String -> AST.VHDLId
  83 mkVHDLId = AST.unsafeVHDLBasicId