Output a package containing all type declarations.

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

diff --git a/VHDL.hs b/VHDL.hs
index 9a51c7a94ea4a63db3167fc79777cc39e7625078..ccd1d464645f76f2f7f171232546c017e939fed0 100644 (file)
--- a/VHDL.hs
+++ b/VHDL.hs
@@ -26,6 +26,7 @@ import VHDLTypes
 import Flatten
 import FlattenTypes
 import TranslatorTypes
+import HsValueMap
 import Pretty
 
 createDesignFiles ::
@@ -34,14 +35,19 @@ createDesignFiles ::
 
 createDesignFiles flatfuncmap =
   -- TODO: Output types
+  (mkVHDLId "types", AST.DesignFile [] [type_package]) :
   map (Arrow.second $ AST.DesignFile context) units
+  
   where
-    init_session = VHDLSession Map.empty Map.empty
+    init_session = VHDLSession Map.empty builtin_funcs
     (units, final_session) = 
       State.runState (createLibraryUnits flatfuncmap) init_session
+    ty_decls = Map.elems (final_session ^. vsTypes)
     context = [
       AST.Library $ mkVHDLId "IEEE",
-      AST.Use $ (AST.NSimple $ mkVHDLId "IEEE.std_logic_1164") AST.:.: AST.All]
+      AST.Use $ (AST.NSimple $ mkVHDLId "IEEE.std_logic_1164") AST.:.: AST.All,
+      AST.Use $ (AST.NSimple $ mkVHDLId "work.types") AST.:.: AST.All]
+    type_package = AST.LUPackageDec $ AST.PackageDec (mkVHDLId "types") (map (AST.PDITD . snd) ty_decls)
 
 createLibraryUnits ::
   FlatFuncMap
@@ -74,11 +80,6 @@ createEntity hsfunc flatfunc =
         (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')
-        -- TODO: Output package
         AST.EntityDec entity_id _ = ent_decl' 
         signature = Entity entity_id args' res'
       in do
@@ -374,3 +375,30 @@ mkVHDLId s =
           ('_':_) -> "_"
           _ -> 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))