Remove the distinction between SignalDef and SignalUse.

Now everywhere SignalDef and SignalUse was used before, the sigid is used
directly.

diff --git a/Flatten.hs b/Flatten.hs
index e550db8b695045a808bc97f6dc570fb15051c8e2..15f99808600bb37cf2880405d48a3639dc78e478 100644 (file)
--- a/Flatten.hs
+++ b/Flatten.hs
@@ -23,11 +23,11 @@ dataConAppArgs dc args =
   where
     tycount = length $ DataCon.dataConAllTyVars dc
 
-genSignalUses ::
+genSignals ::
   Type.Type
-  -> FlattenState (SignalUseMap UnnamedSignal)
+  -> FlattenState (SignalMap UnnamedSignal)
 
-genSignalUses ty = do
+genSignals ty = do
   typeMapToUseMap tymap
   where
     -- First generate a map with the right structure containing the types
@@ -35,11 +35,11 @@ genSignalUses ty = do
 
 typeMapToUseMap ::
   HsValueMap Type.Type
-  -> FlattenState (SignalUseMap UnnamedSignal)
+  -> FlattenState (SignalMap UnnamedSignal)
 
 typeMapToUseMap (Single ty) = do
   id <- genSignalId
-  return $ Single (SignalUse id)
+  return $ Single id
 
 typeMapToUseMap (Tuple tymaps) = do
   usemaps <- State.mapM typeMapToUseMap tymaps
@@ -63,16 +63,16 @@ flattenFunction hsfunc bind@(NonRec var expr) =
 flattenExpr ::
   BindMap
   -> CoreExpr
-  -> FlattenState ([SignalDefMap UnnamedSignal], (SignalUseMap UnnamedSignal))
+  -> FlattenState ([SignalMap UnnamedSignal], (SignalMap UnnamedSignal))
 
 flattenExpr binds lam@(Lam b expr) = do
   -- Find the type of the binder
   let (arg_ty, _) = Type.splitFunTy (CoreUtils.exprType lam)
   -- Create signal names for the binder
-  defs <- genSignalUses arg_ty
+  defs <- genSignals arg_ty
   let binds' = (b, Left defs):binds
   (args, res) <- flattenExpr binds' expr
-  return ((useMapToDefMap defs) : args, res)
+  return (defs : args, res)
 
 flattenExpr binds (Var id) =
   case bind of
@@ -114,12 +114,12 @@ flattenExpr binds app@(App _ _) = do
       -- Check and split each of the arguments
       let (_, arg_ress) = unzip (zipWith checkArg args flat_args)
       -- Generate signals for our result
-      res <- genSignalUses ty
+      res <- genSignals ty
       -- Create the function application
       let app = FApp {
         appFunc = func,
         appArgs = arg_ress,
-        appRes  = useMapToDefMap res
+        appRes  = res
       }
       addApp app
       return ([], res)
@@ -154,7 +154,7 @@ flattenExpr binds expr@(Case (Var v) b _ alts) =
       -> Var.Var                -- The scrutinee
       -> CoreBndr               -- The binder to bind the scrutinee to
       -> CoreAlt                -- The single alternative
-      -> FlattenState ( [SignalDefMap UnnamedSignal], SignalUseMap UnnamedSignal)
+      -> FlattenState ( [SignalMap UnnamedSignal], SignalMap UnnamedSignal)
                                            -- See expandExpr
     flattenSingleAltCaseExpr binds v b alt@(DataAlt datacon, bind_vars, expr) =
       if not (DataCon.isTupleCon datacon) 

diff --git a/FlattenTypes.hs b/FlattenTypes.hs
index c5546eadb9043003981e2c0b1a8b363f8978a9ce..3389a5b6fdfed080cbbc84222b3e90187c7b46ef 100644 (file)
--- a/FlattenTypes.hs
+++ b/FlattenTypes.hs
@@ -10,28 +10,8 @@ import HsValueMap
 -- | A signal identifier
 type UnnamedSignal = Int
 
--- | A use of a signal
-data SignalUse sigid = SignalUse {
-  sigUseId :: sigid
-} deriving (Show, Eq)
-
--- | A def of a signal
-data SignalDef sigid = SignalDef {
-  sigDefId :: sigid
-} deriving (Show, Eq)
-
--- | A map of a Haskell value to signal uses
-type SignalUseMap sigid = HsValueMap (SignalUse sigid)
--- | A map of a Haskell value to signal defs
-type SignalDefMap sigid = HsValueMap (SignalDef sigid)
-
--- | Translate a SignalUseMap to an equivalent SignalDefMap
-useMapToDefMap :: SignalUseMap sigid -> SignalDefMap sigid
-useMapToDefMap = fmap (\(SignalUse u) -> SignalDef u)
-
--- | Translate a SignalDefMap to an equivalent SignalUseMap 
-defMapToUseMap :: SignalDefMap sigid -> SignalUseMap sigid
-defMapToUseMap = fmap (\(SignalDef u) -> SignalUse u)
+-- | A map of a Haskell value to signal ids
+type SignalMap sigid = HsValueMap sigid
 
 -- | How is a given (single) value in a function's type (ie, argument or
 -- return value) used?
@@ -82,23 +62,23 @@ data HsFunction = HsFunction {
 -- | A flattened function application
 data FApp sigid = FApp {
   appFunc :: HsFunction,
-  appArgs :: [SignalUseMap sigid],
-  appRes  :: SignalDefMap sigid
+  appArgs :: [SignalMap sigid],
+  appRes  :: SignalMap sigid
 } deriving (Show, Eq)
 
 -- | A conditional signal definition
 data CondDef sigid = CondDef {
-  cond    :: SignalUse sigid,
-  high    :: SignalUse sigid,
-  low     :: SignalUse sigid,
-  condRes :: SignalDef sigid
+  cond    :: sigid,
+  high    :: sigid,
+  low     :: sigid,
+  condRes :: sigid
 } deriving (Show, Eq)
 
 -- | A flattened function
 data FlatFunction' sigid = FlatFunction {
-  args   :: [SignalDefMap sigid],
-  res    :: SignalUseMap sigid,
-  --sigs   :: [SignalDef],
+  args   :: [SignalMap sigid],
+  res    :: SignalMap sigid,
+  --sigs   :: [Signal],
   apps   :: [FApp sigid],
   conds  :: [CondDef sigid]
 } deriving (Show, Eq)
@@ -110,11 +90,11 @@ type FlatFunction = FlatFunction' UnnamedSignal
 type BindMap = [(
   CoreBndr,            -- ^ The bind name
   Either               -- ^ The bind value which is either
-    (SignalUseMap UnnamedSignal)
+    (SignalMap UnnamedSignal)
                        -- ^ a signal
     (
       HsValueUse,      -- ^ or a HighOrder function
-      [SignalUse UnnamedSignal] -- ^ With these signals already applied to it
+      [UnnamedSignal]  -- ^ With these signals already applied to it
     )
   )]
 

diff --git a/Pretty.hs b/Pretty.hs
index bd4d9e598b3f798ca8b100d28e3bb5fce8004943..22862d59a0f256f16f87bfd0aeef87051b0c7f8c 100644 (file)
--- a/Pretty.hs
+++ b/Pretty.hs
@@ -38,12 +38,6 @@ instance Pretty id => Pretty (FApp id) where
   pPrint (FApp func args res) =
     pPrint func <> text " : " <> pPrint args <> text " -> " <> pPrint res
 
-instance Pretty id => Pretty (SignalDef id) where
-  pPrint (SignalDef id) = pPrint id
-
-instance Pretty id => Pretty (SignalUse id) where
-  pPrint (SignalUse id) = pPrint id
-
 instance Pretty id => Pretty (CondDef id) where
   pPrint _ = text "TODO"