From 495e75489457be4ea5bfa9692e2b8736047a41ae Mon Sep 17 00:00:00 2001 From: Matthijs Kooijman Date: Wed, 11 Feb 2009 18:31:34 +0100 Subject: [PATCH] Replace FuncMap by a Data.Map. --- Pretty.hs | 3 ++- Translator.hs | 19 ++++++++++++++++++- TranslatorTypes.hs | 8 +++++--- 3 files changed, 25 insertions(+), 5 deletions(-) diff --git a/Pretty.hs b/Pretty.hs index bc72faa..c4556a8 100644 --- a/Pretty.hs +++ b/Pretty.hs @@ -1,5 +1,6 @@ module Pretty (prettyShow) where +import qualified Data.Map as Map import qualified CoreSyn import qualified Module import qualified HscTypes @@ -48,7 +49,7 @@ instance Pretty VHDLSession where pPrint (VHDLSession mod nameCount funcs) = text "Module: " $$ nest 15 (text modname) $+$ text "NameCount: " $$ nest 15 (int nameCount) - $+$ text "Functions: " $$ nest 15 (vcat (map ppfunc funcs)) + $+$ text "Functions: " $$ nest 15 (vcat (map ppfunc (Map.toList funcs))) where ppfunc (hsfunc, (flatfunc)) = pPrint hsfunc $+$ (text "Flattened: " $$ nest 15 (pPrint flatfunc)) diff --git a/Translator.hs b/Translator.hs index babd622..5b58232 100644 --- a/Translator.hs +++ b/Translator.hs @@ -10,6 +10,7 @@ import qualified Maybe import qualified Module import qualified Control.Monad.State as State import Name +import qualified Data.Map as Map import Data.Generics import NameEnv ( lookupNameEnv ) import HscTypes ( cm_binds, cm_types ) @@ -53,7 +54,7 @@ main = let binds = Maybe.mapMaybe (findBind (cm_binds core)) ["sfull_adder"] liftIO $ putStr $ prettyShow binds -- Turn bind into VHDL - let (vhdl, sess) = State.runState (mkVHDL binds) (VHDLSession core 0 []) + let (vhdl, sess) = State.runState (mkVHDL binds) (VHDLSession core 0 Map.empty) liftIO $ putStr $ render $ ForSyDe.Backend.Ppr.ppr vhdl liftIO $ ForSyDe.Backend.VHDL.FileIO.writeDesignFile vhdl "../vhdl/vhdl/output.vhdl" liftIO $ putStr $ "\n\nFinal session:\n" ++ prettyShow sess ++ "\n\n" @@ -168,4 +169,20 @@ splitTupleType ty = Nothing Nothing -> Nothing +-- | A consise representation of a (set of) ports on a builtin function +type PortMap = HsValueMap (String, AST.TypeMark) +{- +-- | Translate a concise representation of a builtin function to something +-- that can be put into FuncMap directly. +make_builtin :: String -> [PortMap] -> PortMap -> (HsFunction, FuncData) +make_builtin name args res = + (hsfunc, (Nothing)) + where + hsfunc = HsFunction name (map useAsPort args) (useAsPort res) + +builtin_funcs = + [ + make_builtin "hwxor" [(Single ("a", VHDL.bit_ty)), (Single ("b", VHDL.bit_ty))] (Single ("o", VHDL.bit_ty)) + ] +-} -- vim: set ts=8 sw=2 sts=2 expandtab: diff --git a/TranslatorTypes.hs b/TranslatorTypes.hs index 8db0b5f..70ae9b7 100644 --- a/TranslatorTypes.hs +++ b/TranslatorTypes.hs @@ -6,12 +6,13 @@ module TranslatorTypes where import qualified Control.Monad.State as State import qualified HscTypes +import qualified Data.Map as Map import Flatten -- | A map from a HsFunction identifier to various stuff we collect about a -- function along the way. -type FuncMap = [(HsFunction, FuncData)] +type FuncMap = Map.Map HsFunction FuncData -- | Some stuff we collect about a function along the way. type FuncData = (FlatFunction) @@ -25,13 +26,14 @@ data VHDLSession = VHDLSession { addFunc :: HsFunction -> FlatFunction -> VHDLState () addFunc hsfunc flatfunc = do fs <- State.gets funcs -- Get the funcs element from the session - State.modify (\x -> x {funcs = (hsfunc, flatfunc) : fs }) -- Prepend name and f + let fs' = Map.insert hsfunc (flatfunc) fs -- Insert function + State.modify (\x -> x {funcs = fs' }) -- | Find the given function in the current session getFunc :: HsFunction -> VHDLState (Maybe FuncData) getFunc hsfunc = do fs <- State.gets funcs -- Get the funcs element from the session - return $ lookup hsfunc fs + return $ Map.lookup hsfunc fs getModule :: VHDLState HscTypes.CoreModule getModule = State.gets coreMod -- Get the coreMod element from the session -- 2.30.2