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:
78d7b99
)
Mark port signals as such during flattening.
author
Matthijs Kooijman
<m.kooijman@student.utwente.nl>
Mon, 16 Feb 2009 16:22:20 +0000
(17:22 +0100)
committer
Matthijs Kooijman
<m.kooijman@student.utwente.nl>
Mon, 16 Feb 2009 16:22:20 +0000
(17:22 +0100)
Flatten.hs
patch
|
blob
|
history
diff --git
a/Flatten.hs
b/Flatten.hs
index c8b95b4d92dab4854de0a618febf3296b6ba0750..2e66e90d1dbdb40b70324223423bbfedc07c4857 100644
(file)
--- a/
Flatten.hs
+++ b/
Flatten.hs
@@
-8,6
+8,7
@@
import qualified Maybe
import qualified DataCon
import qualified CoreUtils
import qualified Data.Traversable as Traversable
import qualified DataCon
import qualified CoreUtils
import qualified Data.Traversable as Traversable
+import qualified Data.Foldable as Foldable
import Control.Applicative
import Outputable ( showSDoc, ppr )
import qualified Control.Monad.State as State
import Control.Applicative
import Outputable ( showSDoc, ppr )
import qualified Control.Monad.State as State
@@
-33,6
+34,14
@@
genSignals ty =
-- generate signals for each of them.
Traversable.mapM (\ty -> genSignalId SigInternal ty) (mkHsValueMap ty)
-- generate signals for each of them.
Traversable.mapM (\ty -> genSignalId SigInternal ty) (mkHsValueMap ty)
+-- | Marks a signal as the given SigUse, if its id is in the list of id's
+-- given.
+markSignal :: SigUse -> [UnnamedSignal] -> (UnnamedSignal, SignalInfo) -> (UnnamedSignal, SignalInfo)
+markSignal use ids (id, info) =
+ (id, info')
+ where
+ info' = if id `elem` ids then info { sigUse = use} else info
+
-- | Flatten a haskell function
flattenFunction ::
HsFunction -- ^ The function to flatten
-- | Flatten a haskell function
flattenFunction ::
HsFunction -- ^ The function to flatten
@@
-41,12
+50,14
@@
flattenFunction ::
flattenFunction _ (Rec _) = error "Recursive binders not supported"
flattenFunction hsfunc bind@(NonRec var expr) =
flattenFunction _ (Rec _) = error "Recursive binders not supported"
flattenFunction hsfunc bind@(NonRec var expr) =
- FlatFunction args res apps conds sigs
+ FlatFunction args res apps conds sigs
'
where
init_state = ([], [], [], 0)
(fres, end_state) = State.runState (flattenExpr [] expr) init_state
(args, res) = fres
where
init_state = ([], [], [], 0)
(fres, end_state) = State.runState (flattenExpr [] expr) init_state
(args, res) = fres
+ portlist = concat (map Foldable.toList (res:args))
(apps, conds, sigs, _) = end_state
(apps, conds, sigs, _) = end_state
+ sigs' = fmap (markSignal SigPort portlist) sigs
flattenExpr ::
BindMap
flattenExpr ::
BindMap