From: Matthijs Kooijman <m.kooijman@student.utwente.nl>
Date: Tue, 27 Jan 2009 14:24:17 +0000 (+0100)
Subject: Run mkHWFunction and addFunc in a State monad.
X-Git-Url: https://git.stderr.nl/gitweb?a=commitdiff_plain;h=87d85be9d0d98b75570e1d931f6337fa51631615;p=matthijs%2Fmaster-project%2Fc%CE%BBash.git

Run mkHWFunction and addFunc in a State monad.

This uses a state consisting of a VHDLSession. The invocation of these
functions is a bit ugly now, that will be cleaned up next.
---

diff --git a/Translator.hs b/Translator.hs
index 50d87fa..4df791a 100644
--- 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,9 +43,7 @@ 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
+					let sess = State.execState (do {(name, f) <- mkHWFunction bind; addFunc name f}) (VHDLSession 0 builtin_funcs)
 					liftIO $ putStr $ showSDoc $ ppr expr
 					liftIO $ putStr "\n\n"
 					liftIO $ putStr $ render $ ForSyDe.Backend.Ppr.ppr $ getArchitecture sess bind
@@ -244,12 +243,11 @@ data HWFunction = HWFunction { -- A function that is available in hardware
 -- 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
@@ -262,7 +260,7 @@ 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 {
@@ -270,10 +268,13 @@ data VHDLSession = VHDLSession {
 	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 = 
 	[