From e523563c7a401c6190e803c21ff6609e3e675b2c Mon Sep 17 00:00:00 2001
From: Matthijs Kooijman <m.kooijman@student.utwente.nl>
Date: Tue, 10 Mar 2009 16:22:36 +0100
Subject: [PATCH] Output a package containing all type declarations.

Since there is nothing that registers new types yet, this outputs just an
empty session for now.
---
 VHDL.hs      | 12 ++++++------
 VHDLTypes.hs |  2 +-
 2 files changed, 7 insertions(+), 7 deletions(-)

diff --git a/VHDL.hs b/VHDL.hs
index 8fe3cfe..ccd1d46 100644
--- a/VHDL.hs
+++ b/VHDL.hs
@@ -35,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 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
@@ -75,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
diff --git a/VHDLTypes.hs b/VHDLTypes.hs
index 948b3a1..54baf47 100644
--- a/VHDLTypes.hs
+++ b/VHDLTypes.hs
@@ -34,7 +34,7 @@ data Entity = Entity {
 } deriving (Show);
 
 -- A orderable equivalent of CoreSyn's Type for use as a map key
-newtype OrdType = OrdType Type.Type
+newtype OrdType = OrdType { getType :: Type.Type }
 instance Eq OrdType where
   (OrdType a) == (OrdType b) = Type.tcEqType a b
 instance Ord OrdType where
-- 
2.30.2