Add name hints to various signals generated.

[matthijs/master-project/cλash.git] / FlattenTypes.hs

diff --git a/FlattenTypes.hs b/FlattenTypes.hs
index 8dbdc3b6ab2b9b1a676cd554ba72a78d96e52b38..f75b0d51e64ae9f476627e1d6477062660b1cd5b 100644 (file)
--- a/FlattenTypes.hs
+++ b/FlattenTypes.hs
@@ -92,10 +92,17 @@ data SigDef =
   }
   -- | Unconditional signal definition
   | UncondDef {
-    defSrc :: SignalId,
+    defSrc :: Either SignalId SignalExpr,
     defDst :: SignalId
   } deriving (Show, Eq)
 
+-- | An expression on signals
+data SignalExpr = 
+  EqLit SignalId String -- ^ Is the given signal equal to the given (VHDL) literal
+  | Literal String -- ^ A literal value
+  | Eq SignalId SignalId -- ^ A comparison between to signals
+  deriving (Show, Eq)
+
 -- Returns the function used by the given SigDef, if any
 usedHsFunc :: SigDef -> Maybe HsFunction
 usedHsFunc (FApp hsfunc _ _) = Just hsfunc
@@ -131,7 +138,8 @@ isInternalSigUse _ = False
 data SignalInfo = SignalInfo {
   sigName :: Maybe String,
   sigUse  :: SigUse,
-  sigTy   :: Type.Type
+  sigTy   :: Type.Type,
+  nameHints :: [String]
 }
 
 -- | A flattened function
@@ -150,6 +158,10 @@ signalInfo sigs id = Maybe.fromJust $ lookup id sigs
 -- | A list of binds in effect at a particular point of evaluation
 type BindMap = [(
   CoreBndr,            -- ^ The bind name
+  BindValue            -- ^ The value bound to it
+  )]
+
+type BindValue =
   Either               -- ^ The bind value which is either
     (SignalMap)
                        -- ^ a signal
@@ -157,7 +169,6 @@ type BindMap = [(
       HsValueUse,      -- ^ or a HighOrder function
       [SignalId]       -- ^ With these signals already applied to it
     )
-  )]
 
 -- | The state during the flattening of a single function
 type FlattenState = State.State ([SigDef], [(SignalId, SignalInfo)], SignalId)
@@ -173,10 +184,18 @@ genSignalId :: SigUse -> Type.Type -> FlattenState SignalId
 genSignalId use ty = do
   (defs, sigs, n) <- State.get
   -- Generate a new numbered but unnamed signal
-  let s = (n, SignalInfo Nothing use ty)
+  let s = (n, SignalInfo Nothing use ty [])
   State.put (defs, s:sigs, n+1)
   return n
 
+-- | Add a name hint to the given signal
+addNameHint :: String -> SignalId -> FlattenState ()
+addNameHint hint id = do
+  info <- getSignalInfo id
+  let hints = nameHints info
+  let hints' = (hint:hints)
+  setSignalInfo id (info {nameHints = hints'})
+
 -- | Returns the SignalInfo for the given signal. Errors if the signal is not
 --   known in the session.
 getSignalInfo :: SignalId -> FlattenState SignalInfo