Make the state monad calling code more pretty.

[matthijs/master-project/cλash.git] / Translator.hs

diff --git a/Translator.hs b/Translator.hs
index dea1fd7dfdf8730698316dac554f11c38b34a437..d76ff15dc12f132483ac8244857809d01482e645 100644 (file)
--- a/Translator.hs
+++ b/Translator.hs
@@ -8,6 +8,7 @@ import qualified TyCon
 import qualified DataCon
 import qualified Maybe
 import qualified Module
+import qualified Control.Monad.State as State
 import Name
 import Data.Generics
 import NameEnv ( lookupNameEnv )
@@ -42,13 +43,19 @@ main =
                                        liftIO $ printBinds (cm_binds core)
                                        let bind = findBind "half_adder" (cm_binds core)
                                        let NonRec var expr = bind
-                                       let sess = VHDLSession 0 builtin_funcs
-                                       let (sess', name, f) = mkHWFunction sess bind
-                                       let sess = addFunc sess' name f
+                                       -- Add the HWFunction from the bind to the session
+                                       let sess = State.execState (addF bind) (VHDLSession 0 builtin_funcs)
                                        liftIO $ putStr $ showSDoc $ ppr expr
                                        liftIO $ putStr "\n\n"
                                        liftIO $ putStr $ render $ ForSyDe.Backend.Ppr.ppr $ getArchitecture sess bind
                                        return expr
+       where
+               -- Turns the given bind into VHDL
+               addF bind = do
+                       -- Get the function signature
+                       (name, f) <- mkHWFunction bind
+                       -- Add it to the session
+                       addFunc name f
 
 printTarget (Target (TargetFile file (Just x)) obj Nothing) =
        print $ show file
@@ -215,6 +222,7 @@ getArchitecture sess (NonRec var expr) =
 data PortNameMap =
        Tuple [PortNameMap]
        | Port  String
+  deriving (Show)
 
 -- Generate a port name map (or multiple for tuple types) in the given direction for
 -- each type given.
@@ -238,17 +246,16 @@ data HWFunction = HWFunction { -- A function that is available in hardware
        inPorts   :: [PortNameMap],
        outPort   :: PortNameMap
        --entity    :: AST.EntityDec
-}
+} deriving (Show)
 
 -- Turns a CoreExpr describing a function into a description of its input and
 -- output ports.
 mkHWFunction ::
-       VHDLSession
-       -> CoreBind                                -- The core binder to generate the interface for
-       -> (VHDLSession, String, HWFunction)       -- The name of the function and its interface
+       CoreBind                                   -- The core binder to generate the interface for
+       -> VHDLState (String, HWFunction)          -- The name of the function and its interface
 
-mkHWFunction sess (NonRec var expr) =
-       (sess, name, HWFunction inports outport)
+mkHWFunction (NonRec var expr) =
+               return (name, HWFunction inports outport)
        where
                name = (getOccString var)
                ty = CoreUtils.exprType expr
@@ -261,18 +268,21 @@ mkHWFunction sess (NonRec var expr) =
                        ps     -> getPortNameMapForTys "portin" 0 ps
                outport = getPortNameMapForTy "portout" res
 
-mkHWFunction sess (Rec _) =
+mkHWFunction (Rec _) =
        error "Recursive binders not supported"
 
 data VHDLSession = VHDLSession {
        nameCount :: Int,                      -- A counter that can be used to generate unique names
        funcs     :: [(String, HWFunction)]    -- All functions available, indexed by name
-}
+} deriving (Show)
+
+type VHDLState = State.State VHDLSession
 
 -- Add the function to the session
-addFunc :: VHDLSession -> String -> HWFunction -> VHDLSession
-addFunc sess name f =
-       sess {funcs = (name, f) : (funcs sess) }
+addFunc :: String -> HWFunction -> VHDLState ()
+addFunc name f = do
+       fs <- State.gets funcs -- Get the funcs element form the session
+       State.modify (\x -> x {funcs = (name, f) : fs }) -- Prepend name and f
 
 builtin_funcs = 
        [