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 (parent:
553b58f
)
Map output ports as well as input ports.
author
Matthijs Kooijman
<m.kooijman@student.utwente.nl>
Wed, 21 Jan 2009 10:49:52 +0000
(11:49 +0100)
committer
Matthijs Kooijman
<m.kooijman@student.utwente.nl>
Wed, 21 Jan 2009 10:51:16 +0000
(11:51 +0100)
Translator.hs
patch
|
blob
|
history
diff --git
a/Translator.hs
b/Translator.hs
index 56cbe5e698c764451f3f15bb19658f58e872cca2..18c45d770589e62d4a19bbcebbda82bed5c5ade3 100644
(file)
--- a/
Translator.hs
+++ b/
Translator.hs
@@
-124,21
+124,22
@@
getInstantiations ::
PortNameMap -- The arguments that need to be applied to the
-- expression. Should always be the Args
-- constructor.
PortNameMap -- The arguments that need to be applied to the
-- expression. Should always be the Args
-- constructor.
+ -> PortNameMap -- The output ports that the expression should generate.
-> [(CoreBndr, PortNameMap)] -- A list of bindings in effect
-> CoreSyn.CoreExpr -- The expression to generate an architecture for
-> String -- The resulting VHDL code
-- A lambda expression binds the first argument (a) to the binder b.
-> [(CoreBndr, PortNameMap)] -- A list of bindings in effect
-> CoreSyn.CoreExpr -- The expression to generate an architecture for
-> String -- The resulting VHDL code
-- A lambda expression binds the first argument (a) to the binder b.
-getInstantiations (Args (a:as)) binds (Lam b expr) =
- getInstantiations (Args as) ((b, a):binds) expr
+getInstantiations (Args (a:as))
outs
binds (Lam b expr) =
+ getInstantiations (Args as)
outs
((b, a):binds) expr
-- A case expression that checks a single variable and has a single
-- alternative, can be used to take tuples apart
-- A case expression that checks a single variable and has a single
-- alternative, can be used to take tuples apart
-getInstantiations args binds (Case (Var v) b _ [res]) =
+getInstantiations args
outs
binds (Case (Var v) b _ [res]) =
case altcon of
DataAlt datacon ->
if (DataCon.isTupleCon datacon) then
case altcon of
DataAlt datacon ->
if (DataCon.isTupleCon datacon) then
- getInstantiations args binds' expr
+ getInstantiations args
outs
binds' expr
else
error "Data constructors other than tuples not supported"
otherwise ->
else
error "Data constructors other than tuples not supported"
otherwise ->
@@
-152,21
+153,33
@@
getInstantiations args binds (Case (Var v) b _ [res]) =
(lookup v binds)
-- An application is an instantiation of a component
(lookup v binds)
-- An application is an instantiation of a component
-getInstantiations args binds app@(App expr arg) =
+getInstantiations args
outs
binds app@(App expr arg) =
--indent ++ "F:\n" ++ (getInstantiations (' ':indent) expr) ++ "\n" ++ indent ++ "A:\n" ++ (getInstantiations (' ':indent) arg) ++ "\n"
"app : " ++ (getOccString f) ++ "\n"
++ "port map (\n"
--indent ++ "F:\n" ++ (getInstantiations (' ':indent) expr) ++ "\n" ++ indent ++ "A:\n" ++ (getInstantiations (' ':indent) arg) ++ "\n"
"app : " ++ (getOccString f) ++ "\n"
++ "port map (\n"
+ -- Map input ports of f
++ concat (zipWith (getPortMapEntry binds) ["portin0", "portin1"] args)
++ concat (zipWith (getPortMapEntry binds) ["portin0", "portin1"] args)
+ -- Map output ports of f
+ ++ mapOutputPorts (Port "portout") outs
++ ");\n"
where
((Var f), args) = collectArgs app
++ ");\n"
where
((Var f), args) = collectArgs app
-getInstantiations args binds expr = showSDoc $ ppr $ expr
+getInstantiations args outs binds expr = showSDoc $ ppr $ expr
+
+-- Map the output port of a component to the output port of the containing
+-- entity.
+mapOutputPorts (Port port) (Port signal) =
+ "\t" ++ port ++ " => " ++ signal ++ "\n"
+
+-- Map matching output ports in the tuple
+mapOutputPorts (Tuple ports) (Tuple signals) =
+ concat (zipWith mapOutputPorts ports signals)
getArchitecture (NonRec var expr) =
"architecture structural of " ++ name ++ " is\n"
++ "begin\n"
getArchitecture (NonRec var expr) =
"architecture structural of " ++ name ++ " is\n"
++ "begin\n"
- ++ getInstantiations (Args inportnames) [] expr
+ ++ getInstantiations (Args inportnames)
outport
[] expr
++ "end structural\n"
where
name = (getOccString var)
++ "end structural\n"
where
name = (getOccString var)
@@
-177,6
+190,7
@@
getArchitecture (NonRec var expr) =
inportnames = case ports of
[port] -> [getPortNameMapForTy "portin" port]
ps -> getPortNameMapForTys "portin" 0 ps
inportnames = case ports of
[port] -> [getPortNameMapForTy "portin" port]
ps -> getPortNameMapForTys "portin" 0 ps
+ outport = getPortNameMapForTy "portout" res
data PortNameMap =
Args [PortNameMap] -- Each of the submaps represent an argument to the
data PortNameMap =
Args [PortNameMap] -- Each of the submaps represent an argument to the