projects
/
matthijs
/
master-project
/
cλash.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
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 50d87fad55ef9585be1b5430153048900a369925..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 DataCon
import qualified Maybe
import qualified Module
+import qualified Control.Monad.State as State
import Name
import Data.Generics
import NameEnv ( lookupNameEnv )
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
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
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
printTarget (Target (TargetFile file (Just x)) obj Nothing) =
print $ show file
@@
-244,12
+251,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 ::
-- 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
where
name = (getOccString var)
ty = CoreUtils.exprType expr
@@
-262,7
+268,7
@@
mkHWFunction sess (NonRec var expr) =
ps -> getPortNameMapForTys "portin" 0 ps
outport = getPortNameMapForTy "portout" res
ps -> getPortNameMapForTys "portin" 0 ps
outport = getPortNameMapForTy "portout" res
-mkHWFunction
sess
(Rec _) =
+mkHWFunction (Rec _) =
error "Recursive binders not supported"
data VHDLSession = VHDLSession {
error "Recursive binders not supported"
data VHDLSession = VHDLSession {
@@
-270,10
+276,13
@@
data VHDLSession = VHDLSession {
funcs :: [(String, HWFunction)] -- All functions available, indexed by name
} deriving (Show)
funcs :: [(String, HWFunction)] -- All functions available, indexed by name
} deriving (Show)
+type VHDLState = State.State VHDLSession
+
-- Add the function to the session
-- 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 =
[
builtin_funcs =
[