-- Turns the given bind into VHDL
mkVHDL binds = do
-- Add the builtin functions
- --mapM (uncurry addFunc) builtin_funcs
+ mapM addBuiltIn builtin_funcs
-- Create entities and architectures for them
- mapM flattenBind binds
+ mapM processBind binds
return $ AST.DesignFile
[]
[]
NonRec var _ -> lookfor == (occNameString $ nameOccName $ getName var)
) binds
--- | Flattens the given bind and adds it to the session. Then (recursively)
--- finds any functions it uses and does the same with them.
-flattenBind ::
- CoreBind -- The binder to flatten
+-- | Processes the given bind as a top level bind.
+processBind ::
+ CoreBind -- The bind to process
-> VHDLState ()
-flattenBind (Rec _) = error "Recursive binders not supported"
-
-flattenBind bind@(NonRec var expr) = do
+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
- --hwfunc <- mkHWFunction bind hsfunc
- -- Add it to the session
- --addFunc hsfunc hwfunc
+ flattenBind hsfunc bind
+
+-- | 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 bind = findBind (cm_binds core) name
case bind of
Nothing -> error $ "Couldn't find function " ++ name ++ " in current module."
- Just b -> flattenBind b
+ Just b -> flattenBind hsfunc b
where
name = hsFuncName hsfunc
-- | 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
+
-- | Translate a concise representation of a builtin function to something
-- that can be put into FuncMap directly.
-make_builtin :: String -> [PortMap] -> PortMap -> (HsFunction, FuncData)
-make_builtin name args res =
- (hsfunc, (Nothing))
+addBuiltIn :: BuiltIn -> VHDLState ()
+addBuiltIn (BuiltIn name args res) = do
+ addFunc hsfunc
where
hsfunc = HsFunction name (map useAsPort args) (useAsPort res)
builtin_funcs =
[
- make_builtin "hwxor" [(Single ("a", VHDL.bit_ty)), (Single ("b", VHDL.bit_ty))] (Single ("o", VHDL.bit_ty))
+ BuiltIn "hwxor" [(Single ("a", VHDL.bit_ty)), (Single ("b", VHDL.bit_ty))] (Single ("o", VHDL.bit_ty))
]
--}
+
-- vim: set ts=8 sw=2 sts=2 expandtab: