listBind :: String -> String -> IO ()
listBind filename name = do
core <- loadModule filename
listBind :: String -> String -> IO ()
listBind filename name = do
core <- loadModule filename
mkVHDL binds statefuls = do
-- Add the builtin functions
--mapM addBuiltIn builtin_funcs
-- Create entities and architectures for them
mkVHDL binds statefuls = do
-- Add the builtin functions
--mapM addBuiltIn builtin_funcs
-- Create entities and architectures for them
- Monad.zipWithM processBind statefuls binds
- modA tsFlatFuncs (Map.map nameFlatFunction)
- flatfuncs <- getA tsFlatFuncs
- return $ VHDL.createDesignFiles flatfuncs
+ --Monad.zipWithM processBind statefuls binds
+ --modA tsFlatFuncs (Map.map nameFlatFunction)
+ --flatfuncs <- getA tsFlatFuncs
+ return $ VHDL.createDesignFiles binds
-findBinds :: HscTypes.CoreModule -> [String] -> [CoreBind]
-findBinds core names = Maybe.mapMaybe (findBind (cm_binds core)) names
+findBinds :: HscTypes.CoreModule -> [String] -> [(CoreBndr, CoreExpr)]
+findBinds core names = Maybe.mapMaybe (findBind (CoreSyn.flattenBinds $ cm_binds core)) names
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.
-- Create the function signature
let ty = CoreUtils.exprType expr
let hsfunc = mkHsFunction var ty stateful
-- Create the function signature
let ty = CoreUtils.exprType expr
let hsfunc = mkHsFunction var ty stateful
-- Flatten the function
let flatfunc = flattenFunction hsfunc bind
-- Propagate state variables
let flatfunc' = propagateState hsfunc flatfunc
-- Store the flat function in the session
-- Flatten the function
let flatfunc = flattenFunction hsfunc bind
-- Propagate state variables
let flatfunc' = propagateState hsfunc flatfunc
-- Store the flat function in the session
-- Flatten any functions used
let used_hsfuncs = Maybe.mapMaybe usedHsFunc (flat_defs flatfunc')
mapM_ resolvFunc used_hsfuncs
-- Flatten any functions used
let used_hsfuncs = Maybe.mapMaybe usedHsFunc (flat_defs flatfunc')
mapM_ resolvFunc used_hsfuncs
-- 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
-- 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
-- New function, resolve it
core <- getA tsCoreModule
-- Find the named function
let name = (hsFuncName hsfunc)
-- New function, resolve it
core <- getA tsCoreModule
-- Find the named function
let name = (hsFuncName hsfunc)
case bind of
Nothing -> error $ "Couldn't find function " ++ name ++ " in current module."
Just b -> flattenBind hsfunc b
case bind of
Nothing -> error $ "Couldn't find function " ++ name ++ " in current module."
Just b -> flattenBind hsfunc b