X-Git-Url: https://git.stderr.nl/gitweb?a=blobdiff_plain;f=VHDL.hs;h=b577110db761643e37d83fa0e7caad7a4a7f061b;hb=6da7fe2ee6111b6472efaf2f29cf31b72b66fd87;hp=ae72368f4f9fd0b6eccbe9f20f7836ef0d4da733;hpb=527a6aa73e730b0837d9cec13554ceaacb0a2fca;p=matthijs%2Fmaster-project%2Fc%CE%BBash.git diff --git a/VHDL.hs b/VHDL.hs index ae72368..b577110 100644 --- a/VHDL.hs +++ b/VHDL.hs @@ -3,6 +3,7 @@ -- module VHDL where +-- Standard modules import qualified Data.Foldable as Foldable import qualified Data.List as List import qualified Data.Map as Map @@ -15,14 +16,16 @@ import qualified Data.Monoid as Monoid import Data.Accessor import qualified Data.Accessor.MonadState as MonadState +-- ForSyDe +import qualified ForSyDe.Backend.VHDL.AST as AST + +-- GHC API import qualified Type -import qualified TysWiredIn import qualified Name import qualified TyCon import Outputable ( showSDoc, ppr ) -import qualified ForSyDe.Backend.VHDL.AST as AST - +-- Local imports import VHDLTypes import Flatten import FlattenTypes @@ -35,19 +38,21 @@ createDesignFiles :: -> [(AST.VHDLId, AST.DesignFile)] createDesignFiles flatfuncmap = - -- TODO: Output types - (mkVHDLId "types", AST.DesignFile [] [type_package]) : - map (Arrow.second $ AST.DesignFile context) units + (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) - context = [ - AST.Library $ mkVHDLId "IEEE", - AST.Use $ (AST.NSimple $ mkVHDLId "IEEE.std_logic_1164") AST.:.: AST.All, - AST.Use $ (AST.NSimple $ mkVHDLId "work.types") AST.:.: AST.All] + 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 :: @@ -168,8 +173,6 @@ createArchitecture hsfunc flatfunc = do 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 @@ -375,6 +378,7 @@ mk_fsvec_ty ty args = do 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 + -- TODO: Check name uniqueness State.modify (Map.insert (OrdType ty) (ty_id, ty_dec)) return ty_id @@ -425,3 +429,5 @@ builtin_funcs = mkBuiltins -- a VHDLSignalMap toVHDLSignalMap :: HsValueMap (String, AST.TypeMark) -> VHDLSignalMap toVHDLSignalMap = fmap (\(name, ty) -> Just (mkVHDLId name, ty)) + +-- vim: set ts=8 sw=2 sts=2 expandtab: