projects
/
matthijs
/
master-project
/
cλash.git
/ commitdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
| commitdiff |
tree
raw
|
patch
|
inline
| side by side (from parent 1:
1e19728
)
Put getArchitecture inside the State monad.
author
Matthijs Kooijman
<m.kooijman@student.utwente.nl>
Tue, 27 Jan 2009 15:01:57 +0000
(16:01 +0100)
committer
Matthijs Kooijman
<m.kooijman@student.utwente.nl>
Tue, 27 Jan 2009 15:01:57 +0000
(16:01 +0100)
Translator.hs
patch
|
blob
|
history
diff --git
a/Translator.hs
b/Translator.hs
index d76ff15dc12f132483ac8244857809d01482e645..53e626903b26c68fb3dfdd91e75382a281590917 100644
(file)
--- a/
Translator.hs
+++ b/
Translator.hs
@@
-43,19
+43,21
@@
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
- --
Add the HWFunction from the bind to the session
- let
sess = State.execState (addF
bind) (VHDLSession 0 builtin_funcs)
+ --
Turn bind into VHDL
+ let
vhdl = State.evalState (mkVHDL
bind) (VHDLSession 0 builtin_funcs)
liftIO $ putStr $ showSDoc $ ppr expr
liftIO $ putStr "\n\n"
liftIO $ putStr $ showSDoc $ ppr expr
liftIO $ putStr "\n\n"
- liftIO $ putStr $ render $ ForSyDe.Backend.Ppr.ppr $
getArchitecture sess bind
+ liftIO $ putStr $ render $ ForSyDe.Backend.Ppr.ppr $
vhdl
return expr
where
-- Turns the given bind into VHDL
return expr
where
-- Turns the given bind into VHDL
-
addF
bind = do
+
mkVHDL
bind = do
-- Get the function signature
(name, f) <- mkHWFunction bind
-- Add it to the session
addFunc name f
-- Get the function signature
(name, f) <- mkHWFunction bind
-- Add it to the session
addFunc name f
+ arch <- getArchitecture bind
+ return arch
printTarget (Target (TargetFile file (Just x)) obj Nothing) =
print $ show file
printTarget (Target (TargetFile file (Just x)) obj Nothing) =
print $ show file
@@
-199,14
+201,15
@@
mapOutputPorts (Tuple ports) (Tuple signals) =
concat (zipWith mapOutputPorts ports signals)
getArchitecture ::
concat (zipWith mapOutputPorts ports signals)
getArchitecture ::
- VHDLSession
- -> CoreBind -- The binder to expand into an architecture
- -> AST.ArchBody -- The resulting architecture
+ CoreBind -- The binder to expand into an architecture
+ -> VHDLState AST.ArchBody -- The resulting architecture
-getArchitecture
sess
(Rec _) = error "Recursive binders not supported"
+getArchitecture (Rec _) = error "Recursive binders not supported"
-getArchitecture sess (NonRec var expr) =
- AST.ArchBody
+getArchitecture (NonRec var expr) = do
+ HWFunction inports outport <- getHWFunc name
+ sess <- State.get
+ return $ AST.ArchBody
(AST.unsafeVHDLBasicId "structural")
-- Use unsafe for now, to prevent pulling in ForSyDe error handling
(AST.NSimple (AST.unsafeVHDLBasicId name))
(AST.unsafeVHDLBasicId "structural")
-- Use unsafe for now, to prevent pulling in ForSyDe error handling
(AST.NSimple (AST.unsafeVHDLBasicId name))
@@
-214,10
+217,6
@@
getArchitecture sess (NonRec var expr) =
(getInstantiations sess inports outport [] expr)
where
name = (getOccString var)
(getInstantiations sess inports outport [] expr)
where
name = (getOccString var)
- hwfunc = Maybe.fromMaybe
- (error $ "Function " ++ name ++ "is unknown? This should not happen!")
- (lookup name (funcs sess))
- HWFunction inports outport = hwfunc
data PortNameMap =
Tuple [PortNameMap]
data PortNameMap =
Tuple [PortNameMap]
@@
-281,9
+280,18
@@
type VHDLState = State.State VHDLSession
-- Add the function to the session
addFunc :: String -> HWFunction -> VHDLState ()
addFunc name f = do
-- Add the function to the session
addFunc :: String -> HWFunction -> VHDLState ()
addFunc name f = do
- fs <- State.gets funcs -- Get the funcs element f
or
m the session
+ fs <- State.gets funcs -- Get the funcs element f
ro
m the session
State.modify (\x -> x {funcs = (name, f) : fs }) -- Prepend name and f
State.modify (\x -> x {funcs = (name, f) : fs }) -- Prepend name and f
+-- Lookup the function with the given name in the current session. Errors if
+-- it was not found.
+getHWFunc :: String -> VHDLState HWFunction
+getHWFunc name = do
+ fs <- State.gets funcs -- Get the funcs element from the session
+ return $ Maybe.fromMaybe
+ (error $ "Function " ++ name ++ "is unknown? This should not happen!")
+ (lookup name fs)
+
builtin_funcs =
[
("hwxor", HWFunction [Port "a", Port "b"] (Port "o")),
builtin_funcs =
[
("hwxor", HWFunction [Port "a", Port "b"] (Port "o")),