X-Git-Url: https://git.stderr.nl/gitweb?a=blobdiff_plain;f=Flatten.hs;h=8adce9fb0522f39780cc80aa8ac30e50b0a72e09;hb=56b747a9e1101368dd8d497879d6dfd213555055;hp=1eaa0fffa26cfe1b3d4ae7c41e6b80a9de7244c7;hpb=0bc61dd521c7211ba4db643036f8517bb8bb48f4;p=matthijs%2Fmaster-project%2Fc%CE%BBash.git

diff --git a/Flatten.hs b/Flatten.hs
index 1eaa0ff..8adce9f 100644
--- a/Flatten.hs
+++ b/Flatten.hs
@@ -15,7 +15,7 @@ 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 qualified Control.Monad.Trans.State as State
 
 import HsValueMap
 import TranslatorTypes
@@ -222,7 +222,7 @@ flattenExpr binds app@(App _ _) = do
 
     flattenBuildTupleExpr binds args = do
       -- Flatten each of our args
-      flat_args <- (State.mapM (flattenExpr binds) args)
+      flat_args <- (mapM (flattenExpr binds) args)
       -- Check and split each of the arguments
       let (_, arg_ress) = unzip (zipWith checkArg args flat_args)
       let res = Tuple arg_ress
@@ -233,7 +233,7 @@ flattenExpr binds app@(App _ _) = do
       -- Find the function to call
       let func = appToHsFunction ty f args
       -- Flatten each of our args
-      flat_args <- (State.mapM (flattenExpr binds) args)
+      flat_args <- (mapM (flattenExpr binds) args)
       -- Check and split each of the arguments
       let (_, arg_ress) = unzip (zipWith checkArg args flat_args)
       -- Generate signals for our result
@@ -331,25 +331,20 @@ flattenExpr binds expr@(Case scrut b _ alts) = do
       (args', res') <- flattenMultipleAltCaseExpr binds scrut b (a':alts)
       case a of
         (DataAlt datacon, bind_vars, expr) -> do
-          if isDontCare datacon 
-            then do
-              -- Completely skip the dontcare cases
-              return (args', res')
-            else do
-              lit <- dataConToLiteral datacon
-              -- The scrutinee must be a single signal
-              let Single sig = scrut
-              -- Create a signal that contains a boolean
-              boolsigid <- genSignalId SigInternal TysWiredIn.boolTy
-              addNameHint ("s" ++ show sig ++ "_eq_" ++ lit) boolsigid
-              let expr = EqLit sig lit
-              addDef (UncondDef (Right expr) boolsigid)
-              -- Create conditional assignments of either args/res or
-              -- args'/res based on boolsigid, and return the result.
-              -- TODO: It seems this adds the name hint twice?
-              our_args <- Monad.zipWithM (mkConditionals boolsigid) args args'
-              our_res  <- mkConditionals boolsigid res res'
-              return (our_args, our_res)
+          lit <- dataConToLiteral datacon
+          -- The scrutinee must be a single signal
+          let Single sig = scrut
+          -- Create a signal that contains a boolean
+          boolsigid <- genSignalId SigInternal TysWiredIn.boolTy
+          addNameHint ("s" ++ show sig ++ "_eq_" ++ lit) boolsigid
+          let expr = EqLit sig lit
+          addDef (UncondDef (Right expr) boolsigid)
+          -- Create conditional assignments of either args/res or
+          -- args'/res based on boolsigid, and return the result.
+          -- TODO: It seems this adds the name hint twice?
+          our_args <- Monad.zipWithM (mkConditionals boolsigid) args args'
+          our_res  <- mkConditionals boolsigid res res'
+          return (our_args, our_res)
         otherwise ->
           error $ "Case patterns other than data constructors not supported in case alternative: " ++ (showSDoc $ ppr a)
       where
@@ -374,20 +369,6 @@ flattenExpr binds expr@(Case scrut b _ alts) = do
 flattenExpr _ expr = do
   error $ "Unsupported expression: " ++ (showSDoc $ ppr expr)
 
--- | Is the given data constructor a dontcare?
-isDontCare :: DataCon.DataCon -> Bool
-isDontCare datacon =
-  case Name.getOccString tyname of
-    -- TODO: Do something more robust than string matching
-    "Bit" ->
-      Name.getOccString dcname  == "DontCare"
-    otherwise ->
-      False
-  where
-    tycon = DataCon.dataConTyCon datacon
-    tyname = TyCon.tyConName tycon
-    dcname = DataCon.dataConName datacon
-
 -- | Translates a dataconstructor without arguments to the corresponding
 --   literal.
 dataConToLiteral :: DataCon.DataCon -> FlattenState String
@@ -398,7 +379,7 @@ dataConToLiteral datacon = do
     -- TODO: Do something more robust than string matching
     "Bit"      -> do
       let dcname = DataCon.dataConName datacon
-      let lit = case Name.getOccString dcname of "High" -> "'1'"; "Low" -> "'0'"; "DontCare" -> "'-'"
+      let lit = case Name.getOccString dcname of "High" -> "'1'"; "Low" -> "'0'"
       return lit
     "Bool" -> do
       let dcname = DataCon.dataConName datacon
@@ -442,28 +423,4 @@ stateList ::
 stateList uses signals =
     Maybe.catMaybes $ Foldable.toList $ zipValueMapsWith filterState signals uses
   
--- | Returns pairs of signals that should be mapped to state in this function.
-getOwnStates ::
-  HsFunction                      -- | The function to look at
-  -> FlatFunction                 -- | The function to look at
-  -> [(StateId, SignalInfo, SignalInfo)]   
-        -- | The state signals. The first is the state number, the second the
-        --   signal to assign the current state to, the last is the signal
-        --   that holds the new state.
-
-getOwnStates hsfunc flatfunc =
-  [(old_num, old_info, new_info) 
-    | (old_num, old_info) <- args_states
-    , (new_num, new_info) <- res_states
-    , old_num == new_num]
-  where
-    sigs = flat_sigs flatfunc
-    -- Translate args and res to lists of (statenum, sigid)
-    args = concat $ zipWith stateList (hsFuncArgs hsfunc) (flat_args flatfunc)
-    res = stateList (hsFuncRes hsfunc) (flat_res flatfunc)
-    -- Replace the second tuple element with the corresponding SignalInfo
-    args_states = map (Arrow.second $ signalInfo sigs) args
-    res_states = map (Arrow.second $ signalInfo sigs) res
-
-    
 -- vim: set ts=8 sw=2 sts=2 expandtab: