+
+data HWFunction = HWFunction { -- A function that is available in hardware
+ inPorts :: [PortNameMap],
+ outPort :: PortNameMap
+ --entity :: AST.EntityDec
+} deriving (Show)
+
+-- Turns a CoreExpr describing a function into a description of its input and
+-- output ports.
+mkHWFunction ::
+ CoreBind -- The core binder to generate the interface for
+ -> VHDLState (String, HWFunction) -- The name of the function and its interface
+
+mkHWFunction (NonRec var expr) =
+ return (name, HWFunction inports outport)
+ where
+ name = (getOccString var)
+ ty = CoreUtils.exprType expr
+ (fargs, res) = Type.splitFunTys ty
+ args = if length fargs == 1 then fargs else (init fargs)
+ --state = if length fargs == 1 then () else (last fargs)
+ inports = case args of
+ -- Handle a single port specially, to prevent an extra 0 in the name
+ [port] -> [getPortNameMapForTy "portin" port]
+ ps -> getPortNameMapForTys "portin" 0 ps
+ outport = getPortNameMapForTy "portout" res
+
+mkHWFunction (Rec _) =
+ error "Recursive binders not supported"
+
+data VHDLSession = VHDLSession {
+ nameCount :: Int, -- A counter that can be used to generate unique names
+ funcs :: [(String, HWFunction)] -- All functions available, indexed by name
+} deriving (Show)
+
+type VHDLState = State.State VHDLSession
+
+-- Add the function to the session
+addFunc :: String -> HWFunction -> VHDLState ()
+addFunc name f = do
+ fs <- State.gets funcs -- Get the funcs element form the session
+ State.modify (\x -> x {funcs = (name, f) : fs }) -- Prepend name and f
+
+builtin_funcs =
+ [
+ ("hwxor", HWFunction [Port "a", Port "b"] (Port "o")),
+ ("hwand", HWFunction [Port "a", Port "b"] (Port "o"))
+ ]