Moved to new GHC API (6.11). Also use vhdl package for the VHDL AST

[matthijs/master-project/cλash.git] / Translator.hs

diff --git a/Translator.hs b/Translator.hs
index 9ce7206c9df9bd841bd0c5a4e7cccabe1d392b3f..260b1cdf5061a5e57b0553ed1ffebd0e1c7e9217 100644 (file)
--- a/Translator.hs
+++ b/Translator.hs
@@ -1,23 +1,35 @@
 module Translator where
 module Translator where

-import GHC
+import qualified Directory
+import qualified System.FilePath as FilePath
+import qualified List
+import Debug.Trace
+import qualified Control.Arrow as Arrow
+import GHC hiding (loadModule, sigName)

 import CoreSyn
 import qualified CoreUtils
 import qualified Var
 import qualified Type
 import qualified TyCon
 import qualified DataCon
 import CoreSyn
 import qualified CoreUtils
 import qualified Var
 import qualified Type
 import qualified TyCon
 import qualified DataCon

+import qualified HscMain
+import qualified SrcLoc
+import qualified FastString

 import qualified Maybe
 import qualified Module
 import qualified Maybe
 import qualified Module

-import qualified Control.Monad.State as State
+import qualified Data.Foldable as Foldable
+import qualified Control.Monad.Trans.State as State

 import Name
 import qualified Data.Map as Map
 import Name
 import qualified Data.Map as Map

+import Data.Accessor

 import Data.Generics
 import NameEnv ( lookupNameEnv )
 import Data.Generics
 import NameEnv ( lookupNameEnv )

+import qualified HscTypes

 import HscTypes ( cm_binds, cm_types )
 import MonadUtils ( liftIO )
 import HscTypes ( cm_binds, cm_types )
 import MonadUtils ( liftIO )

-import Outputable ( showSDoc, ppr )
+import Outputable ( showSDoc, ppr, showSDocDebug )

 import GHC.Paths ( libdir )
 import DynFlags ( defaultDynFlags )
 import GHC.Paths ( libdir )
 import DynFlags ( defaultDynFlags )

+import qualified UniqSupply

 import List ( find )
 import qualified List
 import qualified Monad
 import List ( find )
 import qualified List
 import qualified Monad


@@ -25,214 +37,336 @@ import qualified Monad
 -- The following modules come from the ForSyDe project. They are really
 -- internal modules, so ForSyDe.cabal has to be modified prior to installing
 -- ForSyDe to get access to these modules.
 -- The following modules come from the ForSyDe project. They are really
 -- internal modules, so ForSyDe.cabal has to be modified prior to installing
 -- ForSyDe to get access to these modules.

-import qualified ForSyDe.Backend.VHDL.AST as AST
-import qualified ForSyDe.Backend.VHDL.Ppr
-import qualified ForSyDe.Backend.VHDL.FileIO
-import qualified ForSyDe.Backend.Ppr
+import qualified Language.VHDL.AST as AST
+import qualified Language.VHDL.FileIO
+import qualified Language.VHDL.Ppr as Ppr

 -- This is needed for rendering the pretty printed VHDL
 import Text.PrettyPrint.HughesPJ (render)
 
 import TranslatorTypes
 import HsValueMap
 import Pretty
 -- This is needed for rendering the pretty printed VHDL
 import Text.PrettyPrint.HughesPJ (render)
 
 import TranslatorTypes
 import HsValueMap
 import Pretty

-import Flatten
-import FlattenTypes
+import Normalize
+-- import Flatten
+-- import FlattenTypes

 import VHDLTypes
 import qualified VHDL
 
 import VHDLTypes
 import qualified VHDL
 

-main = 
-    do
-      defaultErrorHandler defaultDynFlags $ do
-        runGhc (Just libdir) $ do
-          dflags <- getSessionDynFlags
-          setSessionDynFlags dflags
-          --target <- guessTarget "adder.hs" Nothing
-          --liftIO (print (showSDoc (ppr (target))))
-          --liftIO $ printTarget target
-          --setTargets [target]
-          --load LoadAllTargets
-          --core <- GHC.compileToCoreSimplified "Adders.hs"
-          core <- GHC.compileToCoreSimplified "Adders.hs"
-          --liftIO $ printBinds (cm_binds core)
-          let binds = Maybe.mapMaybe (findBind (cm_binds core)) ["sfull_adder"]
-          liftIO $ putStr $ prettyShow binds
-          -- Turn bind into VHDL
-          let (vhdl, sess) = State.runState (mkVHDL binds) (VHDLSession core 0 Map.empty)
-          liftIO $ putStr $ render $ ForSyDe.Backend.Ppr.ppr vhdl
-          liftIO $ ForSyDe.Backend.VHDL.FileIO.writeDesignFile vhdl "../vhdl/vhdl/output.vhdl"
-          liftIO $ putStr $ "\n\nFinal session:\n" ++ prettyShow sess ++ "\n\n"
-          return ()
+makeVHDL :: String -> String -> Bool -> IO ()
+makeVHDL filename name stateful = do
+  -- Load the module
+  (core, env) <- loadModule filename
+  -- Translate to VHDL
+  vhdl <- moduleToVHDL env core [(name, stateful)]
+  -- Write VHDL to file
+  let dir = "./vhdl/" ++ name ++ "/"
+  prepareDir dir
+  mapM (writeVHDL dir) vhdl
+  return ()
+
+listBindings :: String -> IO [()]
+listBindings filename = do
+  (core, env) <- loadModule filename
+  let binds = CoreSyn.flattenBinds $ cm_binds core
+  mapM (listBinding) binds
+
+listBinding :: (CoreBndr, CoreExpr) -> IO ()
+listBinding (b, e) = do
+  putStr "\nBinder: "
+  putStr $ show b
+  putStr "\nExpression: \n"
+  putStr $ prettyShow e
+  putStr "\n\n"
+  putStr $ showSDoc $ ppr e
+  putStr "\n\n"
+  putStr $ showSDoc $ ppr $ CoreUtils.exprType e
+  putStr "\n\n"
+  
+-- | Show the core structure of the given binds in the given file.
+listBind :: String -> String -> IO ()
+listBind filename name = do
+  (core, env) <- loadModule filename
+  let [(b, expr)] = findBinds core [name]
+  putStr "\n"
+  putStr $ prettyShow expr
+  putStr "\n\n"
+  putStr $ showSDoc $ ppr expr
+  putStr "\n\n"
+  putStr $ showSDoc $ ppr $ CoreUtils.exprType expr
+  putStr "\n\n"
+
+-- | Translate the binds with the given names from the given core module to
+--   VHDL. The Bool in the tuple makes the function stateful (True) or
+--   stateless (False).
+moduleToVHDL :: HscTypes.HscEnv -> HscTypes.CoreModule -> [(String, Bool)] -> IO [(AST.VHDLId, AST.DesignFile)]
+moduleToVHDL env core list = do
+  let (names, statefuls) = unzip list
+  let binds = map fst $ findBinds core names
+  -- Generate a UniqSupply
+  -- Running 
+  --    egrep -r "(initTcRnIf|mkSplitUniqSupply)" .
+  -- on the compiler dir of ghc suggests that 'z' is not used to generate a
+  -- unique supply anywhere.
+  uniqSupply <- UniqSupply.mkSplitUniqSupply 'z'
+  -- Turn bind into VHDL
+  let all_bindings = (CoreSyn.flattenBinds $ cm_binds core)
+  let (normalized_bindings, typestate) = normalizeModule env uniqSupply all_bindings binds statefuls
+  let vhdl = VHDL.createDesignFiles typestate normalized_bindings
+  mapM (putStr . render . Ppr.ppr . snd) vhdl
+  --putStr $ "\n\nFinal session:\n" ++ prettyShow sess ++ "\n\n"
+  return vhdl

   where
   where

-    -- Turns the given bind into VHDL
-    mkVHDL binds = do
-      -- Add the builtin functions
-      mapM addBuiltIn builtin_funcs
-      -- Create entities and architectures for them
-      mapM processBind binds
-      modFuncs nameFlatFunction
-      modFuncs VHDL.createEntity
-      modFuncs VHDL.createArchitecture
-      -- Extract the library units generated from all the functions in the
-      -- session.
-      funcs <- getFuncs
-      let units = concat $ map VHDL.getLibraryUnits funcs
-      return $ AST.DesignFile 
-        []
-        units
-
-findBind :: [CoreBind] -> String -> Maybe CoreBind
+
+-- | Prepares the directory for writing VHDL files. This means creating the
+--   dir if it does not exist and removing all existing .vhdl files from it.
+prepareDir :: String -> IO()
+prepareDir dir = do
+  -- Create the dir if needed
+  exists <- Directory.doesDirectoryExist dir
+  Monad.unless exists $ Directory.createDirectory dir
+  -- Find all .vhdl files in the directory
+  files <- Directory.getDirectoryContents dir
+  let to_remove = filter ((==".vhdl") . FilePath.takeExtension) files
+  -- Prepend the dirname to the filenames
+  let abs_to_remove = map (FilePath.combine dir) to_remove
+  -- Remove the files
+  mapM_ Directory.removeFile abs_to_remove
+
+-- | Write the given design file to a file with the given name inside the
+--   given dir
+writeVHDL :: String -> (AST.VHDLId, AST.DesignFile) -> IO ()
+writeVHDL dir (name, vhdl) = do
+  -- Find the filename
+  let fname = dir ++ (AST.fromVHDLId name) ++ ".vhdl"
+  -- Write the file
+  Language.VHDL.FileIO.writeDesignFile vhdl fname
+
+-- | Loads the given file and turns it into a core module.
+loadModule :: String -> IO (HscTypes.CoreModule, HscTypes.HscEnv)
+loadModule filename =
+  defaultErrorHandler defaultDynFlags $ do
+    runGhc (Just libdir) $ do
+      dflags <- getSessionDynFlags
+      setSessionDynFlags dflags
+      --target <- guessTarget "adder.hs" Nothing
+      --liftIO (print (showSDoc (ppr (target))))
+      --liftIO $ printTarget target
+      --setTargets [target]
+      --load LoadAllTargets
+      --core <- GHC.compileToCoreSimplified "Adders.hs"
+      core <- GHC.compileToCoreModule filename
+      env <- GHC.getSession
+      return (core, env)
+
+-- | Extracts the named binds from the given module.
+findBinds :: HscTypes.CoreModule -> [String] -> [(CoreBndr, CoreExpr)]
+findBinds core names = Maybe.mapMaybe (findBind (CoreSyn.flattenBinds $ cm_binds core)) names
+
+-- | Extract a named bind from the given list of binds
+findBind :: [(CoreBndr, CoreExpr)] -> String -> Maybe (CoreBndr, CoreExpr)

 findBind binds lookfor =
   -- This ignores Recs and compares the name of the bind with lookfor,
   -- disregarding any namespaces in OccName and extra attributes in Name and
   -- Var.
 findBind binds lookfor =
   -- This ignores Recs and compares the name of the bind with lookfor,
   -- disregarding any namespaces in OccName and extra attributes in Name and
   -- Var.

-  find (\b -> case b of 
-    Rec l -> False
-    NonRec var _ -> lookfor == (occNameString $ nameOccName $ getName var)
-  ) binds
-
--- | Processes the given bind as a top level bind.
-processBind ::
-  CoreBind                        -- The bind to process
-  -> VHDLState ()
-
-processBind  (Rec _) = error "Recursive binders not supported"
-processBind bind@(NonRec var expr) = do
-  -- Create the function signature
-  let ty = CoreUtils.exprType expr
-  let hsfunc = mkHsFunction var ty
-  flattenBind hsfunc bind
+  find (\(var, _) -> lookfor == (occNameString $ nameOccName $ getName var)) binds

 
 -- | Flattens the given bind into the given signature and adds it to the
 --   session. Then (recursively) finds any functions it uses and does the same
 --   with them.
 
 -- | Flattens the given bind into the given signature and adds it to the
 --   session. Then (recursively) finds any functions it uses and does the same
 --   with them.

-flattenBind ::
-  HsFunction                         -- The signature to flatten into
-  -> CoreBind                        -- The bind to flatten
-  -> VHDLState ()
-
-flattenBind _ (Rec _) = error "Recursive binders not supported"
-
-flattenBind hsfunc bind@(NonRec var expr) = do
-  -- Flatten the function
-  let flatfunc = flattenFunction hsfunc bind
-  addFunc hsfunc
-  setFlatFunc hsfunc flatfunc
-  let used_hsfuncs = map appFunc (flat_apps flatfunc)
-  State.mapM resolvFunc used_hsfuncs
-  return ()
+-- flattenBind ::
+--   HsFunction                         -- The signature to flatten into
+--   -> (CoreBndr, CoreExpr)            -- The bind to flatten
+--   -> TranslatorState ()
+-- 
+-- flattenBind hsfunc bind@(var, expr) = do
+--   -- Flatten the function
+--   let flatfunc = flattenFunction hsfunc bind
+--   -- Propagate state variables
+--   let flatfunc' = propagateState hsfunc flatfunc
+--   -- Store the flat function in the session
+--   modA tsFlatFuncs (Map.insert hsfunc flatfunc')
+--   -- Flatten any functions used
+--   let used_hsfuncs = Maybe.mapMaybe usedHsFunc (flat_defs flatfunc')
+--   mapM_ resolvFunc used_hsfuncs
+
+-- | Decide which incoming state variables will become state in the
+--   given function, and which will be propagate to other applied
+--   functions.
+-- propagateState ::
+--   HsFunction
+--   -> FlatFunction
+--   -> FlatFunction
+-- 
+-- propagateState hsfunc flatfunc =
+--     flatfunc {flat_defs = apps', flat_sigs = sigs'} 
+--   where
+--     (olds, news) = unzip $ getStateSignals hsfunc flatfunc
+--     states' = zip olds news
+--     -- Find all signals used by all sigdefs
+--     uses = concatMap sigDefUses (flat_defs flatfunc)
+--     -- Find all signals that are used more than once (is there a
+--     -- prettier way to do this?)
+--     multiple_uses = uses List.\\ (List.nub uses)
+--     -- Find the states whose "old state" signal is used only once
+--     single_use_states = filter ((`notElem` multiple_uses) . fst) states'
+--     -- See if these single use states can be propagated
+--     (substate_sigss, apps') = unzip $ map (propagateState' single_use_states) (flat_defs flatfunc)
+--     substate_sigs = concat substate_sigss
+--     -- Mark any propagated state signals as SigSubState
+--     sigs' = map 
+--       (\(id, info) -> (id, if id `elem` substate_sigs then info {sigUse = SigSubState} else info))
+--       (flat_sigs flatfunc)
+
+-- | Propagate the state into a single function application.
+-- propagateState' ::
+--   [(SignalId, SignalId)]
+--                       -- ^ TODO
+--   -> SigDef           -- ^ The SigDef to process.
+--   -> ([SignalId], SigDef) 
+--                       -- ^ Any signal ids that should become substates,
+--                       --   and the resulting application.
+-- 
+-- propagateState' states def =
+--     if (is_FApp def) then
+--       (our_old ++ our_new, def {appFunc = hsfunc'})
+--     else
+--       ([], def)
+--   where
+--     hsfunc = appFunc def
+--     args = appArgs def
+--     res = appRes def
+--     our_states = filter our_state states
+--     -- A state signal belongs in this function if the old state is
+--     -- passed in, and the new state returned
+--     our_state (old, new) =
+--       any (old `Foldable.elem`) args
+--       && new `Foldable.elem` res
+--     (our_old, our_new) = unzip our_states
+--     -- Mark the result
+--     zipped_res = zipValueMaps res (hsFuncRes hsfunc)
+--     res' = fmap (mark_state (zip our_new [0..])) zipped_res
+--     -- Mark the args
+--     zipped_args = zipWith zipValueMaps args (hsFuncArgs hsfunc)
+--     args' = map (fmap (mark_state (zip our_old [0..]))) zipped_args
+--     hsfunc' = hsfunc {hsFuncArgs = args', hsFuncRes = res'}
+-- 
+--     mark_state :: [(SignalId, StateId)] -> (SignalId, HsValueUse) -> HsValueUse
+--     mark_state states (id, use) =
+--       case lookup id states of
+--         Nothing -> use
+--         Just state_id -> State state_id

 
 

+-- | Returns pairs of signals that should be mapped to state in this function.
+-- getStateSignals ::
+--   HsFunction                      -- | The function to look at
+--   -> FlatFunction                 -- | The function to look at
+--   -> [(SignalId, SignalId)]   
+--         -- | TODO The state signals. The first is the state number, the second the
+--         --   signal to assign the current state to, the last is the signal
+--         --   that holds the new state.
+-- 
+-- getStateSignals hsfunc flatfunc =
+--   [(old_id, new_id) 
+--     | (old_num, old_id) <- args
+--     , (new_num, new_id) <- res
+--     , old_num == new_num]
+--   where
+--     sigs = flat_sigs flatfunc
+--     -- Translate args and res to lists of (statenum, sigid)
+--     args = concat $ zipWith stateList (hsFuncArgs hsfunc) (flat_args flatfunc)
+--     res = stateList (hsFuncRes hsfunc) (flat_res flatfunc)
+    

 -- | Find the given function, flatten it and add it to the session. Then
 --   (recursively) do the same for any functions used.
 -- | Find the given function, flatten it and add it to the session. Then
 --   (recursively) do the same for any functions used.

-resolvFunc ::
-  HsFunction        -- | The function to look for
-  -> VHDLState ()
-
-resolvFunc hsfunc = do
-  -- See if the function is already known
-  func <- getFunc hsfunc
-  case func of
-    -- Already known, do nothing
-    Just _ -> do
-      return ()
-    -- New function, resolve it
-    Nothing -> do
-      -- Get the current module
-      core <- getModule
-      -- Find the named function
-      let bind = findBind (cm_binds core) name
-      case bind of
-        Nothing -> error $ "Couldn't find function " ++ name ++ " in current module."
-        Just b  -> flattenBind hsfunc b
-  where
-    name = hsFuncName hsfunc
+-- resolvFunc ::
+--   HsFunction        -- | The function to look for
+--   -> TranslatorState ()
+-- 
+-- resolvFunc hsfunc = do
+--   flatfuncmap <- getA tsFlatFuncs
+--   -- Don't do anything if there is already a flat function for this hsfunc or
+--   -- when it is a builtin function.
+--   Monad.unless (Map.member hsfunc flatfuncmap) $ do
+--   -- Not working with new builtins -- Monad.unless (elem hsfunc VHDL.builtin_hsfuncs) $ do
+--   -- New function, resolve it
+--   core <- getA tsCoreModule
+--   -- Find the named function
+--   let name = (hsFuncName hsfunc)
+--   let bind = findBind (CoreSyn.flattenBinds $ cm_binds core) name 
+--   case bind of
+--     Nothing -> error $ "Couldn't find function " ++ name ++ " in current module."
+--     Just b  -> flattenBind hsfunc b

 
 -- | Translate a top level function declaration to a HsFunction. i.e., which
 --   interface will be provided by this function. This function essentially
 --   defines the "calling convention" for hardware models.
 
 -- | Translate a top level function declaration to a HsFunction. i.e., which
 --   interface will be provided by this function. This function essentially
 --   defines the "calling convention" for hardware models.

-mkHsFunction ::
-  Var.Var         -- ^ The function defined
-  -> Type         -- ^ The function type (including arguments!)
-  -> HsFunction   -- ^ The resulting HsFunction
-
-mkHsFunction f ty =
-  HsFunction hsname hsargs hsres
-  where
-    hsname  = getOccString f
-    (arg_tys, res_ty) = Type.splitFunTys ty
-    -- The last argument must be state
-    state_ty = last arg_tys
-    state    = useAsState (mkHsValueMap state_ty)
-    -- All but the last argument are inports
-    inports = map (useAsPort . mkHsValueMap)(init arg_tys)
-    hsargs   = inports ++ [state]
-    hsres    = case splitTupleType res_ty of
-      -- Result type must be a two tuple (state, ports)
-      Just [outstate_ty, outport_ty] -> if Type.coreEqType state_ty outstate_ty
-        then
-          Tuple [state, useAsPort (mkHsValueMap outport_ty)]
-        else
-          error $ "Input state type of function " ++ hsname ++ ": " ++ (showSDoc $ ppr state_ty) ++ " does not match output state type: " ++ (showSDoc $ ppr outstate_ty)
-      otherwise                -> error $ "Return type of top-level function " ++ hsname ++ " must be a two-tuple containing a state and output ports."
+-- mkHsFunction ::
+--   Var.Var         -- ^ The function defined
+--   -> Type         -- ^ The function type (including arguments!)
+--   -> Bool         -- ^ Is this a stateful function?
+--   -> HsFunction   -- ^ The resulting HsFunction
+-- 
+-- mkHsFunction f ty stateful=
+--   HsFunction hsname hsargs hsres
+--   where
+--     hsname  = getOccString f
+--     (arg_tys, res_ty) = Type.splitFunTys ty
+--     (hsargs, hsres) = 
+--       if stateful 
+--       then
+--         let
+--           -- The last argument must be state
+--           state_ty = last arg_tys
+--           state    = useAsState (mkHsValueMap state_ty)
+--           -- All but the last argument are inports
+--           inports = map (useAsPort . mkHsValueMap)(init arg_tys)
+--           hsargs   = inports ++ [state]
+--           hsres    = case splitTupleType res_ty of
+--             -- Result type must be a two tuple (state, ports)
+--             Just [outstate_ty, outport_ty] -> if Type.coreEqType state_ty outstate_ty
+--               then
+--                 Tuple [state, useAsPort (mkHsValueMap outport_ty)]
+--               else
+--                 error $ "Input state type of function " ++ hsname ++ ": " ++ (showSDoc $ ppr state_ty) ++ " does not match output state type: " ++ (showSDoc $ ppr outstate_ty)
+--             otherwise                -> error $ "Return type of top-level function " ++ hsname ++ " must be a two-tuple containing a state and output ports."
+--         in
+--           (hsargs, hsres)
+--       else
+--         -- Just use everything as a port
+--         (map (useAsPort . mkHsValueMap) arg_tys, useAsPort $ mkHsValueMap res_ty)

 
 -- | Adds signal names to the given FlatFunction
 
 -- | Adds signal names to the given FlatFunction

-nameFlatFunction ::
-  HsFunction
-  -> FuncData
-  -> VHDLState ()
-
-nameFlatFunction hsfunc fdata =
-  let func = flatFunc fdata in
-  case func of
-    -- Skip (builtin) functions without a FlatFunction
-    Nothing -> do return ()
-    -- Name the signals in all other functions
-    Just flatfunc ->
-      let s = flat_sigs flatfunc in
-      let s' = map (\(id, (SignalInfo Nothing use ty)) -> (id, SignalInfo (Just $ "sig_" ++ (show id)) use ty)) s in
-      let flatfunc' = flatfunc { flat_sigs = s' } in
-      setFlatFunc hsfunc flatfunc'
-
--- | Splits a tuple type into a list of element types, or Nothing if the type
---   is not a tuple type.
-splitTupleType ::
-  Type              -- ^ The type to split
-  -> Maybe [Type]   -- ^ The tuples element types
-
-splitTupleType ty =
-  case Type.splitTyConApp_maybe ty of
-    Just (tycon, args) -> if TyCon.isTupleTyCon tycon 
-      then
-        Just args
-      else
-        Nothing
-    Nothing -> Nothing
-
--- | A consise representation of a (set of) ports on a builtin function
-type PortMap = HsValueMap (String, AST.TypeMark)
--- | A consise representation of a builtin function
-data BuiltIn = BuiltIn String [PortMap] PortMap
-
--- | Map a port specification of a builtin function to a VHDL Signal to put in
---   a VHDLSignalMap
-toVHDLSignalMap :: HsValueMap (String, AST.TypeMark) -> VHDLSignalMap
-toVHDLSignalMap = fmap (\(name, ty) -> (VHDL.mkVHDLId name, ty))
-
--- | Translate a concise representation of a builtin function to something
---   that can be put into FuncMap directly.
-addBuiltIn :: BuiltIn -> VHDLState ()
-addBuiltIn (BuiltIn name args res) = do
-    addFunc hsfunc
-    setEntity hsfunc entity
-  where
-    hsfunc = HsFunction name (map useAsPort args) (useAsPort res)
-    entity = Entity (VHDL.mkVHDLId name) (map toVHDLSignalMap args) (toVHDLSignalMap res) Nothing
-
-builtin_funcs = 
-  [ 
-    BuiltIn "hwxor" [(Single ("a", VHDL.bit_ty)), (Single ("b", VHDL.bit_ty))] (Single ("o", VHDL.bit_ty)),
-    BuiltIn "hwand" [(Single ("a", VHDL.bit_ty)), (Single ("b", VHDL.bit_ty))] (Single ("o", VHDL.bit_ty)),
-    BuiltIn "hwor" [(Single ("a", VHDL.bit_ty)), (Single ("b", VHDL.bit_ty))] (Single ("o", VHDL.bit_ty)),
-    BuiltIn "hwnot" [(Single ("a", VHDL.bit_ty))] (Single ("o", VHDL.bit_ty))
-  ]
+-- nameFlatFunction ::
+--   FlatFunction
+--   -> FlatFunction
+-- 
+-- nameFlatFunction flatfunc =
+--   -- Name the signals
+--   let 
+--     s = flat_sigs flatfunc
+--     s' = map nameSignal s in
+--   flatfunc { flat_sigs = s' }
+--   where
+--     nameSignal :: (SignalId, SignalInfo) -> (SignalId, SignalInfo)
+--     nameSignal (id, info) =
+--       let hints = nameHints info in
+--       let parts = ("sig" : hints) ++ [show id] in
+--       let name = concat $ List.intersperse "_" parts in
+--       (id, info {sigName = Just name})
+-- 
+-- -- | Splits a tuple type into a list of element types, or Nothing if the type
+-- --   is not a tuple type.
+-- splitTupleType ::
+--   Type              -- ^ The type to split
+--   -> Maybe [Type]   -- ^ The tuples element types
+-- 
+-- splitTupleType ty =
+--   case Type.splitTyConApp_maybe ty of
+--     Just (tycon, args) -> if TyCon.isTupleTyCon tycon 
+--       then
+--         Just args
+--       else
+--         Nothing
+--     Nothing -> Nothing

 
 -- vim: set ts=8 sw=2 sts=2 expandtab:
 
 -- vim: set ts=8 sw=2 sts=2 expandtab: