+ deriving (Show)
+
+-- Generate a port name map (or multiple for tuple types) in the given direction for
+-- each type given.
+getPortNameMapForTys :: String -> Int -> [Type] -> [PortNameMap]
+getPortNameMapForTys prefix num [] = []
+getPortNameMapForTys prefix num (t:ts) =
+ (getPortNameMapForTy (prefix ++ show num) t) : getPortNameMapForTys prefix (num + 1) ts
+
+getPortNameMapForTy :: String -> Type -> PortNameMap
+getPortNameMapForTy name ty =
+ if (TyCon.isTupleTyCon tycon) then
+ -- Expand tuples we find
+ Tuple (getPortNameMapForTys name 0 args)
+ else -- Assume it's a type constructor application, ie simple data type
+ -- TODO: Add type?
+ Port name
+ where
+ (tycon, args) = Type.splitTyConApp ty
+
+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 ::
+ VHDLSession
+ -> CoreBind -- The core binder to generate the interface for
+ -> (VHDLSession, String, HWFunction) -- The name of the function and its interface
+
+mkHWFunction sess (NonRec var expr) =
+ (sess, 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 sess (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)
+
+-- Add the function to the session
+addFunc :: VHDLSession -> String -> HWFunction -> VHDLSession
+addFunc sess name f =
+ sess {funcs = (name, f) : (funcs sess) }
+
+builtin_funcs =
+ [
+ ("hwxor", HWFunction [Port "a", Port "b"] (Port "o")),
+ ("hwand", HWFunction [Port "a", Port "b"] (Port "o"))
+ ]