Replace FuncMap by a Data.Map.

diff --git a/Pretty.hs b/Pretty.hs
index bc72faa1c296167fbb197ee35cc5a549e9ed10ab..c4556a81b90980dcc8bcfd97457c901fb0568e58 100644 (file)
--- 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 babd622fda8df41c8c962ccd6737d48eecbb6c49..5b58232b9845e52ea950c8c1133b33908d4de7fa 100644 (file)
--- 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 8db0b5f1d6f786b200511f14485061c2bf535696..70ae9b7e922e486cda209a36ca93fd0563dc22dd 100644 (file)
--- 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