Import the ieee library into the generated types package.

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

diff --git a/VHDL.hs b/VHDL.hs
index 338aa1df889005824ca15bb3407c7517a11882c0..4d8b6669d69503a7f8977eaac1996488648a9ccd 100644 (file)
--- a/VHDL.hs
+++ b/VHDL.hs
@@ -5,11 +5,15 @@ module VHDL where
 
 import qualified Data.Foldable as Foldable
 import qualified Data.List as List
 
 import qualified Data.Foldable as Foldable
 import qualified Data.List as List

+import qualified Data.Map as Map

 import qualified Maybe
 import qualified Control.Monad as Monad
 import qualified Control.Arrow as Arrow
 import qualified Maybe
 import qualified Control.Monad as Monad
 import qualified Control.Arrow as Arrow

+import qualified Control.Monad.Trans.State as State

 import qualified Data.Traversable as Traversable
 import qualified Data.Monoid as Monoid
 import qualified Data.Traversable as Traversable
 import qualified Data.Monoid as Monoid

+import Data.Accessor
+import qualified Data.Accessor.MonadState as MonadState

 
 import qualified Type
 import qualified TysWiredIn
 
 import qualified Type
 import qualified TysWiredIn


@@ -23,61 +27,73 @@ import VHDLTypes
 import Flatten
 import FlattenTypes
 import TranslatorTypes
 import Flatten
 import FlattenTypes
 import TranslatorTypes

+import HsValueMap

 import Pretty
 
 import Pretty
 

-getDesignFiles :: VHDLState [AST.DesignFile]
-getDesignFiles = do
-  -- Extract the library units generated from all the functions in the
-  -- session.
-  funcs <- getFuncs
-  let units = Maybe.mapMaybe getLibraryUnits funcs
-  let context = [
-        AST.Library $ mkVHDLId "IEEE",
-        AST.Use $ (AST.NSimple $ mkVHDLId "IEEE.std_logic_1164") AST.:.: AST.All]
-  return $ map (AST.DesignFile context) units
+createDesignFiles ::
+  FlatFuncMap
+  -> [(AST.VHDLId, AST.DesignFile)]
+
+createDesignFiles flatfuncmap =
+  -- TODO: Output types
+  (mkVHDLId "types", AST.DesignFile ieee_context [type_package]) :
+  map (Arrow.second $ AST.DesignFile full_context) units

   
   

+  where
+    init_session = VHDLSession Map.empty builtin_funcs
+    (units, final_session) = 
+      State.runState (createLibraryUnits flatfuncmap) init_session
+    ty_decls = Map.elems (final_session ^. vsTypes)
+    ieee_context = [
+        AST.Library $ mkVHDLId "IEEE",
+        AST.Use $ (AST.NSimple $ mkVHDLId "IEEE.std_logic_1164") AST.:.: AST.All
+      ]
+    full_context =
+      (AST.Use $ (AST.NSimple $ mkVHDLId "work.types") AST.:.: AST.All)
+      : ieee_context
+    type_package = AST.LUPackageDec $ AST.PackageDec (mkVHDLId "types") (map (AST.PDITD . snd) ty_decls)
+
+createLibraryUnits ::
+  FlatFuncMap
+  -> VHDLState [(AST.VHDLId, [AST.LibraryUnit])]
+
+createLibraryUnits flatfuncmap = do
+  let hsfuncs = Map.keys flatfuncmap
+  let flatfuncs = Map.elems flatfuncmap
+  entities <- Monad.zipWithM createEntity hsfuncs flatfuncs
+  archs <- Monad.zipWithM createArchitecture hsfuncs flatfuncs
+  return $ zipWith 
+    (\ent arch -> 
+      let AST.EntityDec id _ = ent in 
+      (id, [AST.LUEntity ent, AST.LUArch arch])
+    )
+    entities archs
+

 -- | Create an entity for a given function
 createEntity ::
 -- | Create an entity for a given function
 createEntity ::

-  HsFunction        -- | The function signature
-  -> FuncData       -- | The function data collected so far
-  -> VHDLState ()
-
-createEntity hsfunc fdata = 
-  let func = flatFunc fdata in
-  case func of
-    -- Skip (builtin) functions without a FlatFunction
-    Nothing -> do return ()
-    -- Create an entity for all other functions
-    Just flatfunc ->
-      let 
-        sigs    = flat_sigs flatfunc
-        args    = flat_args flatfunc
-        res     = flat_res  flatfunc
-        (ty_decls, args') = Traversable.traverse (Traversable.traverse (mkMap sigs)) args
-        (ty_decls', res') = Traversable.traverse (mkMap sigs) res
-        -- TODO: Unique ty_decls
-        ent_decl' = createEntityAST hsfunc args' res'
-        pkg_id = mkVHDLId $ (AST.fromVHDLId entity_id) ++ "_types"
-        pkg_decl = if null ty_decls && null ty_decls'
-          then Nothing
-          else Just $ AST.PackageDec pkg_id (map AST.PDITD $ ty_decls ++ ty_decls')
-        AST.EntityDec entity_id _ = ent_decl' 
-        entity' = Entity entity_id args' res' (Just ent_decl') pkg_decl
-      in do
-        setEntity hsfunc entity'
+  HsFunction -- | The function signature
+  -> FlatFunction -- | The FlatFunction
+  -> VHDLState AST.EntityDec -- | The resulting entity
+
+createEntity hsfunc flatfunc = do
+      let sigs    = flat_sigs flatfunc
+      let args    = flat_args flatfunc
+      let res     = flat_res  flatfunc
+      args' <- Traversable.traverse (Traversable.traverse (mkMap sigs)) args
+      res' <- Traversable.traverse (mkMap sigs) res
+      let ent_decl' = createEntityAST hsfunc args' res'
+      let AST.EntityDec entity_id _ = ent_decl' 
+      let signature = Entity entity_id args' res'
+      modA vsSignatures (Map.insert hsfunc signature)
+      return ent_decl'

   where
     mkMap :: 
       [(SignalId, SignalInfo)] 
       -> SignalId 
   where
     mkMap :: 
       [(SignalId, SignalInfo)] 
       -> SignalId 

-      -> ([AST.TypeDec], Maybe (AST.VHDLId, AST.TypeMark))
-    mkMap sigmap id =
-      if isPortSigUse $ sigUse info
-        then
-          let (decs, type_mark) = vhdl_ty ty in
-          (decs, Just (mkVHDLId nm, type_mark))
-        else
-          (Monoid.mempty, Nothing)
-      where
+      -> VHDLState VHDLSignalMapElement
+    -- We only need the vsTypes element from the state
+    mkMap sigmap = MonadState.lift vsTypes . (\id ->
+      let

         info = Maybe.fromMaybe
           (error $ "Signal not found in the name map? This should not happen!")
           (lookup id sigmap)
         info = Maybe.fromMaybe
           (error $ "Signal not found in the name map? This should not happen!")
           (lookup id sigmap)


@@ -85,6 +101,14 @@ createEntity hsfunc fdata =
           (error $ "Signal not named? This should not happen!")
           (sigName info)
         ty = sigTy info
           (error $ "Signal not named? This should not happen!")
           (sigName info)
         ty = sigTy info

+      in
+        if isPortSigUse $ sigUse info
+          then do
+            type_mark <- vhdl_ty ty
+            return $ Just (mkVHDLId nm, type_mark)
+          else
+            return $ Nothing
+       )

 
   -- | Create the VHDL AST for an entity
 createEntityAST ::
 
   -- | Create the VHDL AST for an entity
 createEntityAST ::


@@ -126,35 +150,33 @@ mkEntityId hsfunc =
 
 -- | Create an architecture for a given function
 createArchitecture ::
 
 -- | Create an architecture for a given function
 createArchitecture ::

-  HsFunction        -- | The function signature
-  -> FuncData       -- | The function data collected so far
-  -> VHDLState ()
-
-createArchitecture hsfunc fdata = 
-  let func = flatFunc fdata in
-  case func of
-    -- Skip (builtin) functions without a FlatFunction
-    Nothing -> do return ()
-    -- Create an architecture for all other functions
-    Just flatfunc -> do
-      let sigs = flat_sigs flatfunc
-      let args = flat_args flatfunc
-      let res  = flat_res  flatfunc
-      let defs = flat_defs flatfunc
-      let entity_id = Maybe.fromMaybe
-                      (error $ "Building architecture without an entity? This should not happen!")
-                      (getEntityId fdata)
-      -- Create signal declarations for all signals that are not in args and
-      -- res
-      let (ty_decls, sig_decs)  = Arrow.second Maybe.catMaybes $ Traversable.traverse (mkSigDec . snd) sigs
-      -- TODO: Unique ty_decls
-      -- TODO: Store ty_decls somewhere
-      -- Create concurrent statements for all signal definitions
-      statements <- mapM (mkConcSm sigs) defs
-      let procs = map mkStateProcSm (makeStatePairs flatfunc)
-      let procs' = map AST.CSPSm procs
-      let arch = AST.ArchBody (mkVHDLId "structural") (AST.NSimple entity_id) (map AST.BDISD sig_decs) (statements ++ procs')
-      setArchitecture hsfunc arch
+  HsFunction -- ^ The function signature
+  -> FlatFunction -- ^ The FlatFunction
+  -> VHDLState AST.ArchBody -- ^ The architecture for this function
+
+createArchitecture hsfunc flatfunc = do
+  signaturemap <- getA vsSignatures
+  let signature = Maybe.fromMaybe 
+        (error $ "Generating architecture for function " ++ (prettyShow hsfunc) ++ "without signature? This should not happen!")
+        (Map.lookup hsfunc signaturemap)
+  let entity_id = ent_id signature
+  -- Create signal declarations for all internal and state signals
+  sig_dec_maybes <- mapM (mkSigDec' . snd) sigs
+  let sig_decs = Maybe.catMaybes $ sig_dec_maybes
+  -- Create concurrent statements for all signal definitions
+  let statements = zipWith (mkConcSm signaturemap sigs) defs [0..]
+  return $ AST.ArchBody (mkVHDLId "structural") (AST.NSimple entity_id) (map AST.BDISD sig_decs) (statements ++ procs')
+  where
+    sigs = flat_sigs flatfunc
+    args = flat_args flatfunc
+    res  = flat_res  flatfunc
+    defs = flat_defs flatfunc
+    -- TODO: Unique ty_decls
+    -- TODO: Store ty_decls somewhere
+    procs = map mkStateProcSm (makeStatePairs flatfunc)
+    procs' = map AST.CSPSm procs
+    -- mkSigDec only uses vsTypes from the state
+    mkSigDec' = MonadState.lift vsTypes . mkSigDec

 
 -- | Looks up all pairs of old state, new state signals, together with
 --   the state id they represent.
 
 -- | Looks up all pairs of old state, new state signals, together with
 --   the state id they represent.


@@ -183,14 +205,14 @@ mkStateProcSm (num, old, new) =
     rising_edge_clk = AST.PrimFCall $ AST.FCall rising_edge [Nothing AST.:=>: (AST.ADName $ AST.NSimple clk)]
     statement   = AST.IfSm rising_edge_clk [assign] [] Nothing
 
     rising_edge_clk = AST.PrimFCall $ AST.FCall rising_edge [Nothing AST.:=>: (AST.ADName $ AST.NSimple clk)]
     statement   = AST.IfSm rising_edge_clk [assign] [] Nothing
 

-mkSigDec :: SignalInfo -> ([AST.TypeDec], Maybe AST.SigDec)
+mkSigDec :: SignalInfo -> TypeState (Maybe AST.SigDec)

 mkSigDec info =
   let use = sigUse info in
 mkSigDec info =
   let use = sigUse info in

-  if isInternalSigUse use || isStateSigUse use then
-    let (ty_decls, type_mark) = vhdl_ty ty in
-    (ty_decls, Just $ AST.SigDec (getSignalId info) type_mark Nothing)
+  if isInternalSigUse use || isStateSigUse use then do
+    type_mark <- vhdl_ty ty
+    return $ Just (AST.SigDec (getSignalId info) type_mark Nothing)

   else
   else

-    ([], Nothing)
+    return Nothing

   where
     ty = sigTy info
 
   where
     ty = sigTy info
 


@@ -204,31 +226,34 @@ getSignalId info =
 
 -- | Transforms a signal definition into a VHDL concurrent statement
 mkConcSm ::
 
 -- | Transforms a signal definition into a VHDL concurrent statement
 mkConcSm ::

-  [(SignalId, SignalInfo)] -- | The signals in the current architecture
-  -> SigDef                -- | The signal definition
-  -> VHDLState AST.ConcSm    -- | The corresponding VHDL component instantiation.
-
-mkConcSm sigs (FApp hsfunc args res) = do
-  fdata_maybe <- getFunc hsfunc
-  let fdata = Maybe.fromMaybe
-        (error $ "Using function '" ++ (prettyShow hsfunc) ++ "' that is not in the session? This should not happen!")
-        fdata_maybe
-  let entity = Maybe.fromMaybe
-        (error $ "Using function '" ++ (prettyShow hsfunc) ++ "' without entity declaration? This should not happen!")
-        (funcEntity fdata)
-  let entity_id = ent_id entity
-  label <- uniqueName (AST.fromVHDLId entity_id)
-  -- Add a clk port if we have state
-  let clk_port = Maybe.fromJust $ mkAssocElem (Just $ mkVHDLId "clk") "clk"
-  let portmaps = mkAssocElems sigs args res entity ++ (if hasState hsfunc then [clk_port] else [])
-  return $ AST.CSISm $ AST.CompInsSm (mkVHDLId label) (AST.IUEntity (AST.NSimple entity_id)) (AST.PMapAspect portmaps)
-
-mkConcSm sigs (UncondDef src dst) = do
-  let src_expr  = vhdl_expr src
-  let src_wform = AST.Wform [AST.WformElem src_expr Nothing]
-  let dst_name  = AST.NSimple (getSignalId $ signalInfo sigs dst)
-  let assign    = dst_name AST.:<==: (AST.ConWforms [] src_wform Nothing)
-  return $ AST.CSSASm assign
+  SignatureMap             -- ^ The interfaces of functions in the session
+  -> [(SignalId, SignalInfo)] -- ^ The signals in the current architecture
+  -> SigDef                -- ^ The signal definition 
+  -> Int                   -- ^ A number that will be unique for all
+                           --   concurrent statements in the architecture.
+  -> AST.ConcSm            -- ^ The corresponding VHDL component instantiation.
+
+mkConcSm signatures sigs (FApp hsfunc args res) num =
+  let 
+    signature = Maybe.fromMaybe
+        (error $ "Using function '" ++ (prettyShow hsfunc) ++ "' without signature? This should not happen!")
+        (Map.lookup hsfunc signatures)
+    entity_id = ent_id signature
+    label = (AST.fromVHDLId entity_id) ++ "_" ++ (show num)
+    -- Add a clk port if we have state
+    clk_port = Maybe.fromJust $ mkAssocElem (Just $ mkVHDLId "clk") "clk"
+    portmaps = mkAssocElems sigs args res signature ++ (if hasState hsfunc then [clk_port] else [])
+  in
+    AST.CSISm $ AST.CompInsSm (mkVHDLId label) (AST.IUEntity (AST.NSimple entity_id)) (AST.PMapAspect portmaps)
+
+mkConcSm _ sigs (UncondDef src dst) _ =
+  let
+    src_expr  = vhdl_expr src
+    src_wform = AST.Wform [AST.WformElem src_expr Nothing]
+    dst_name  = AST.NSimple (getSignalId $ signalInfo sigs dst)
+    assign    = dst_name AST.:<==: (AST.ConWforms [] src_wform Nothing)
+  in
+    AST.CSSASm assign

   where
     vhdl_expr (Left id) = mkIdExpr sigs id
     vhdl_expr (Right expr) =
   where
     vhdl_expr (Left id) = mkIdExpr sigs id
     vhdl_expr (Right expr) =


@@ -240,16 +265,18 @@ mkConcSm sigs (UncondDef src dst) = do
         (Eq a b) ->
           (mkIdExpr sigs a) AST.:=: (mkIdExpr sigs b)
 
         (Eq a b) ->
           (mkIdExpr sigs a) AST.:=: (mkIdExpr sigs b)
 

-mkConcSm sigs (CondDef cond true false dst) = do
-  let cond_expr  = mkIdExpr sigs cond
-  let true_expr  = mkIdExpr sigs true
-  let false_expr  = mkIdExpr sigs false
-  let false_wform = AST.Wform [AST.WformElem false_expr Nothing]
-  let true_wform = AST.Wform [AST.WformElem true_expr Nothing]
-  let whenelse = AST.WhenElse true_wform cond_expr
-  let dst_name  = AST.NSimple (getSignalId $ signalInfo sigs dst)
-  let assign    = dst_name AST.:<==: (AST.ConWforms [whenelse] false_wform Nothing)
-  return $ AST.CSSASm assign
+mkConcSm _ sigs (CondDef cond true false dst) _ =
+  let
+    cond_expr  = mkIdExpr sigs cond
+    true_expr  = mkIdExpr sigs true
+    false_expr  = mkIdExpr sigs false
+    false_wform = AST.Wform [AST.WformElem false_expr Nothing]
+    true_wform = AST.Wform [AST.WformElem true_expr Nothing]
+    whenelse = AST.WhenElse true_wform cond_expr
+    dst_name  = AST.NSimple (getSignalId $ signalInfo sigs dst)
+    assign    = dst_name AST.:<==: (AST.ConWforms [whenelse] false_wform Nothing)
+  in
+    AST.CSSASm assign

 
 -- | Turn a SignalId into a VHDL Expr
 mkIdExpr :: [(SignalId, SignalInfo)] -> SignalId -> AST.Expr
 
 -- | Turn a SignalId into a VHDL Expr
 mkIdExpr :: [(SignalId, SignalInfo)] -> SignalId -> AST.Expr


@@ -296,33 +323,6 @@ mkAssocElem :: Maybe AST.VHDLId -> String -> Maybe AST.AssocElem
 mkAssocElem (Just port) signal = Just $ Just port AST.:=>: (AST.ADName (AST.NSimple (mkVHDLId signal))) 
 mkAssocElem Nothing _ = Nothing
 
 mkAssocElem (Just port) signal = Just $ Just port AST.:=>: (AST.ADName (AST.NSimple (mkVHDLId signal))) 
 mkAssocElem Nothing _ = Nothing
 

--- | Extracts the generated entity id from the given funcdata
-getEntityId :: FuncData -> Maybe AST.VHDLId
-getEntityId fdata =
-  case funcEntity fdata of
-    Nothing -> Nothing
-    Just e  -> case ent_decl e of
-      Nothing -> Nothing
-      Just (AST.EntityDec id _) -> Just id
-
-getLibraryUnits ::
-  (HsFunction, FuncData)      -- | A function from the session
-  -> Maybe [AST.LibraryUnit]  -- | The entity, architecture and optional package for the function
-
-getLibraryUnits (hsfunc, fdata) =
-  case funcEntity fdata of 
-    Nothing -> Nothing
-    Just ent -> 
-      case ent_decl ent of
-      Nothing -> Nothing
-      Just decl ->
-        case funcArch fdata of
-          Nothing -> Nothing
-          Just arch ->
-            Just $
-              [AST.LUEntity decl, AST.LUArch arch]
-              ++ (Maybe.maybeToList (fmap AST.LUPackageDec $ ent_pkg_decl ent))
-

 -- | The VHDL Bit type
 bit_ty :: AST.TypeMark
 bit_ty = AST.unsafeVHDLBasicId "Bit"
 -- | The VHDL Bit type
 bit_ty :: AST.TypeMark
 bit_ty = AST.unsafeVHDLBasicId "Bit"


@@ -336,38 +336,57 @@ std_logic_ty :: AST.TypeMark
 std_logic_ty = AST.unsafeVHDLBasicId "std_logic"
 
 -- Translate a Haskell type to a VHDL type
 std_logic_ty = AST.unsafeVHDLBasicId "std_logic"
 
 -- Translate a Haskell type to a VHDL type

-vhdl_ty :: Type.Type -> ([AST.TypeDec], AST.TypeMark)
-vhdl_ty ty = Maybe.fromMaybe
-  (error $ "Unsupported Haskell type: " ++ (showSDoc $ ppr ty))
-  (vhdl_ty_maybe ty)
-
--- Translate a Haskell type to a VHDL type, optionally generating a type
--- declaration for the type.
-vhdl_ty_maybe :: Type.Type -> Maybe ([AST.TypeDec], AST.TypeMark)
-vhdl_ty_maybe ty =
-  if Type.coreEqType ty TysWiredIn.boolTy
-    then
-      Just ([], bool_ty)
-    else
-      case Type.splitTyConApp_maybe ty of
-        Just (tycon, args) ->
-          let name = TyCon.tyConName tycon in
-            -- TODO: Do something more robust than string matching
-            case Name.getOccString name of
-              "Bit"      -> Just ([], std_logic_ty)
-              "FSVec"    ->
-                let 
-                  [len, el_ty] = args 
-                  -- TODO: Find actual number
-                  ty_id = mkVHDLId ("vector_" ++ (show len))
-                  -- TODO: Use el_ty
-                  range = AST.IndexConstraint [AST.ToRange (AST.PrimLit "0") (AST.PrimLit "16")]
-                  ty_def = AST.TDA $ AST.ConsArrayDef range std_logic_ty
-                  ty_dec = AST.TypeDec ty_id ty_def
-                in
-                  Just ([ty_dec], ty_id)
-              otherwise  -> Nothing
-        otherwise -> Nothing
+vhdl_ty :: Type.Type -> TypeState AST.TypeMark
+vhdl_ty ty = do
+  typemap <- State.get
+  let builtin_ty = do -- See if this is a tycon and lookup its name
+        (tycon, args) <- Type.splitTyConApp_maybe ty
+        let name = Name.getOccString (TyCon.tyConName tycon)
+        Map.lookup name builtin_types
+  -- If not a builtin type, try the custom types
+  let existing_ty = (fmap fst) $ Map.lookup (OrdType ty) typemap
+  case Monoid.getFirst $ Monoid.mconcat (map Monoid.First [builtin_ty, existing_ty]) of
+    -- Found a type, return it
+    Just t -> return t
+    -- No type yet, try to construct it
+    Nothing -> do
+      let new_ty = do
+            -- Use the Maybe Monad for failing when one of these fails
+            (tycon, args) <- Type.splitTyConApp_maybe ty
+            let name = Name.getOccString (TyCon.tyConName tycon)
+            case name of
+              "FSVec" -> Just $ mk_fsvec_ty ty args
+              otherwise -> Nothing
+      -- Return new_ty when a new type was successfully created
+      Maybe.fromMaybe 
+        (error $ "Unsupported Haskell type: " ++ (showSDoc $ ppr ty))
+        new_ty
+
+-- | Create a VHDL type belonging to a FSVec Haskell type
+mk_fsvec_ty ::
+  Type.Type -- ^ The Haskell type to create a VHDL type for
+  -> [Type.Type] -- ^ Type arguments to the FSVec type constructor
+  -> TypeState AST.TypeMark -- The typemark created.
+
+mk_fsvec_ty ty args = do
+  -- Assume there are two type arguments
+  let [len, el_ty] = args 
+  -- TODO: Find actual number
+  -- Construct the type id, but filter out dots (since these are not allowed).
+  let ty_id = mkVHDLId $ filter (/='.') ("vector_" ++ (show len))
+  -- TODO: Use el_ty
+  let range = AST.IndexConstraint [AST.ToRange (AST.PrimLit "0") (AST.PrimLit "16")]
+  let ty_def = AST.TDA $ AST.ConsArrayDef range std_logic_ty
+  let ty_dec = AST.TypeDec ty_id ty_def
+  State.modify (Map.insert (OrdType ty) (ty_id, ty_dec))
+  return ty_id
+
+
+builtin_types = 
+  Map.fromList [
+    ("Bit", std_logic_ty),
+    ("Bool", bool_ty) -- TysWiredIn.boolTy
+  ]

 
 -- Shortcut
 mkVHDLId :: String -> AST.VHDLId
 
 -- Shortcut
 mkVHDLId :: String -> AST.VHDLId


@@ -382,3 +401,30 @@ mkVHDLId s =
           ('_':_) -> "_"
           _ -> cs
       ) . List.group
           ('_':_) -> "_"
           _ -> cs
       ) . List.group

+
+-- | 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 list of concise representation of builtin functions to a
+--   SignatureMap
+mkBuiltins :: [BuiltIn] -> SignatureMap
+mkBuiltins = Map.fromList . map (\(BuiltIn name args res) ->
+    (HsFunction name (map useAsPort args) (useAsPort res),
+     Entity (VHDL.mkVHDLId name) (map toVHDLSignalMap args) (toVHDLSignalMap res))
+  )
+
+builtin_hsfuncs = Map.keys builtin_funcs
+builtin_funcs = mkBuiltins
+  [ 
+    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))
+  ]
+
+-- | 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) -> Just (mkVHDLId name, ty))