X-Git-Url: https://git.stderr.nl/gitweb?a=blobdiff_plain;f=VHDL.hs;h=956237732dd214610dbfa807074b1577b661c9e8;hb=fcd5e88b1c14a3129253de9e8c225e3b13e041e7;hp=ae7dfc9bfd42f360fa70f0beb8526770dfc5c01f;hpb=8325780f83f31cc3520029912d0797704d058d7e;p=matthijs%2Fmaster-project%2Fc%CE%BBash.git diff --git a/VHDL.hs b/VHDL.hs index ae7dfc9..9562377 100644 --- a/VHDL.hs +++ b/VHDL.hs @@ -3,14 +3,58 @@ -- module VHDL where -import Flatten +import Data.Traversable +import qualified Maybe + import qualified Type import qualified Name import qualified TyCon -import qualified Maybe import Outputable ( showSDoc, ppr ) + import qualified ForSyDe.Backend.VHDL.AST as AST +import VHDLTypes +import FlattenTypes +import TranslatorTypes + +-- | Create an entity for a given function +createEntity :: + HsFunction -- | The function signature + -> FuncData -- | The function data collected so far + -> FuncData -- | The modified function data + +createEntity hsfunc fdata = + let func = flatFunc fdata in + case func of + -- Skip (builtin) functions without a FlatFunction + Nothing -> fdata + -- Create an entity for all other functions + Just flatfunc -> + + let + s = sigs flatfunc + a = args flatfunc + r = res flatfunc + args' = map (fmap (mkMap s)) a + res' = fmap (mkMap s) r + entity' = Entity args' res' Nothing + in + fdata { entity = Just entity' } + where + mkMap :: Eq id => [(id, SignalInfo)] -> id -> AST.VHDLId + mkMap sigmap id = + mkVHDLId nm + where + info = Maybe.fromMaybe + (error $ "Signal not found in the name map? This should not happen!") + (lookup id sigmap) + nm = Maybe.fromMaybe + (error $ "Signal not named? This should not happen!") + (name info) + + + + -- | The VHDL Bit type bit_ty :: AST.TypeMark @@ -37,4 +81,3 @@ vhdl_ty_maybe ty = -- Shortcut mkVHDLId :: String -> AST.VHDLId mkVHDLId = AST.unsafeVHDLBasicId -