Translator.hs

   1 module Main(main) where
   2 import GHC
   3 import CoreSyn
   4 import qualified CoreUtils
   5 import qualified Var
   6 import qualified Type
   7 import qualified TyCon
   8 import qualified DataCon
   9 import qualified Maybe
  10 import qualified Module
  11 import qualified Control.Monad.State as State
  12 import Name
  13 import Data.Generics
  14 import NameEnv ( lookupNameEnv )
  15 import HscTypes ( cm_binds, cm_types )
  16 import MonadUtils ( liftIO )
  17 import Outputable ( showSDoc, ppr )
  18 import GHC.Paths ( libdir )
  19 import DynFlags ( defaultDynFlags )
  20 import List ( find )
  21 import qualified List
  22 import qualified Monad
  23
  24 -- The following modules come from the ForSyDe project. They are really
  25 -- internal modules, so ForSyDe.cabal has to be modified prior to installing
  26 -- ForSyDe to get access to these modules.
  27 import qualified ForSyDe.Backend.VHDL.AST as AST
  28 import qualified ForSyDe.Backend.VHDL.Ppr
  29 import qualified ForSyDe.Backend.VHDL.FileIO
  30 import qualified ForSyDe.Backend.Ppr
  31 -- This is needed for rendering the pretty printed VHDL
  32 import Text.PrettyPrint.HughesPJ (render)
  33
  34 main =
  35     do
  36       defaultErrorHandler defaultDynFlags $ do
  37         runGhc (Just libdir) $ do
  38           dflags <- getSessionDynFlags
  39           setSessionDynFlags dflags
  40           --target <- guessTarget "adder.hs" Nothing
  41           --liftIO (print (showSDoc (ppr (target))))
  42           --liftIO $ printTarget target
  43           --setTargets [target]
  44           --load LoadAllTargets
  45           --core <- GHC.compileToCoreSimplified "Adders.hs"
  46           core <- GHC.compileToCoreSimplified "Adders.hs"
  47           --liftIO $ printBinds (cm_binds core)
  48           let binds = Maybe.mapMaybe (findBind (cm_binds core)) ["full_adder", "half_adder"]
  49           liftIO $ printBinds binds
  50           -- Turn bind into VHDL
  51           let vhdl = State.evalState (mkVHDL binds) (VHDLSession 0 [])
  52           liftIO $ putStr $ render $ ForSyDe.Backend.Ppr.ppr vhdl
  53           liftIO $ ForSyDe.Backend.VHDL.FileIO.writeDesignFile vhdl "../vhdl/vhdl/output.vhdl"
  54           return ()
  55   where
  56     -- Turns the given bind into VHDL
  57     mkVHDL binds = do
  58       -- Add the builtin functions
  59       mapM (uncurry addFunc) builtin_funcs
  60       -- Get the function signatures
  61       funcs <- mapM mkHWFunction binds
  62       -- Add them to the session
  63       mapM (uncurry addFunc) funcs
  64       let entities = map getEntity (snd $ unzip funcs)
  65       -- Create architectures for them
  66       archs <- mapM getArchitecture binds
  67       return $ AST.DesignFile
  68         []
  69         ((map AST.LUEntity entities) ++ (map AST.LUArch archs))
  70
  71 printTarget (Target (TargetFile file (Just x)) obj Nothing) =
  72   print $ show file
  73
  74 printBinds [] = putStr "done\n\n"
  75 printBinds (b:bs) = do
  76   printBind b
  77   putStr "\n"
  78   printBinds bs
  79
  80 printBind (NonRec b expr) = do
  81   putStr "NonRec: "
  82   printBind' (b, expr)
  83
  84 printBind (Rec binds) = do
  85   putStr "Rec: \n"
  86   foldl1 (>>) (map printBind' binds)
  87
  88 printBind' (b, expr) = do
  89   putStr $ getOccString b
  90   putStr $ showSDoc $ ppr expr
  91   putStr "\n"
  92
  93 findBind :: [CoreBind] -> String -> Maybe CoreBind
  94 findBind binds lookfor =
  95   -- This ignores Recs and compares the name of the bind with lookfor,
  96   -- disregarding any namespaces in OccName and extra attributes in Name and
  97   -- Var.
  98   find (\b -> case b of
  99     Rec l -> False
 100     NonRec var _ -> lookfor == (occNameString $ nameOccName $ getName var)
 101   ) binds
 102
 103 getPortMapEntry ::
 104   SignalNameMap  -- The port name to bind to
 105   -> SignalNameMap
 106                             -- The signal or port to bind to it
 107   -> AST.AssocElem          -- The resulting port map entry
 108
 109 -- Accepts a port name and an argument to map to it.
 110 -- Returns the appropriate line for in the port map
 111 getPortMapEntry (Signal portname _) (Signal signame _) =
 112   (Just portname) AST.:=>: (AST.ADName (AST.NSimple signame))
 113 expandExpr ::
 114   [(CoreBndr, SignalNameMap)]
 115                                          -- A list of bindings in effect
 116   -> CoreExpr                            -- The expression to expand
 117   -> VHDLState (
 118        [AST.SigDec],                     -- Needed signal declarations
 119        [AST.ConcSm],                     -- Needed component instantations and
 120                                          -- signal assignments.
 121        [SignalNameMap],       -- The signal names corresponding to
 122                                          -- the expression's arguments
 123        SignalNameMap)         -- The signal names corresponding to
 124                                          -- the expression's result.
 125 expandExpr binds lam@(Lam b expr) = do
 126   -- Generate a new signal to which we will expect this argument to be bound.
 127   signal_name <- uniqueName ("arg_" ++ getOccString b)
 128   -- Find the type of the binder
 129   let (arg_ty, _) = Type.splitFunTy (CoreUtils.exprType lam)
 130   -- Create signal names for the binder
 131   let arg_signal = getPortNameMapForTy ("xxx") arg_ty
 132   -- Create the corresponding signal declarations
 133   let signal_decls = mkSignalsFromMap arg_signal
 134   -- Add the binder to the list of binds
 135   let binds' = (b, arg_signal) : binds
 136   -- Expand the rest of the expression
 137   (signal_decls', statements', arg_signals', res_signal') <- expandExpr binds' expr
 138   -- Properly merge the results
 139   return (signal_decls ++ signal_decls',
 140           statements',
 141           arg_signal : arg_signals',
 142           res_signal')
 143
 144 expandExpr binds (Var id) =
 145   return ([], [], [], Signal signal_id ty)
 146   where
 147     -- Lookup the id in our binds map
 148     Signal signal_id ty = Maybe.fromMaybe
 149       (error $ "Argument " ++ getOccString id ++ "is unknown")
 150       (lookup id binds)
 151
 152 expandExpr binds l@(Let (NonRec b bexpr) expr) = do
 153   (signal_decls, statements, arg_signals, res_signals) <- expandExpr binds bexpr
 154   let binds' = (b, res_signals) : binds
 155   (signal_decls', statements', arg_signals', res_signals') <- expandExpr binds' expr
 156   return (
 157     signal_decls ++ signal_decls',
 158     statements ++ statements',
 159     arg_signals',
 160     res_signals')
 161
 162 expandExpr binds app@(App _ _) = do
 163   -- Is this a data constructor application?
 164   case CoreUtils.exprIsConApp_maybe app of
 165     -- Is this a tuple construction?
 166     Just (dc, args) -> if DataCon.isTupleCon dc
 167       then
 168         expandBuildTupleExpr binds (dataConAppArgs dc args)
 169       else
 170         error "Data constructors other than tuples not supported"
 171     otherise ->
 172       -- Normal function application, should map to a component instantiation
 173       let ((Var f), args) = collectArgs app in
 174       expandApplicationExpr binds (CoreUtils.exprType app) f args
 175
 176 expandExpr binds expr@(Case (Var v) b _ alts) =
 177   case alts of
 178     [alt] -> expandSingleAltCaseExpr binds v b alt
 179     otherwise -> error $ "Multiple alternative case expression not supported: " ++ (showSDoc $ ppr expr)
 180
 181 expandExpr binds expr@(Case _ b _ _) =
 182   error $ "Case expression with non-variable scrutinee not supported: " ++ (showSDoc $ ppr expr)
 183
 184 expandExpr binds expr =
 185   error $ "Unsupported expression: " ++ (showSDoc $ ppr $ expr)
 186
 187 -- Expands the construction of a tuple into VHDL
 188 expandBuildTupleExpr ::
 189   [(CoreBndr, SignalNameMap)]
 190                                          -- A list of bindings in effect
 191   -> [CoreExpr]                          -- A list of expressions to put in the tuple
 192   -> VHDLState ( [AST.SigDec], [AST.ConcSm], [SignalNameMap], SignalNameMap)
 193                                          -- See expandExpr
 194 expandBuildTupleExpr binds args = do
 195   -- Split the tuple constructor arguments into types and actual values.
 196   -- Expand each of the values in the tuple
 197   (signals_declss, statementss, arg_signalss, res_signals) <-
 198     (Monad.liftM List.unzip4) $ mapM (expandExpr binds) args
 199   if any (not . null) arg_signalss
 200     then error "Putting high order functions in tuples not supported"
 201     else
 202       return (
 203         concat signals_declss,
 204         concat statementss,
 205         [],
 206         Tuple res_signals)
 207
 208 -- Expands the most simple case expression that scrutinizes a plain variable
 209 -- and has a single alternative. This simple form currently allows only for
 210 -- unpacking tuple variables.
 211 expandSingleAltCaseExpr ::
 212   [(CoreBndr, SignalNameMap)]
 213                             -- A list of bindings in effect
 214   -> Var.Var                -- The scrutinee
 215   -> CoreBndr               -- The binder to bind the scrutinee to
 216   -> CoreAlt                -- The single alternative
 217   -> VHDLState ( [AST.SigDec], [AST.ConcSm], [SignalNameMap], SignalNameMap)
 218                                          -- See expandExpr
 219
 220 expandSingleAltCaseExpr binds v b alt@(DataAlt datacon, bind_vars, expr) =
 221   if not (DataCon.isTupleCon datacon)
 222     then
 223       error $ "Dataconstructors other than tuple constructors not supported in case pattern of alternative: " ++ (showSDoc $ ppr alt)
 224     else
 225       let
 226         -- Lookup the scrutinee (which must be a variable bound to a tuple) in
 227         -- the existing bindings list and get the portname map for each of
 228         -- it's elements.
 229         Tuple tuple_ports = Maybe.fromMaybe
 230           (error $ "Case expression uses unknown scrutinee " ++ getOccString v)
 231           (lookup v binds)
 232         -- TODO include b in the binds list
 233         -- Merge our existing binds with the new binds.
 234         binds' = (zip bind_vars tuple_ports) ++ binds
 235       in
 236         -- Expand the expression with the new binds list
 237         expandExpr binds' expr
 238
 239 expandSingleAltCaseExpr _ _ _ alt =
 240   error $ "Case patterns other than data constructors not supported in case alternative: " ++ (showSDoc $ ppr alt)
 241
 242
 243 -- Expands the application of argument to a function into VHDL
 244 expandApplicationExpr ::
 245   [(CoreBndr, SignalNameMap)]
 246                                          -- A list of bindings in effect
 247   -> Type                                -- The result type of the function call
 248   -> Var.Var                             -- The function to call
 249   -> [CoreExpr]                          -- A list of argumetns to apply to the function
 250   -> VHDLState ( [AST.SigDec], [AST.ConcSm], [SignalNameMap], SignalNameMap)
 251                                          -- See expandExpr
 252 expandApplicationExpr binds ty f args = do
 253   let name = getOccString f
 254   -- Generate a unique name for the application
 255   appname <- uniqueName ("app_" ++ name)
 256   -- Lookup the hwfunction to instantiate
 257   HWFunction vhdl_id inports outport <- getHWFunc name
 258   -- Expand each of the args, so each of them is reduced to output signals
 259   (arg_signal_decls, arg_statements, arg_res_signals) <- expandArgs binds args
 260   -- Bind each of the input ports to the expanded arguments
 261   let inmaps = concat $ zipWith createAssocElems inports arg_res_signals
 262   -- Create signal names for our result
 263   let res_signal = getPortNameMapForTy (appname ++ "_out") ty
 264   -- Create the corresponding signal declarations
 265   let signal_decls = mkSignalsFromMap res_signal
 266   -- Bind each of the output ports to our output signals
 267   let outmaps = mapOutputPorts outport res_signal
 268   -- Instantiate the component
 269   let component = AST.CSISm $ AST.CompInsSm
 270         (AST.unsafeVHDLBasicId appname)
 271         (AST.IUEntity (AST.NSimple vhdl_id))
 272         (AST.PMapAspect (inmaps ++ outmaps))
 273   -- Merge the generated declarations
 274   return (
 275     signal_decls ++ arg_signal_decls,
 276     component : arg_statements,
 277     [], -- We don't take any extra arguments; we don't support higher order functions yet
 278     res_signal)
 279
 280 -- Creates a list of AssocElems (port map lines) that maps the given signals
 281 -- to the given ports.
 282 createAssocElems ::
 283   SignalNameMap      -- The port names to bind to
 284   -> SignalNameMap   -- The signals to bind to it
 285   -> [AST.AssocElem]            -- The resulting port map lines
 286
 287 createAssocElems (Signal port_id _) (Signal signal_id _) =
 288   [(Just port_id) AST.:=>: (AST.ADName (AST.NSimple signal_id))]
 289
 290 createAssocElems (Tuple ports) (Tuple signals) =
 291   concat $ zipWith createAssocElems ports signals
 292
 293 -- Generate a signal declaration for a signal with the given name and the
 294 -- given type and no value. Also returns the id of the signal.
 295 mkSignal :: String -> AST.TypeMark -> (AST.VHDLId, AST.SigDec)
 296 mkSignal name ty =
 297   (id, mkSignalFromId id ty)
 298   where
 299     id = AST.unsafeVHDLBasicId name
 300
 301 mkSignalFromId :: AST.VHDLId -> AST.TypeMark -> AST.SigDec
 302 mkSignalFromId id ty =
 303   AST.SigDec id ty Nothing
 304
 305 -- Generates signal declarations for all the signals in the given map
 306 mkSignalsFromMap ::
 307   SignalNameMap
 308   -> [AST.SigDec]
 309
 310 mkSignalsFromMap (Signal id ty) =
 311   [mkSignalFromId id ty]
 312
 313 mkSignalsFromMap (Tuple signals) =
 314   concat $ map mkSignalsFromMap signals
 315
 316 expandArgs ::
 317   [(CoreBndr, SignalNameMap)] -- A list of bindings in effect
 318   -> [CoreExpr]                          -- The arguments to expand
 319   -> VHDLState ([AST.SigDec], [AST.ConcSm], [SignalNameMap])
 320                                          -- The resulting signal declarations,
 321                                          -- component instantiations and a
 322                                          -- VHDLName for each of the
 323                                          -- expressions passed in.
 324 expandArgs binds (e:exprs) = do
 325   -- Expand the first expression
 326   (signal_decls, statements, arg_signals, res_signal) <- expandExpr binds e
 327   if not (null arg_signals)
 328     then error $ "Passing functions as arguments not supported: " ++ (showSDoc $ ppr e)
 329     else do
 330       (signal_decls', statements', res_signals') <- expandArgs binds exprs
 331       return (
 332         signal_decls ++ signal_decls',
 333         statements ++ statements',
 334         res_signal : res_signals')
 335
 336 expandArgs _ [] = return ([], [], [])
 337
 338 -- Extract the arguments from a data constructor application (that is, the
 339 -- normal args, leaving out the type args).
 340 dataConAppArgs :: DataCon -> [CoreExpr] -> [CoreExpr]
 341 dataConAppArgs dc args =
 342     drop tycount args
 343   where
 344     tycount = length $ DataCon.dataConAllTyVars dc
 345
 346 mapOutputPorts ::
 347   SignalNameMap      -- The output portnames of the component
 348   -> SignalNameMap   -- The output portnames and/or signals to map these to
 349   -> [AST.AssocElem]            -- The resulting output ports
 350
 351 -- Map the output port of a component to the output port of the containing
 352 -- entity.
 353 mapOutputPorts (Signal portname _) (Signal signalname _) =
 354   [(Just portname) AST.:=>: (AST.ADName (AST.NSimple signalname))]
 355
 356 -- Map matching output ports in the tuple
 357 mapOutputPorts (Tuple ports) (Tuple signals) =
 358   concat (zipWith mapOutputPorts ports signals)
 359
 360 getArchitecture ::
 361   CoreBind                  -- The binder to expand into an architecture
 362   -> VHDLState AST.ArchBody -- The resulting architecture
 363
 364 getArchitecture (Rec _) = error "Recursive binders not supported"
 365
 366 getArchitecture (NonRec var expr) = do
 367   let name = (getOccString var)
 368   HWFunction vhdl_id inports outport <- getHWFunc name
 369   sess <- State.get
 370   (signal_decls, statements, arg_signals, res_signal) <- expandExpr [] expr
 371   let inport_assigns = concat $ zipWith createSignalAssignments arg_signals inports
 372   let outport_assigns = createSignalAssignments outport res_signal
 373   return $ AST.ArchBody
 374     (AST.unsafeVHDLBasicId "structural")
 375     (AST.NSimple vhdl_id)
 376     (map AST.BDISD signal_decls)
 377     (inport_assigns ++ outport_assigns ++ statements)
 378
 379 -- Generate a VHDL entity declaration for the given function
 380 getEntity :: HWFunction -> AST.EntityDec
 381 getEntity (HWFunction vhdl_id inports outport) =
 382   AST.EntityDec vhdl_id ports
 383   where
 384     ports =
 385       (concat $ map (mkIfaceSigDecs AST.In) inports)
 386       ++ mkIfaceSigDecs AST.Out outport
 387
 388 mkIfaceSigDecs ::
 389   AST.Mode                        -- The port's mode (In or Out)
 390   -> SignalNameMap        -- The ports to generate a map for
 391   -> [AST.IfaceSigDec]            -- The resulting ports
 392
 393 mkIfaceSigDecs mode (Signal port_id ty) =
 394   [AST.IfaceSigDec port_id mode ty]
 395
 396 mkIfaceSigDecs mode (Tuple ports) =
 397   concat $ map (mkIfaceSigDecs mode) ports
 398
 399 -- Create concurrent assignments of one map of signals to another. The maps
 400 -- should have a similar form.
 401 createSignalAssignments ::
 402   SignalNameMap         -- The signals to assign to
 403   -> SignalNameMap      -- The signals to assign
 404   -> [AST.ConcSm]                  -- The resulting assignments
 405
 406 -- A simple assignment of one signal to another (greatly complicated because
 407 -- signal assignments can be conditional with multiple conditions in VHDL).
 408 createSignalAssignments (Signal dst _) (Signal src _) =
 409     [AST.CSSASm assign]
 410   where
 411     src_name  = AST.NSimple src
 412     src_expr  = AST.PrimName src_name
 413     src_wform = AST.Wform [AST.WformElem src_expr Nothing]
 414     dst_name  = (AST.NSimple dst)
 415     assign    = dst_name AST.:<==: (AST.ConWforms [] src_wform Nothing)
 416
 417 createSignalAssignments (Tuple dsts) (Tuple srcs) =
 418   concat $ zipWith createSignalAssignments dsts srcs
 419
 420 createSignalAssignments dst src =
 421   error $ "Non matching source and destination: " ++ show dst ++ "\nand\n" ++  show src
 422
 423 data SignalNameMap =
 424   Tuple [SignalNameMap]
 425   | Signal AST.VHDLId AST.TypeMark   -- A signal (or port) of the given (VDHL) type
 426   deriving (Show)
 427
 428 -- Generate a port name map (or multiple for tuple types) in the given direction for
 429 -- each type given.
 430 getPortNameMapForTys :: String -> Int -> [Type] -> [SignalNameMap]
 431 getPortNameMapForTys prefix num [] = []
 432 getPortNameMapForTys prefix num (t:ts) =
 433   (getPortNameMapForTy (prefix ++ show num) t) : getPortNameMapForTys prefix (num + 1) ts
 434
 435 getPortNameMapForTy :: String -> Type -> SignalNameMap
 436 getPortNameMapForTy name ty =
 437   if (TyCon.isTupleTyCon tycon) then
 438     -- Expand tuples we find
 439     Tuple (getPortNameMapForTys name 0 args)
 440   else -- Assume it's a type constructor application, ie simple data type
 441     Signal (AST.unsafeVHDLBasicId name) (vhdl_ty ty)
 442   where
 443     (tycon, args) = Type.splitTyConApp ty
 444
 445 data HWFunction = HWFunction { -- A function that is available in hardware
 446   vhdlId    :: AST.VHDLId,
 447   inPorts   :: [SignalNameMap],
 448   outPort   :: SignalNameMap
 449   --entity    :: AST.EntityDec
 450 } deriving (Show)
 451
 452 -- Turns a CoreExpr describing a function into a description of its input and
 453 -- output ports.
 454 mkHWFunction ::
 455   CoreBind                                   -- The core binder to generate the interface for
 456   -> VHDLState (String, HWFunction)          -- The name of the function and its interface
 457
 458 mkHWFunction (NonRec var expr) =
 459     return (name, HWFunction (mkVHDLId name) inports outport)
 460   where
 461     name = getOccString var
 462     ty = CoreUtils.exprType expr
 463     (fargs, res) = Type.splitFunTys ty
 464     args = if length fargs == 1 then fargs else (init fargs)
 465     --state = if length fargs == 1 then () else (last fargs)
 466     inports = case args of
 467       -- Handle a single port specially, to prevent an extra 0 in the name
 468       [port] -> [getPortNameMapForTy "portin" port]
 469       ps     -> getPortNameMapForTys "portin" 0 ps
 470     outport = getPortNameMapForTy "portout" res
 471
 472 mkHWFunction (Rec _) =
 473   error "Recursive binders not supported"
 474
 475 data VHDLSession = VHDLSession {
 476   nameCount :: Int,                      -- A counter that can be used to generate unique names
 477   funcs     :: [(String, HWFunction)]    -- All functions available, indexed by name
 478 } deriving (Show)
 479
 480 type VHDLState = State.State VHDLSession
 481
 482 -- Add the function to the session
 483 addFunc :: String -> HWFunction -> VHDLState ()
 484 addFunc name f = do
 485   fs <- State.gets funcs -- Get the funcs element from the session
 486   State.modify (\x -> x {funcs = (name, f) : fs }) -- Prepend name and f
 487
 488 -- Lookup the function with the given name in the current session. Errors if
 489 -- it was not found.
 490 getHWFunc :: String -> VHDLState HWFunction
 491 getHWFunc name = do
 492   fs <- State.gets funcs -- Get the funcs element from the session
 493   return $ Maybe.fromMaybe
 494     (error $ "Function " ++ name ++ "is unknown? This should not happen!")
 495     (lookup name fs)
 496
 497 -- Makes the given name unique by appending a unique number.
 498 -- This does not do any checking against existing names, so it only guarantees
 499 -- uniqueness with other names generated by uniqueName.
 500 uniqueName :: String -> VHDLState String
 501 uniqueName name = do
 502   count <- State.gets nameCount -- Get the funcs element from the session
 503   State.modify (\s -> s {nameCount = count + 1})
 504   return $ name ++ "_" ++ (show count)
 505
 506 -- Shortcut
 507 mkVHDLId :: String -> AST.VHDLId
 508 mkVHDLId = AST.unsafeVHDLBasicId
 509
 510 builtin_funcs =
 511   [
 512     ("hwxor", HWFunction (mkVHDLId "hwxor") [Signal (mkVHDLId "a") vhdl_bit_ty, Signal (mkVHDLId "b") vhdl_bit_ty] (Signal (mkVHDLId "o") vhdl_bit_ty)),
 513     ("hwand", HWFunction (mkVHDLId "hwand") [Signal (mkVHDLId "a") vhdl_bit_ty, Signal (mkVHDLId "b") vhdl_bit_ty] (Signal (mkVHDLId "o") vhdl_bit_ty)),
 514     ("hwor", HWFunction (mkVHDLId "hwor") [Signal (mkVHDLId "a") vhdl_bit_ty, Signal (mkVHDLId "b") vhdl_bit_ty] (Signal (mkVHDLId "o") vhdl_bit_ty)),
 515     ("hwnot", HWFunction (mkVHDLId "hwnot") [Signal (mkVHDLId "i") vhdl_bit_ty] (Signal (mkVHDLId "o") vhdl_bit_ty))
 516   ]
 517
 518 vhdl_bit_ty :: AST.TypeMark
 519 vhdl_bit_ty = AST.unsafeVHDLBasicId "Bit"
 520
 521 -- Translate a Haskell type to a VHDL type
 522 vhdl_ty :: Type -> AST.TypeMark
 523 vhdl_ty ty = Maybe.fromMaybe
 524   (error $ "Unsupported Haskell type: " ++ (showSDoc $ ppr ty))
 525   (vhdl_ty_maybe ty)
 526
 527 -- Translate a Haskell type to a VHDL type
 528 vhdl_ty_maybe :: Type -> Maybe AST.TypeMark
 529 vhdl_ty_maybe ty =
 530   case Type.splitTyConApp_maybe ty of
 531     Just (tycon, args) ->
 532       let name = TyCon.tyConName tycon in
 533         -- TODO: Do something more robust than string matching
 534         case getOccString name of
 535           "Bit"      -> Just vhdl_bit_ty
 536           otherwise  -> Nothing
 537     otherwise -> Nothing
 538
 539 -- vim: set ts=8 sw=2 sts=2 expandtab: