From: Matthijs Kooijman Date: Tue, 10 Mar 2009 15:22:36 +0000 (+0100) Subject: Output a package containing all type declarations. X-Git-Url: https://git.stderr.nl/gitweb?a=commitdiff_plain;h=e523563c7a401c6190e803c21ff6609e3e675b2c;p=matthijs%2Fmaster-project%2Fc%CE%BBash.git Output a package containing all type declarations. Since there is nothing that registers new types yet, this outputs just an empty session for now. --- 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